From 4ec8ce507abd1b8fd14f5fbd3b5f98df8dc5b92b Mon Sep 17 00:00:00 2001 From: "hernan.wilkinson" Date: Sun, 12 Jun 2022 00:30:28 -0300 Subject: [PATCH] InlineMethod and InlineTemporaryVariable refactorings - Thanks Fernando Balboa --- ...anWilkinson-2022Jun11-19h09m-HAW.001.cs.st | 3568 ++ Packages/BaseImageTests.pck.st | 42739 ++++++++-------- 2 files changed, 25751 insertions(+), 20556 deletions(-) create mode 100644 CoreUpdates/5235-InlineRefactorings-HernanWilkinson-2022Jun11-19h09m-HAW.001.cs.st diff --git a/CoreUpdates/5235-InlineRefactorings-HernanWilkinson-2022Jun11-19h09m-HAW.001.cs.st b/CoreUpdates/5235-InlineRefactorings-HernanWilkinson-2022Jun11-19h09m-HAW.001.cs.st new file mode 100644 index 00000000..d2c9a76e --- /dev/null +++ b/CoreUpdates/5235-InlineRefactorings-HernanWilkinson-2022Jun11-19h09m-HAW.001.cs.st @@ -0,0 +1,3568 @@ +'From Cuis 6.0 [latest update: #5234] on 11 June 2022 at 8:28:35 pm'! +!classDefinition: #InlineMethodMessageSendsSet category: #'Tools-Refactoring'! +MessageSet subclass: #InlineMethodMessageSendsSet + instanceVariableNames: 'applier selectedIndex' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!classDefinition: #InlineMethodWizardStepWindow category: #'Tools-Refactoring'! +MessageSetWindow subclass: #InlineMethodWizardStepWindow + instanceVariableNames: 'applier' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!classDefinition: #InlineMethodImplementorsStepWindow category: #'Tools-Refactoring'! +InlineMethodWizardStepWindow subclass: #InlineMethodImplementorsStepWindow + instanceVariableNames: 'selectedImplementor' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!classDefinition: #InlineMethodImplementorsWithShowUsagesStepWindow category: #'Tools-Refactoring'! +InlineMethodImplementorsStepWindow subclass: #InlineMethodImplementorsWithShowUsagesStepWindow + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!classDefinition: #InlineMethodUsagesStepWindow category: #'Tools-Refactoring'! +InlineMethodWizardStepWindow subclass: #InlineMethodUsagesStepWindow + instanceVariableNames: 'changedMethods' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!classDefinition: #InlineMethodUsagesWithShowImplementorsStepWindow category: #'Tools-Refactoring'! +InlineMethodUsagesStepWindow subclass: #InlineMethodUsagesWithShowImplementorsStepWindow + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!classDefinition: #MessageNodeReference category: #'Tools-Refactoring'! +Object subclass: #MessageNodeReference + instanceVariableNames: 'messageNode selector classReference completeSourceRange methodNode stringVersion' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!classDefinition: #PossibleMessageNodeReference category: #'Tools-Refactoring'! +MessageNodeReference subclass: #PossibleMessageNodeReference + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!classDefinition: #InlineMethod category: #'Tools-Refactoring'! +Refactoring subclass: #InlineMethod + instanceVariableNames: 'methodToInline messageSendsToInline updatedSendersCode methodNodeToInline replacementsByMessageSend temporariesDeclarationsByNode temporariesToDeclareByInsertionPoint implementorCompleteSourceRanges removeMethod' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!classDefinition: #InlineTemporaryVariable category: #'Tools-Refactoring'! +Refactoring subclass: #InlineTemporaryVariable + instanceVariableNames: 'variableToInline methodToRefactor updatedSourceCode methodNode oldVariableNode usageToInline sourceCodeChanges methodOrBlockNodeDeclaringTemporary rangeOfNodeDeclaringTemporary assignmentToInlineRange endOfNodeEnclosingAssignment' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!classDefinition: #InlineMethodApplier category: #'Tools-Refactoring'! +RefactoringApplier subclass: #InlineMethodApplier + instanceVariableNames: 'selectorToInline scopeChoice implementors messageSends selectedClass wizardStepWindow shouldShowChanges browser shouldRemoveImplementor triggeringMessageSend shouldInlineTriggeringMessageSendOnly' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! +!classDefinition: #InlineTemporaryVariableApplier category: #'Tools-Refactoring'! +RefactoringApplier subclass: #InlineTemporaryVariableApplier + instanceVariableNames: 'codeProvider temporaryToInline usageInterval methodToRefactor' + classVariableNames: '' + poolDictionaries: '' + category: 'Tools-Refactoring'! + +!CompiledMethod methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:28:05'! +referencesSelf + + ^self methodNode referencesSelf! ! + +!CompiledMethod methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:28:09'! +referencesSuper + + ^self methodNode referencesSuper! ! + + +!Interval methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:29:34'! +includesAllOf: aCollection + + ^aCollection isInterval + ifTrue: [ (self includes: aCollection first) + and: [ (self includes: aCollection last) + and: [ self increment = aCollection increment or: [ super includesAllOf:aCollection ]]]] + ifFalse: [ super includesAllOf: aCollection ]! ! + + +!SourceCodeInterval methodsFor: 'source code' stamp: 'HAW 6/11/2022 19:30:38'! +codeAfterIntervalOn: aSourceCode + + ^ aSourceCode copyFrom: (self last + 1) to: aSourceCode size! ! + +!SourceCodeInterval methodsFor: 'source code' stamp: 'HAW 6/11/2022 19:36:07'! +expandUntilStartOfNextStatementOn: aSourceCode + + "Expands a source code interval containing a valid expression until the next statement. If there isn't one, the interval is not modified. + Examples: + - The interval *a := 1 + 2.* b = 3 + 4. is expanded to *a := 1 + 2. *b = 3 + 4. + - The interval *a := 1 + 2.* ' + b = 3 + 4. is expanded to + *a := 1 + 2. + *b = 3 + 4. + - The interval *| a b |* + a : =1. is expanded to + *| a b | + *a := 1. + + TODO: improve to take into account that there could be a comment in the middle of the statements or + after the last statement - Fernando" + + ((self last >= aSourceCode size) + or:[ (self isEndOfLastStatementOn: aSourceCode) + or:[self isLastStatementOfBlockOn: aSourceCode]]) ifTrue: [^self class from: self first to: self last]. + + ((self isEndOfTemporariesDeclarationOn: aSourceCode) or: [self endsOnDotOn: aSourceCode ]) + ifTrue: [^self expandUntilNextNonBlankCharacterOn: aSourceCode ]. + + (self nextNonBlankCharacterIsDotOn: aSourceCode) + ifTrue: [^(self expandUntilStatementEndOn: aSourceCode) expandUntilStartOfNextStatementOn: aSourceCode ]. + + self error: self class canNotExpandIncompleteStatementError. + ! ! + +!SourceCodeInterval methodsFor: 'source code' stamp: 'HAW 6/11/2022 19:34:10'! +expandUntilStatementEndOn: aSourceCode + + ^SourceCodeInterval + from: self first + to: (aSourceCode findDelimiters: '.' startingAt: self last) + ! ! + +!SourceCodeInterval methodsFor: 'source code' stamp: 'HAW 6/11/2022 19:34:23'! +lastCharacterOfRangeOn: aSourceCode + + ^aSourceCode at: self last! ! + +!SourceCodeInterval methodsFor: 'source code' stamp: 'HAW 6/11/2022 19:34:48'! +nextNonBlankCharacterIs: aCharacter on: aSourceCode + + | codeAfterInterval firstNonBlankIndex | + + codeAfterInterval := self codeAfterIntervalOn: aSourceCode. + + firstNonBlankIndex := codeAfterInterval firstNonSeparator. + + ^firstNonBlankIndex ~= 0 and: [(codeAfterInterval at: firstNonBlankIndex) = aCharacter] +! ! + +!SourceCodeInterval methodsFor: 'source code' stamp: 'HAW 6/11/2022 19:35:00'! +nextNonBlankCharacterIsDotOn: aSourceCode + + ^self nextNonBlankCharacterIs: $. on: aSourceCode. + ! ! + +!SourceCodeInterval methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:31:22'! +endsOnDotOn: aSourceCode + + ^(self lastCharacterOfRangeOn: aSourceCode) = $.! ! + +!SourceCodeInterval methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:32:09'! +intervalEndsOnEndOfStatementIn: aSourceCode + + ^(self endsOnDotOn: aSourceCode) + or: [ (self nextNonBlankCharacterIsDotOn: aSourceCode) + or: [self isEndOfTemporariesDeclarationOn: aSourceCode ]].! ! + +!SourceCodeInterval methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:31:03'! +isEndOfLastStatementOn: aSourceCode + + ^((self lastCharacterOfRangeOn: aSourceCode) isSeparator not) + and: [(self codeAfterIntervalOn: aSourceCode) firstNonSeparator = 0]. + ! ! + +!SourceCodeInterval methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:31:07'! +isEndOfTemporariesDeclarationOn: aSourceCode + + ^((self lastCharacterOfRangeOn: aSourceCode) = $|) and: [^(aSourceCode indexOf: $|) < self last]! ! + +!SourceCodeInterval methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:31:11'! +isLastStatementOfBlockOn: aSourceCode + + ^self nextNonBlankCharacterIs: $] on: aSourceCode.! ! + +!SourceCodeInterval methodsFor: 'source code' stamp: 'HAW 6/11/2022 18:57:06'! +expandUntilNextNonBlankCharacterOn: aSourceCode + + ^SourceCodeInterval from: self first to: (self last + + (aSourceCode copyFrom: (self last + 1) to: (aSourceCode size)) firstNonSeparator - 1) + ! ! + +!ParseNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:43:52'! +isMethodNode + + ^false! ! + +!ParseNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:44:17'! +referencesSelf + + ^ false! ! + +!ParseNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:44:05'! +referencesSuper + + ^false! ! + + +!AssignmentNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:44:54'! +referencesSelf + + ^variable referencesSelf or: [value referencesSelf]! ! + +!AssignmentNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:44:57'! +referencesSuper + + ^variable referencesSuper or: [value referencesSuper]! ! + + +!BlockNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:38:06'! +referencesSelf + + ^self statements anySatisfy: [:aParseNode | aParseNode referencesSelf]! ! + +!BlockNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:38:09'! +referencesSuper + + ^self statements anySatisfy: [:aParseNode | aParseNode referencesSuper]! ! + + +!MethodNode methodsFor: 'source mapping' stamp: 'HAW 6/11/2022 19:38:58'! +completeSourceRangesOf: requestedParseNode ifAbsent: emptySourceRangesBlock + "Returns the source ranges associated with the requested parse node." + + | completeSourceRanges | + + completeSourceRanges := Set new. + + "There may be more than one equivalent key in the complete source ranges map + if more than one block declare a temporary variable with the same name - Fernando" + self completeSourceRangesDo: [:parseNode :sourceRanges | + (parseNode equivalentTo: requestedParseNode) ifTrue: [completeSourceRanges addAll: sourceRanges]]. + + completeSourceRanges isEmpty ifFalse: [^completeSourceRanges ] ifTrue: [^emptySourceRangesBlock value]. + ! ! + +!MethodNode methodsFor: 'source mapping' stamp: 'HAW 6/11/2022 19:42:44'! +singleCompleteSourceRangeOf: requestedParseNode + "Returns the source range associated with the requested parse node. + Fails if there is no source range, or if there are multiple source ranges." + + ^self + singleCompleteSourceRangeOf: requestedParseNode + ifPresent: [ :sourceRange | sourceRange ] + ifAbsent: [ self error: 'could not find source range for node: ' , requestedParseNode printString ]! ! + +!MethodNode methodsFor: 'source mapping' stamp: 'HAW 6/11/2022 19:42:35'! +singleCompleteSourceRangeOf: requestedParseNode ifPresent: sourceRangePresentBlock ifAbsent: sourceRangeAbsentBlock + "Finds the source range associated with the requested parse node. + If it is present, evaluates sourceRangePresentBlock with the result. + Otherwise, it evaluates sourceRangeAbsentBlock. + Raises an error if the requested parse node has multiple source ranges" + | sourceRanges | + + sourceRanges := self + completeSourceRangesOf: requestedParseNode + ifAbsent: [^sourceRangeAbsentBlock value]. + + ^sourceRanges size > 1 + ifTrue: [self error: 'there are multiple source ranges for the parse node: ' , requestedParseNode printString ] + ifFalse: [sourceRangePresentBlock value: sourceRanges anyOne].! ! + +!MethodNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:39:19'! +equivalentTo: aParseNode + + ^ aParseNode isMethodNode + and: [ block equivalentTo: aParseNode block]! ! + +!MethodNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:41:48'! +isMethodNode + + ^true.! ! + +!MethodNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:38:25'! +referencesSelf + + ^block referencesSelf! ! + +!MethodNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:38:28'! +referencesSuper + + ^block referencesSuper! ! + + +!VariableNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:52:27'! +referencesSelf + + ^ self isSelfPseudoVariable ! ! + +!VariableNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:49:49'! +referencesSuper + + ^self isSuperPseudoVariable ! ! + +!SelectorNode methodsFor: 'testing' stamp: 'HAW 5/3/2020 22:39:23'! +isInfix + + ^key isInfix ! ! + +!MessageNode methodsFor: 'testing' stamp: 'HAW 5/3/2020 22:39:07'! +isInfix + + ^selector isInfix! ! + +!MessageNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:45:21'! +isKeywordMessageSend + + ^self selectorSymbol isKeyword! ! + +!MessageNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:46:12'! +referencesSelf + + ^self receiver referencesSelf + or: [self arguments anySatisfy: [:argument | argument referencesSelf]]! ! + +!MessageNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:46:16'! +referencesSuper + + ^self receiver referencesSuper + or: [self arguments anySatisfy: [:argument | argument referencesSuper]]! ! + +!MessageNode methodsFor: 'testing' stamp: 'HAW 8/3/2019 10:31:57'! +isUnaryMessageSend + + ^self selectorSymbol isUnary ! ! + +!ReturnNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:46:37'! +referencesSelf + + ^expr referencesSelf! ! + +!ReturnNode methodsFor: 'testing' stamp: 'HAW 6/11/2022 19:46:42'! +referencesSuper + + ^expr referencesSuper! ! + + +!SmalltalkEditor methodsFor: 'inline method' stamp: 'HAW 6/11/2022 19:58:26'! +contextualInlineMethod + + self isEditingClassDefinition ifTrue: [ ^morph flash ]. + self ifSourceCodeRefactoringCanBeAppliedDo: [ + self + withMethodNodeAndClassDo: [ :methodNode :selectedClass | self contextualInlineMethodOf: methodNode in: selectedClass ] + ifErrorsParsing: [ :anError | morph flash ] ] ! ! + +!SmalltalkEditor methodsFor: 'inline method' stamp: 'HAW 6/11/2022 19:58:29'! +contextualInlineMethod: aKeyboardEvent + + self contextualInlineMethod. + ^true. + + ! ! + +!SmalltalkEditor methodsFor: 'inline method' stamp: 'HAW 6/11/2022 19:58:33'! +contextualInlineMethodOf: aMethodNode in: aSelectedClass + + aMethodNode + withParseNodeIncluding: self startIndex + do: [ :nodeUnderCursor | + nodeUnderCursor isMessageNode ifFalse: [^morph flash]. + + ((aMethodNode completeSourceRangesOf: nodeUnderCursor ifAbsent: [self shouldNotHappen]) + detect: [ :aSourceRange | aSourceRange includes: self startIndex] + ifFound: [ :aSourceRange | | messageNodeReference | + messageNodeReference := MessageNodeReference + messageNode: nodeUnderCursor + selector: aMethodNode selector + class: aSelectedClass + completeSourceRange: aSourceRange. + self inlineMethodInUsage: messageNodeReference. ] + ifNone: [self shouldNotHappen ])] + ifAbsent: [ + self startIndex <= aMethodNode selectorLastPosition ifFalse: [ ^ morph flash ]. + + RefactoringApplier inlineMethodApplier + createAndValueHandlingExceptionsOn: model textProvider + forMethod: (MethodReference class: aSelectedClass selector: aMethodNode selector)] + +! ! + +!SmalltalkEditor methodsFor: 'inline method' stamp: 'HAW 6/11/2022 19:58:36'! +inlineMethodInUsage: aMessageNodeReference + + RefactoringApplier inlineMethodApplier + createAndValueHandlingExceptionsOn: model textProvider + forMessageSend: aMessageNodeReference.! ! + +!SmalltalkEditor methodsFor: 'inline temporaray variable' stamp: 'HAW 6/11/2022 19:58:40'! +inlineTemporaryVariable + + "To prevent the refactoring to be evaluated on editors w/o methods like the workspace - Fernando" + self hasValidCurrentCompiledMethod ifFalse: [ ^ nil ]. + + InlineTemporaryVariableApplier createAndValueHandlingExceptions: [ + InlineTemporaryVariableApplier + on: self + for: self selectionInterval asSourceCodeInterval + of: self codeProvider currentCompiledMethod ]! ! + +!SmalltalkEditor methodsFor: 'inline temporaray variable' stamp: 'HAW 6/11/2022 19:58:43'! +inlineTemporaryVariable: aKeyboardEvent + + self inlineTemporaryVariable. + ^true! ! + + +!BrowserWindow methodsFor: 'keyboard shortcuts' stamp: 'HAW 6/11/2022 20:00:51'! +messageListKey: aChar from: view + "Respond to a Command key. I am a model with a code pane, and I also + have a listView that has a list of methods. The view knows how to get + the list and selection." + + | sel | + sel _ model selectedMessageName. + sel + ifNotNil: [ + "The following require a method selection" + aChar = $R ifTrue: [^ self renameSelector]. + aChar = $U ifTrue: [^ self addParameter ]. + aChar = $I ifTrue: [^ self removeParameter ]. + aChar = $3 ifTrue: [^ self inlineMethod ]]. + super messageListKey: aChar from: view! ! + +!BrowserWindow methodsFor: 'refactorings' stamp: 'HAW 6/11/2022 19:59:39'! +inlineMethod + + model selectedMessageName ifNotNil: [ :selectorToInline | + RefactoringApplier inlineMethodApplier + createAndValueHandlingExceptionsOn: model + forMethod: (MethodReference class: model selectedClassOrMetaClass selector: selectorToInline )]! ! + +!BrowserWindow methodsFor: 'refactorings' stamp: 'HAW 6/11/2022 20:02:15'! +messageRefactoringMenu + + ^DynamicMenuBuilder buildTitled: 'Refactorings' targeting: self collectingMenuOptionsWith: #messageRefactoringMenuOptions.! ! + + +!MethodReference methodsFor: 'testing' stamp: 'HAW 6/11/2022 20:04:20'! +isMessageListTitle + + ^(self actualClass isKindOf: Object) and: [methodSymbol first = $_] +! ! + + +!RefactoringApplier class methodsFor: 'appliers - registering' stamp: 'HAW 6/11/2022 20:05:08'! +registerInlineMethodApplier: anInlineMethodApplierClass + + self registerApplierAt: self inlineMethodApplierId with: anInlineMethodApplierClass ! ! + +!RefactoringApplier class methodsFor: 'appliers - getting' stamp: 'HAW 6/11/2022 20:04:51'! +inlineMethodApplier + + ^self applierAt: self inlineMethodApplierId ifAbsent: [ InlineMethodApplier ]! ! + +!RefactoringApplier class methodsFor: 'appliers - id' stamp: 'HAW 6/11/2022 20:05:00'! +inlineMethodApplierId + + ^#inlineMethodApplier! ! + +!RefactoringApplier class methodsFor: 'appliers - resetting' stamp: 'HAW 6/11/2022 20:05:19'! +resetInlineMethodApplier + + self resetApplierAt: self inlineMethodApplierId ! ! + + +!RefactoringMenues class methodsFor: 'editor menus' stamp: 'HAW 6/11/2022 20:06:01'! +messageRefactoringMenuOptions + + ^ `{ + { + #itemGroup -> 10. + #itemOrder -> 10. + #label -> 'rename... (R)'. + #selector -> #renameSelector. + #icon -> #saveAsIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 15. + #label -> 'change keyword order...'. + #selector -> #changeKeywordOrder. + #icon -> #sendReceiveIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 20. + #label -> 'add parameter...'. + #selector -> #addParameter. + #icon -> #listAddIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 30. + #label -> 'remove parameter...'. + #selector -> #removeParameter. + #icon -> #listRemoveIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 40. + #label -> 'push up'. + #selector -> #pushUpSelector. + #icon -> #goTopIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 50. + #label -> 'push down'. + #selector -> #pushDownSelector. + #icon -> #goBottomIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 60. + #label -> 'move to instance/class method'. + #selector -> #moveToInstanceOrClassMethod. + #icon -> #changesIcon + } asDictionary. + { + #itemGroup -> 10. + #itemOrder -> 70. + #label -> 'inline method... (3)'. + #selector -> #inlineMethod. + #icon -> #saveAsIcon + } asDictionary. + }`. + + ! ! + +!RefactoringMenues class methodsFor: 'editor menus' stamp: 'HAW 6/11/2022 20:06:58'! +smalltalkEditorMenuOptions + + ^`{ + { + #itemGroup -> 35. + #itemOrder -> 10. + #label -> 'Rename... (R)'. + #selector -> #contextualRename. + #icon -> #saveAsIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 20. + #label -> 'Extract Temporary... (J)'. + #selector -> #extractToTemporary. + #icon -> #saveAsIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 30. + #label -> 'Extract Method... (K)'. + #selector -> #extractMethod. + #icon -> #saveAsIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 40. + #label -> 'Inline Temporary... (2)'. + #selector -> #inlineTemporaryVariable. + #icon -> #saveAsIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 50. + #label -> 'More Refactorings...'. + #selector -> #openSmalltalkEditorRefactoringMenu. + #icon -> #listAddIcon + } asDictionary. + }`! ! + +!RefactoringMenues class methodsFor: 'editor menus' stamp: 'HAW 6/11/2022 20:07:45'! +smalltalkEditorRefactoringMenuOptions + + ^`{ + { + #itemGroup -> 35. + #itemOrder -> 30. + #label -> 'Add Parameter... (A)'. + #selector -> #contextualAddParameter. + #icon -> #listAddIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 35. + #label -> 'Extract as Parameter... (1)'. + #selector -> #contextualExtractAsParameter. + #icon -> #listAddIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 40. + #label -> 'Remove Parameter... (S)'. + #selector -> #contextualRemoveParameter. + #icon -> #listRemoveIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 50. + #label -> 'Temporary to Instance Variable (O)'. + #selector -> #temporaryToInstanceVariable. + #icon -> #saveAsIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 60. + #label -> 'Push Up Instance Variable'. + #selector -> #contextualPushUpInClassDefinition. + #icon -> #goTopIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 70. + #label -> 'Push Down Instance Variable'. + #selector -> #contextualPushDownInClassDefinition. + #icon -> #goBottomIcon + } asDictionary. + { + #itemGroup -> 35. + #itemOrder -> 80. + #label -> 'Inline Method... (3)'. + #selector -> #contextualInlineMethod. + #icon -> #saveAsIcon + } asDictionary. + }`! ! + +!RefactoringMenues class methodsFor: 'shortcuts' stamp: 'HAW 6/11/2022 20:06:27'! +smalltalkEditorCmdShortcutsSpec + + " + SmalltalkEditor initializeCmdShortcuts + " + ^#( + #($R #contextualRename: 'Renames what is under cursor') + #($A #contextualAddParameter: 'Adds parameter to message that is under cursor') + #($S #contextualRemoveParameter: 'Removes parameter to message that is under cursor') + #($O #temporaryToInstanceVariable: 'Extracts temporary variable to instance variable') + #($J #extractToTemporary: 'Extracts the selected code into a temporary variable') + #($K #extractMethod: 'Extracts the selected code into a separate method') + #($1 #contextualExtractAsParameter: 'Extracts the selected code as parameter') + #($2 #inlineTemporaryVariable: 'Inlines the selected temporary variable into each usage') + #($3 #contextualInlineMethod: 'Inlines the selected message send into desired colaborations') + )! ! + +!methodRemoval: MethodNode #hasTemporaryNamed: stamp: 'HAW 6/11/2022 19:41:22'! +MethodNode removeSelector: #hasTemporaryNamed:! + +!InlineMethod commentStamp: '' prior: 0! +I am a refactoring that replaces message sends in the sender with the body of the target method , replacing the parameters as needed. +Implementation notes: + +- I can refactor multiple message sends at the same time. +- I can delete the target method.! + + +!InlineMethod methodsFor: 'changes' stamp: 'FB 11/22/2021 17:01:21'! +changedMethods + + | changedMethods | + + changedMethods := (messageSendsToInline collect: [:aMessageNodeReference | aMessageNodeReference methodReference ]) asSet. + removeMethod ifTrue: [changedMethods add: methodToInline methodReference]. + ^changedMethods.! ! + + +!InlineMethod methodsFor: 'applying' stamp: 'FB 5/21/2022 16:49:59'! +apply + + messageSendsToInline do: [:aMessageNodeReference | self inlineMessageSend: aMessageNodeReference]. + self declareNecessaryTemporaries. + removeMethod ifTrue: [self removeMethodToInline]. + self compileChanges. + + ^self changedMethods! ! + + +!InlineMethod methodsFor: 'temporaries declaration - private' stamp: 'FB 11/4/2021 22:04:44'! +declareNecessaryTemporaries + + temporariesToDeclareByInsertionPoint keysAndValuesDo: [:aSenderAndPosition :temporariesToDeclare | + | sender positionToInsertTemporaries temporariesString | + sender := aSenderAndPosition key. + positionToInsertTemporaries := aSenderAndPosition value. + temporariesString := temporariesToDeclare reduce: [:t1 : t2 | t1 value, ' ', t2 value]. + ((sender methodNode parseNodesPathAt: positionToInsertTemporaries ifAbsent: [self shouldNotHappen ]) first key isTemporariesDeclaration) + ifTrue: [ + self replaceRange: (positionToInsertTemporaries to: positionToInsertTemporaries) + withNewSourceCode: temporariesString, ' |' + inMethod: sender. + ] + ifFalse: [ + self replaceRange: (positionToInsertTemporaries to: positionToInsertTemporaries) + withNewSourceCode: '| ', temporariesString, ' |', Character newLineCharacter asString + inMethod: sender + ] + ]! ! + +!InlineMethod methodsFor: 'temporaries declaration - private' stamp: 'HAW 6/11/2022 19:07:59'! +declareTemporaries: temporariesToDeclare in: aMethodOrBlockNode of: aSenderMethod + + | positionToInsertNewVariablesDeclarations renamedTemporaries temporariesToDeclareInPosition| + + renamedTemporaries := self renameTemporariesIfNeeded: temporariesToDeclare accordingToNode: aMethodOrBlockNode of: aSenderMethod. + + aMethodOrBlockNode hasTemporaryVariables + ifTrue: [ + positionToInsertNewVariablesDeclarations := (aSenderMethod methodNode + singleCompleteSourceRangeOf: (aMethodOrBlockNode temporariesDeclaration)) last. + ] + ifFalse: [ + | firstStatementRange | + firstStatementRange := aSenderMethod methodNode singleCompleteSourceRangeOf: (aMethodOrBlockNode statements first). + positionToInsertNewVariablesDeclarations := firstStatementRange first. + ]. + temporariesToDeclareInPosition := self temporariesToDeclareByInsertionPoint: (aSenderMethod -> positionToInsertNewVariablesDeclarations). + temporariesToDeclareInPosition addAll: (renamedTemporaries collect: [:aReplacementAssociation | aReplacementAssociation value]). + ^renamedTemporaries. + ! ! + +!InlineMethod methodsFor: 'temporaries declaration - private' stamp: 'HAW 6/11/2022 19:05:49'! +declareTemporaries: temporariesToDeclare inBlockOf: aMessageNodeReference + + | methodOrBlockNodeDeclaringNewVariables renamedTemporaries replacements | + + methodOrBlockNodeDeclaringNewVariables := self enclosingBlockOf: aMessageNodeReference. + renamedTemporaries := self declareTemporaries: temporariesToDeclare in: methodOrBlockNodeDeclaringNewVariables of: aMessageNodeReference compiledMethod. + + replacements := self replacementsMapForMessageSend: aMessageNodeReference . + renamedTemporaries do: [:oldVariableAndNewName | + (self findRangesOf: oldVariableAndNewName key in: implementorCompleteSourceRanges) do: [:range | + replacements at: range put: oldVariableAndNewName value. + ] + ] + ! ! + +!InlineMethod methodsFor: 'temporaries declaration - private' stamp: 'FB 11/4/2021 23:14:31'! +declareTemporariesIfNeededFor: aMessageNodeReference + + | implementorTemporaries | + + implementorTemporaries := methodNodeToInline temporariesDeclaration allDeclaredVariableNodes. + implementorTemporaries isEmpty ifFalse: [self declareTemporaries: implementorTemporaries + inBlockOf: aMessageNodeReference]. + ! ! + +!InlineMethod methodsFor: 'temporaries declaration - private' stamp: 'HAW 6/11/2022 19:04:49'! +renameTemporariesIfNeeded: temporariesToDeclare accordingToNode: aMethodOrBlockNode of: aSenderMethod + + "If a temporary to declare already exists in the scope, a new fresh name + will be found for it. The method returns an OrderedCollection of (variableNode -> newVariableName) + replacements. If the variable does not need a rename, it will still be added to the collection. + This method also adds the new name to the map that tracks temporaries + names in scope for the requested method or block node across the whole refactoring - Fernando" + + | alreadyDeclaredTemporaries newTemporaries | + + newTemporaries := OrderedCollection new: temporariesToDeclare size. + alreadyDeclaredTemporaries := self declaredTemporariesFor: aMethodOrBlockNode ofSender: aSenderMethod. + temporariesToDeclare do: [:temporary | + | finalTemporaryName index | + finalTemporaryName := temporary name. + index := 1. + [alreadyDeclaredTemporaries includes: finalTemporaryName] whileTrue: [ + finalTemporaryName := temporary name, index asString. + index := index + 1. + ]. + alreadyDeclaredTemporaries add: finalTemporaryName. + newTemporaries add: (temporary -> finalTemporaryName). + ]. + + ^newTemporaries.! ! + +!InlineMethod methodsFor: 'temporaries declaration - private' stamp: 'HAW 6/11/2022 19:07:59'! +temporariesToDeclareByInsertionPoint: aSenderAndPosition + + ^temporariesToDeclareByInsertionPoint keys + detect: [:senderAndPosition | senderAndPosition = aSenderAndPosition] + ifFound: [ :key | temporariesToDeclareByInsertionPoint at: key ] + ifNone: [| temporariesToDeclareAtInsertionPoint | + temporariesToDeclareAtInsertionPoint := OrderedCollection new. + temporariesToDeclareByInsertionPoint at: aSenderAndPosition put: temporariesToDeclareAtInsertionPoint. + temporariesToDeclareAtInsertionPoint]. + ! ! + + +!InlineMethod methodsFor: 'applying primitives - private' stamp: 'FB 11/22/2021 17:32:45'! +compileChanges + + updatedSendersCode keysAndValuesDo: [:aMethodReference :aCollectionOfChanges | + | updatedSenderSourceCode | + + updatedSenderSourceCode := aMethodReference sourceCode copyReplacing: aCollectionOfChanges. + aMethodReference methodClass compile: updatedSenderSourceCode classified: aMethodReference category + ].! ! + +!InlineMethod methodsFor: 'applying primitives - private' stamp: 'HAW 6/11/2022 19:06:09'! +declaredTemporariesFor: aParseNode ofSender: aSender + + ^temporariesDeclarationsByNode keys + detect: [:senderAndNode | senderAndNode key = aSender and: [senderAndNode value equivalentTo: aParseNode]] + ifFound: [ :key | temporariesDeclarationsByNode at: key] + ifNone: [| temporariesAndArgsDict | + + temporariesAndArgsDict := self temporariesAndArgsInScopeOf: aParseNode ofSender: aSender. + temporariesDeclarationsByNode at: (aSender -> aParseNode) put: temporariesAndArgsDict. + temporariesAndArgsDict]. + + + ! ! + +!InlineMethod methodsFor: 'applying primitives - private' stamp: 'FB 3/31/2022 22:59:39'! +enclosingBlockOf: aMessageNodeReferenceWithReturnValue + + | parseNodeSourceRange methodNode | + + methodNode := aMessageNodeReferenceWithReturnValue methodNode. + parseNodeSourceRange := aMessageNodeReferenceWithReturnValue completeSourceRange. + ^self enclosingBlockOf: parseNodeSourceRange in: methodNode.! ! + +!InlineMethod methodsFor: 'applying primitives - private' stamp: 'FB 3/31/2022 23:01:25'! +enclosingBlockOf: aParseNodeSourceRange in: aMethodNode + + aMethodNode completeSourceRangesDo: [ :parseNode :sourceRanges | + (parseNode isBlockNode + and: [ parseNode ~= aMethodNode ] + and: [ sourceRanges anySatisfy: [ :sourceRange | + sourceRange first < aParseNodeSourceRange first and: [ sourceRange last > aParseNodeSourceRange last ] ] ]) + ifTrue: [ ^ parseNode ] + ]. + ^aMethodNode.! ! + +!InlineMethod methodsFor: 'applying primitives - private' stamp: 'FB 7/13/2021 01:17:58'! +findRangesOf: aNode in: completeSourceRanges + "This is needed because the map of source ranges compares nodes by memory + instead of using equivalentTo: -- Fernando" + + completeSourceRanges keysAndValuesDo: [:aParseNode :sourceRanges | + (aParseNode equivalentTo: aNode) ifTrue: [^sourceRanges] + ]. + ^#(). + ! ! + +!InlineMethod methodsFor: 'applying primitives - private' stamp: 'FB 9/5/2021 20:43:20'! +findSourceRangeOf: aMessageNodeWithReturnValue in: aSenderMethod + + ^ (aSenderMethod methodNode completeSourceRangesOf: aMessageNodeWithReturnValue ifAbsent: [self shouldNotHappen]) anyOne! ! + +!InlineMethod methodsFor: 'applying primitives - private' stamp: 'FB 10/31/2021 23:29:24'! +removeMethodToInline + + methodToInline methodClass removeSelector: methodToInline selector.! ! + +!InlineMethod methodsFor: 'applying primitives - private' stamp: 'FB 11/22/2021 17:31:25'! +replaceRange: aSourceCodeInterval withNewSourceCode: newSourceCode inMethod: aCompiledMethod + + | currentUpdates sourceCodeReplacement| + + sourceCodeReplacement := newSourceCode. + ((aSourceCodeInterval last < aCompiledMethod sourceCode size) and: [((aCompiledMethod sourceCode at: aSourceCodeInterval last + 1) = $.)]) + ifTrue: [sourceCodeReplacement := newSourceCode copyUpToLast: $.]. + "It's important to use < and not <= because temporaries declarations are added to the changes collection + after the changes concerning the inlining of the implementor code, but they need to be replaced first - Fernando" + currentUpdates := updatedSendersCode at: aCompiledMethod methodReference ifAbsent: (SortedCollection sortBlock: [ :left :right | left key first < right key first ]). + currentUpdates add: (aSourceCodeInterval -> sourceCodeReplacement). + updatedSendersCode at: aCompiledMethod methodReference put: currentUpdates. + ! ! + +!InlineMethod methodsFor: 'applying primitives - private' stamp: 'HAW 6/11/2022 19:05:49'! +replacementsMapForMessageSend: aMessageNodeReference + + ^replacementsByMessageSend keys + detect: [:messageNodeReference | messageNodeReference equivalentTo: aMessageNodeReference] + ifFound: [ :key | replacementsByMessageSend at: key ] + ifNone: [| replacementsDict | + + replacementsDict := Dictionary new. + replacementsByMessageSend at: aMessageNodeReference put: replacementsDict. + replacementsDict ]. + + ! ! + +!InlineMethod methodsFor: 'applying primitives - private' stamp: 'FB 6/28/2021 21:08:59'! +sourceCodeOfNode: aParseNode ofSender: aSender using: completeSourceCodeRanges + + completeSourceCodeRanges keysAndValuesDo: [:aNode :aCollectionOfRanges | + (aNode equivalentTo: aParseNode) ifTrue: [ |range| + range := aCollectionOfRanges anyOne. + ^aSender sourceCode copyFrom: range first to: range last + ] + ]. + self shouldNotHappen.! ! + +!InlineMethod methodsFor: 'applying primitives - private' stamp: 'HAW 6/11/2022 19:06:09'! +temporariesAndArgsInScopeOf: aParseNode ofSender: aSender + + | enclosingNodes parseNodeRange methodNode temporariesInScope | + + temporariesInScope := Set new. + methodNode := aSender methodNode. + methodNode arguments size > 0 ifTrue: [temporariesInScope addAll: (methodNode arguments collect: [:arg | arg name])]. + methodNode hasTemporaryVariables + ifTrue: [temporariesInScope addAll: (methodNode temporariesDeclaration allDeclaredVariableNodes + collect: [:temporaryNode | temporaryNode name])]. + (aParseNode isKindOf: BlockNode) ifTrue: [ + parseNodeRange := (methodNode singleCompleteSourceRangeOf: aParseNode). + enclosingNodes := (methodNode parseNodesPathAt: parseNodeRange first ifAbsent: [self shouldNotHappen]) + collect: [:nodeAndRange | nodeAndRange key]. + enclosingNodes do: [:enclosingNode | + enclosingNode isBlockNode ifTrue: [ + enclosingNode hasTemporaryVariables + ifTrue: [temporariesInScope addAll: (enclosingNode temporariesDeclaration allDeclaredVariableNodes + collect: [:temporaryNode | temporaryNode name])]. + enclosingNode arguments size > 0 + ifTrue: [temporariesInScope addAll: (enclosingNode arguments collect: [:temporaryNode | temporaryNode name])]. + ]. + ]. + ]. + + ^temporariesInScope + + + + ! ! + + +!InlineMethod methodsFor: 'source code building - private' stamp: 'HAW 6/11/2022 18:58:18'! +addParenthesesIfNeededTo: anExpression + + "TODO: duplicated code in InlineTemporaryVariable" + + | firstCharacterIsOpeningParentheses lastCharacterIsClosingParentheses | + + firstCharacterIsOpeningParentheses := (anExpression at: (anExpression firstNonSeparator)) = $(. + lastCharacterIsClosingParentheses := (anExpression at: (anExpression lastNonSeparator)) = $). + + ^(firstCharacterIsOpeningParentheses and: [lastCharacterIsClosingParentheses]) + ifTrue: [^anExpression] + ifFalse: [^'(', anExpression, ')'].! ! + +!InlineMethod methodsFor: 'source code building - private' stamp: 'HAW 6/11/2022 19:05:49'! +buildInlinedSourceCodeStatementsFrom: statementsToInline withParametersFrom: aMessageNodeReference removingReturn: removeReturn + + | inlinedStatements senderCompleteSourceRanges argumentsAndTemporariesReplacements indentation | + + senderCompleteSourceRanges := aMessageNodeReference methodNode completeSourceRanges. + self calculateReplacementsFrom: aMessageNodeReference + usingRanges: senderCompleteSourceRanges. + + self declareTemporariesIfNeededFor: aMessageNodeReference. + argumentsAndTemporariesReplacements := self replacementsMapForMessageSend: aMessageNodeReference. + + indentation := self indentationUpTo: aMessageNodeReference completeSourceRange first in: aMessageNodeReference compiledMethod sourceCode. + inlinedStatements := indentation, ((statementsToInline collect: [:aStatementToInline | + self sourceCodeOfImplementorStatement: aStatementToInline withReplacements: argumentsAndTemporariesReplacements removingReturn: removeReturn + ]) + reduce: [:aStatementWithReplacements :nextStatementWithReplacements | + aStatementWithReplacements, Character newLineCharacter asString, indentation, + (nextStatementWithReplacements copyReplaceAll: String newLineString with: String newLineString, indentation asTokens: false)]). + + ^inlinedStatements.! ! + +!InlineMethod methodsFor: 'source code building - private' stamp: 'HAW 6/11/2022 19:05:49'! +buildInlinedSourceCodeStatementsFrom: statementsToInline withParametersFrom: aMessageNodeReference usedInNode: aParseNode + + | inlinedStatements argumentsAndTemporariesReplacements senderCompleteSourceRanges usageNodeSourceRange + inlinedUsageStatement statementsWithReplacements indentation | + + senderCompleteSourceRanges := aMessageNodeReference methodNode completeSourceRanges. + usageNodeSourceRange := (self findRangesOf: aParseNode in: senderCompleteSourceRanges) first. + + self calculateReplacementsFrom: aMessageNodeReference + usingRanges: senderCompleteSourceRanges. + + self declareTemporariesIfNeededFor: aMessageNodeReference. + argumentsAndTemporariesReplacements := self replacementsMapForMessageSend: aMessageNodeReference. + + statementsWithReplacements := statementsToInline collect: [:aStatementToInline | + self sourceCodeOfImplementorStatement: aStatementToInline withReplacements: argumentsAndTemporariesReplacements removingReturn: true]. + indentation := self indentationUpTo: usageNodeSourceRange first in: aMessageNodeReference compiledMethod sourceCode. + + statementsWithReplacements size > 1 + ifTrue: [inlinedStatements := indentation, ((statementsWithReplacements allButLast) + reduce: [:aStatementWithReplacements :nextStatementWithReplacements | + aStatementWithReplacements, String newLineString, indentation, (nextStatementWithReplacements + copyReplaceAll: String newLineString with: String newLineString, indentation asTokens: false) ])] + ifFalse: [inlinedStatements := '']. + inlinedUsageStatement := self statementWithMessageSend: aMessageNodeReference usedIn: aParseNode + lastStatement: statementsToInline last replacement: statementsWithReplacements last. + + statementsWithReplacements size > 1 + ifTrue: [inlinedStatements := inlinedStatements, String newLineString, indentation, inlinedUsageStatement] + ifFalse: [inlinedStatements := inlinedUsageStatement ]. + + ^inlinedStatements.! ! + +!InlineMethod methodsFor: 'source code building - private' stamp: 'HAW 6/11/2022 19:05:49'! +calculateParameterReplacementsFrom: aMessageNodeReference withRanges: senderRanges + + "Return a Dict of (sourceRange -> string) where the source range belongs to a parameter usage + in the implementor method and the string is the variable name passed as that used parameter + in the message node + E.g. + + m1: aParam + + ^aParam + + --- + m2 + ^m1:2 + + then the Dict would have one entry: ( -> 2)" + | replacements | + + replacements := self replacementsMapForMessageSend: aMessageNodeReference. + methodToInline methodNode arguments withIndexDo: [:anArgumentNode :argIndex | | passedArgument | + passedArgument := aMessageNodeReference messageNode arguments at: argIndex. + (self findRangesOf: anArgumentNode in: implementorCompleteSourceRanges) do: [:aRange | + replacements at: aRange put: (self sourceCodeOfNode: passedArgument ofSender: aMessageNodeReference compiledMethod using: senderRanges).] + + ]. + ^replacements.! ! + +!InlineMethod methodsFor: 'source code building - private' stamp: 'HAW 6/11/2022 19:05:49'! +calculateReplacementsFrom: aMessageNodeReference usingRanges: senderRanges + + "Return a Dict of (sourceRange -> string) where the source range belongs to a parameter usage + or self reference in the implementor method and the string is the variable name passed as + that used parameter in the message node, or the receiver of the message to inline for self references + E.g. + + m1: aParam + + ^aParam + + --- + m2 + ^m1:2 + + then the Dict would have one entry: ( -> 2)" + | replacements | + + replacements := self replacementsMapForMessageSend: aMessageNodeReference. + methodToInline methodNode arguments withIndexDo: [:anArgumentNode :argIndex | | passedArgument | + passedArgument := aMessageNodeReference messageNode arguments at: argIndex. + (self findRangesOf: anArgumentNode in: implementorCompleteSourceRanges) do: [:aRange | + replacements at: aRange put: (self sourceCodeOfNode: passedArgument ofSender: aMessageNodeReference compiledMethod using: senderRanges).] + + ]. + + methodToInline methodNode nodesDo: [:aParseNode | (aParseNode isVariableNode and: [aParseNode referencesSelf]) ifTrue: [ + (self findRangesOf: aParseNode in: implementorCompleteSourceRanges) do: [:rangeOfSelfReference | + "Given previous validations, we can be sure that the receiver is a variable node" + replacements at: rangeOfSelfReference put: aMessageNodeReference messageNode receiver name. + ] + ]]. + ^replacements.! ! + +!InlineMethod methodsFor: 'source code building - private' stamp: 'FB 11/16/2021 20:18:53'! +indentationUpTo: anIndex in: aSourceCode + + | indentation currentIndex character| + + currentIndex := anIndex - 1. + indentation := ''. + + [currentIndex > 0 and: [ + character := (aSourceCode at: currentIndex). + (character = Character tab) or: [character = Character space] + ]] whileTrue: [ + indentation := indentation, character asString. + currentIndex := currentIndex - 1. + ]. + + ^(character = Character newLineCharacter) ifFalse: [^''] ifTrue: [^indentation reversed].! ! + +!InlineMethod methodsFor: 'source code building - private' stamp: 'FB 6/27/2021 19:35:43'! +removeReturnSelfStatementIfNeeded: aCollectionOfStatements + + (aCollectionOfStatements last isReturnSelf) + ifTrue: [aCollectionOfStatements removeLast]. + + ^aCollectionOfStatements! ! + +!InlineMethod methodsFor: 'source code building - private' stamp: 'FB 3/13/2022 17:44:17'! +sourceCodeOfImplementorStatement: aStatementToInline withReplacements: replacementsDict removingReturn: removeReturn + + | sourceRange originalSourceCode statementReplacements | + + sourceRange := (self findRangesOf: aStatementToInline in: implementorCompleteSourceRanges) anyOne. + originalSourceCode := methodToInline sourceCode copyFrom: sourceRange first to: sourceRange last. + "Replacements must be adjusted because the statement string begins at index 1 instead of the + original position on the source code" + statementReplacements := ((replacementsDict associations select: [:anAssociation | sourceRange includesAllOf: (anAssociation key)]) + collect: [:anAssociation | ((anAssociation key first - sourceRange first + 1) to: (anAssociation key last - sourceRange first + 1)) -> anAssociation value]) + asSortedCollection: [ :left :right | left key first < right key first ]. + + "Remove the return character if present" + (removeReturn and: [aStatementToInline isReturn]) ifTrue: [statementReplacements add: (1 to: 1) -> '']. + ^(originalSourceCode copyReplacing: statementReplacements), '.'.! ! + +!InlineMethod methodsFor: 'source code building - private' stamp: 'FB 11/21/2021 20:29:45'! +statementWithMessageSend: aMessageNodeReference usedIn: aParseNode inlinedWith: anExpression addingParentheses: addParentheses + + | sourceRangeOfUsage usageNodeSourceRange normalizedMessageSendRange expression| + + usageNodeSourceRange := (self findRangesOf: aParseNode in: aMessageNodeReference methodNode completeSourceRanges) first. + sourceRangeOfUsage := aMessageNodeReference completeSourceRange. + normalizedMessageSendRange := (sourceRangeOfUsage first - usageNodeSourceRange first + 1) + to: (sourceRangeOfUsage last - usageNodeSourceRange first + 1). + expression := addParentheses ifTrue: [(self addParenthesesIfNeededTo: (anExpression copyUpToLast: $.)), '.'] ifFalse: [anExpression]. + + ^(aMessageNodeReference compiledMethod sourceCode copyFrom: usageNodeSourceRange first to: usageNodeSourceRange last) + copyReplacing: (Array with: ((normalizedMessageSendRange -> expression)))! ! + +!InlineMethod methodsFor: 'source code building - private' stamp: 'FB 3/13/2022 17:44:17'! +statementWithMessageSend: aMessageNodeReference usedIn: aParseNode lastStatement: implementorLastStatementToInline + replacement: lastStatementWithReplacements + + | inlinedStatementContainingMessageSend | + + implementorLastStatementToInline expr isMessageNode + ifTrue: [ | senderSourceRange enclosingNode | + senderSourceRange := aMessageNodeReference completeSourceRange. + (aMessageNodeReference methodNode parseNodesPathAt: senderSourceRange first + ifAbsent: [self shouldNotHappen]) + detect: [:aNodeAndRange | (aNodeAndRange value includesAllOf: senderSourceRange) + and: [aNodeAndRange value first < senderSourceRange first]] + ifFound: [:aNodeAndRange | + enclosingNode := aNodeAndRange key. + ] + ifNone: [self shouldNotHappen]. + inlinedStatementContainingMessageSend := self statementWithMessageSend: aMessageNodeReference usedIn: aParseNode + inlinedWith: lastStatementWithReplacements addingParentheses: enclosingNode isMessageNode. + ] + ifFalse: [ + inlinedStatementContainingMessageSend := self statementWithMessageSend: aMessageNodeReference usedIn: aParseNode + inlinedWith: lastStatementWithReplacements addingParentheses: false. + ]. + + ^inlinedStatementContainingMessageSend.! ! + + +!InlineMethod methodsFor: 'inlining - private' stamp: 'FB 3/13/2022 17:44:17'! +findOutermostStatementContaining: aMessageNodeReference enclosedBy: enclosingBlock ifFound: ifFoundBlock ifNone: ifNoneBlock + + | usageNodesPath isDifferentMessageNode isIncludedInBlock | + + usageNodesPath := aMessageNodeReference methodNode parseNodesPathAt: aMessageNodeReference completeSourceRange first + ifAbsent: [self shouldNotHappen]. + isDifferentMessageNode := [:aNode | aNode isMessageNode and: [(aNode equivalentTo: aMessageNodeReference messageNode) not]]. + isIncludedInBlock := [:aRange | |sourceRangeOfEnclosingBlock | + sourceRangeOfEnclosingBlock := enclosingBlock isBlockNode + ifTrue: [self findSourceRangeOf: enclosingBlock in: aMessageNodeReference compiledMethod.] + ifFalse: [(1 to: aMessageNodeReference compiledMethod sourceCode size)]. + sourceRangeOfEnclosingBlock includesAllOf: aRange. + ]. + usageNodesPath reversed + detect: [:aNodeAndRange | | node range | + node := aNodeAndRange key. + range := aNodeAndRange value. + ((node isAssignmentNode or: [isDifferentMessageNode value: node]) and: [isIncludedInBlock value: range]) + ] + ifFound: [:aNodeAndRange | ^ifFoundBlock value: aNodeAndRange] + ifNone: [^ifNoneBlock value]. + + + + + ! ! + +!InlineMethod methodsFor: 'inlining - private' stamp: 'FB 3/6/2022 14:52:08'! +inlineMessageSend: aMessageNodeReference + + | statementsToInline | + + statementsToInline := self removeReturnSelfStatementIfNeeded: (methodToInline methodNode block statements). + statementsToInline isEmpty ifTrue: [^self]. + statementsToInline last isReturn + ifTrue: [self inlineStatements: statementsToInline ofMessageWithReturnValue: aMessageNodeReference.] + ifFalse: [self inlineStatements: statementsToInline ofMessageWithoutAssigningPossibleReturnValue: aMessageNodeReference + removingReturn: true]. + + + ! ! + +!InlineMethod methodsFor: 'inlining - private' stamp: 'FB 5/25/2022 20:44:39'! +inlineStatements: statementsToInline ofMessageWithReturnValue: aMessageNodeReferenceWithReturnValue + + | enclosingBlock | + + enclosingBlock := self enclosingBlockOf: aMessageNodeReferenceWithReturnValue. + (self parseNode: enclosingBlock returns: aMessageNodeReferenceWithReturnValue messageNode) + ifTrue: [^self inlineStatements: statementsToInline ofMessageWithoutAssigningPossibleReturnValue: aMessageNodeReferenceWithReturnValue + removingReturn: false]. + + "Find the outermost statement containing the usage to inline that's inside the enclosing block" + self findOutermostStatementContaining: aMessageNodeReferenceWithReturnValue enclosedBy: enclosingBlock + ifFound: [ :outermostNodeAndRange | + self inlineStatements: statementsToInline ofMessageWithReturnValue: aMessageNodeReferenceWithReturnValue + usedInParseNode: outermostNodeAndRange key + ] + ifNone: [ | includeLastStatement statements lastStatementOfEnclosingBlock | + lastStatementOfEnclosingBlock := (self removeReturnSelfStatementIfNeeded: + ((enclosingBlock isBlockNode ifTrue: enclosingBlock ifFalse: enclosingBlock block) + statements)) last. + includeLastStatement := (lastStatementOfEnclosingBlock equivalentTo: aMessageNodeReferenceWithReturnValue messageNode) + or: [lastStatementOfEnclosingBlock equivalentTo: aMessageNodeReferenceWithReturnValue messageNode asReturnNode]. + statements := includeLastStatement ifTrue: statementsToInline ifFalse: statementsToInline allButLast. + self inlineStatements: statements ofMessageWithoutAssigningPossibleReturnValue: aMessageNodeReferenceWithReturnValue + removingReturn: true + ] + + + + + ! ! + +!InlineMethod methodsFor: 'inlining - private' stamp: 'FB 11/16/2021 21:29:22'! +inlineStatements: statementsToInline ofMessageWithReturnValue: aMessageNodeWithReturnValueReference usedInParseNode: aParseNode + + | inlinedStatements sourceRangeOfUsage senderMethod| + + inlinedStatements := self buildInlinedSourceCodeStatementsFrom: statementsToInline withParametersFrom: aMessageNodeWithReturnValueReference + usedInNode: aParseNode. + + senderMethod := aMessageNodeWithReturnValueReference compiledMethod. + sourceRangeOfUsage := self findSourceRangeOf: aParseNode in: senderMethod. + + self replaceRange: sourceRangeOfUsage withNewSourceCode: inlinedStatements inMethod: senderMethod. + + + ! ! + +!InlineMethod methodsFor: 'inlining - private' stamp: 'FB 5/18/2022 15:01:06'! +inlineStatements: statementsToInline ofMessageWithoutAssigningPossibleReturnValue: aMessageNodeReference removingReturn: removeReturn + + | inlinedStatements sourceRangeToReplace senderMethod senderSourceCode | + + senderMethod := aMessageNodeReference compiledMethod. + senderSourceCode := aMessageNodeReference compiledMethod sourceCode. + statementsToInline isEmpty + ifTrue: [ + inlinedStatements := ''. + sourceRangeToReplace := aMessageNodeReference completeSourceRange asSourceCodeInterval + expandUntilStartOfNextStatementOn: senderSourceCode. + ] + ifFalse: [ + inlinedStatements := self buildInlinedSourceCodeStatementsFrom: statementsToInline withParametersFrom: aMessageNodeReference + removingReturn: removeReturn. + removeReturn + ifTrue: [sourceRangeToReplace := aMessageNodeReference completeSourceRange] + ifFalse: [ + (self enclosingBlockOf: aMessageNodeReference) nodesDo: [:aNode | + (aNode isReturn and: [aNode expr equivalentTo: aMessageNodeReference messageNode ]) + ifTrue: [sourceRangeToReplace := (self findSourceRangeOf: aNode in: senderMethod) + asSourceCodeInterval expandUntilStartOfNextStatementOn: senderSourceCode ] ] + ]. + ]. + + self replaceRange: sourceRangeToReplace withNewSourceCode: inlinedStatements inMethod: senderMethod. + + + + ! ! + +!InlineMethod methodsFor: 'inlining - private' stamp: 'FB 11/3/2021 22:59:59'! +parseNode: aParseNode returns: aMessageNode + + aParseNode nodesDo: [:aNode | (aNode isReturn and: [aNode expr equivalentTo: aMessageNode]) + ifTrue: [^true]]. + ^false. + + + + + ! ! + + +!InlineMethod methodsFor: 'initialization' stamp: 'FB 3/6/2022 15:12:28'! +methodToInline: aCompiledMethod usages: aCollectionOfMesageNodeReferences removingMethod: removingMethod + + methodToInline := aCompiledMethod. + messageSendsToInline := aCollectionOfMesageNodeReferences. + replacementsByMessageSend := Dictionary new. + temporariesDeclarationsByNode := Dictionary new. + temporariesToDeclareByInsertionPoint := Dictionary new. + updatedSendersCode := Dictionary ofSize: ((messageSendsToInline groupBy: [:aMessageNodeReference | aMessageNodeReference methodReference]) keys) size. + methodNodeToInline := methodToInline methodNode. + implementorCompleteSourceRanges := methodNodeToInline completeSourceRanges. + removeMethod := removingMethod.! ! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlineMethod class' category: #'Tools-Refactoring'! +InlineMethod class + instanceVariableNames: ''! + +!InlineMethod class methodsFor: 'initialization' stamp: 'FB 4/14/2022 15:14:25'! +from: aCompiledMethodToInline intoSendersAndUsages: aCollectionOfMessageSends removeMethod: removingMethod + + self assertCanInlineMethod: aCompiledMethodToInline intoMessageSends: aCollectionOfMessageSends. + + ^self new + methodToInline: aCompiledMethodToInline + usages: aCollectionOfMessageSends + removingMethod: removingMethod.! ! + + +!InlineMethod class methodsFor: 'preconditions' stamp: 'FB 5/21/2022 18:00:47'! +assertCanInlineMethod: aCompiledMethodToInline intoMessageSends: aCollectionOfMessageSends + + | senders | + + self assertNoCascadingMessages: aCollectionOfMessageSends. + senders := aCollectionOfMessageSends collect: [:aMessageNodeReference | aMessageNodeReference actualClass]. + self assertSenders: senders haveAccessToPrivateVariablesOf: aCompiledMethodToInline. + self assertMethodToInlineHasOnlyOneReturn: aCompiledMethodToInline. + + "When the method to inline references self, only allow inlining on statements like: + variable := ClassOfMethodToInline new. + variable methodToInline. + but not on: + ClassOfMethodToInline new methodToInline + to be able to replace the references to self with the variable name + " + + (aCompiledMethodToInline referencesSelf) ifTrue: [ + (aCollectionOfMessageSends allSatisfy: [:aSender | (self sender: aSender belongsToClassOf: aCompiledMethodToInline) + or: [aSender messageNode receiver isVariableNode ]]) ifFalse: [ + self signalMethodToInlineReferencesSelf + ] + ]. + + "Do not allow inlining implementors that reference super unless all the senders belong to the same class, + since otherwise it's not possible to replace the super keyword with something that maintains the semantics" + (aCompiledMethodToInline referencesSuper) ifTrue: [ + self assertSenders: aCollectionOfMessageSends belongToClassOf: aCompiledMethodToInline + ifFalse: [self signalMethodToInlineReferencesSuper] . + ]. + ! ! + +!InlineMethod class methodsFor: 'preconditions' stamp: 'FB 10/16/2021 21:26:35'! +assertMethodToInlineHasOnlyOneReturn: aCompiledMethod + + | returnsCount | + + returnsCount := 0. + aCompiledMethod methodNode nodesDo: [:aNode | aNode isReturn ifTrue: [ + returnsCount := returnsCount + 1. + returnsCount > 1 ifTrue: [self signalMethodHasMultipleReturnsErrorMessage ] + ] + ]! ! + +!InlineMethod class methodsFor: 'preconditions' stamp: 'FB 4/14/2022 15:08:07'! +assertNoCascadingMessages: aCollectionOfMessageSends + + (aCollectionOfMessageSends anySatisfy: [:aMessageNodeReference | + aMessageNodeReference messageNode isCascade ]) ifTrue: [self signalMessageSendCanNotBeCascade]! ! + +!InlineMethod class methodsFor: 'preconditions' stamp: 'FB 5/21/2022 16:36:12'! +assertSenders: aCollectionOfSenders belongToClassOf: aCompiledMethod ifFalse: ifFalseBlock + + (aCollectionOfSenders allSatisfy: [:aSender | self sender: aSender belongsToClassOf: aCompiledMethod]) + ifFalse: [^ifFalseBlock value].! ! + +!InlineMethod class methodsFor: 'preconditions' stamp: 'FB 5/21/2022 15:38:18'! +assertSenders: aSendersCollection haveAccessToPrivateVariablesOf: aCompiledMethod + + | methodReferencesInstanceVariables | + + methodReferencesInstanceVariables := false. + aCompiledMethod methodNode + nodesDo: [:aNode | aNode isInstanceVariableNode ifTrue: [methodReferencesInstanceVariables := true]]. + + methodReferencesInstanceVariables ifTrue: [ + (aSendersCollection allSatisfy: [:aSenderClass | aSenderClass = aCompiledMethod methodClass]) + ifFalse: [self signalMethodAccessPrivateVariablesNotVisibleToSenderErrorMessage] + ]. + ! ! + +!InlineMethod class methodsFor: 'preconditions' stamp: 'FB 4/9/2022 00:04:03'! +assertSendersHaveAccessToPrivateVariables: aSendersCollection of: aCompiledMethod + + | methodReferencesInstanceVariables | + + methodReferencesInstanceVariables := false. + aCompiledMethod methodNode + nodesDo: [:aNode | aNode isInstanceVariableNode ifTrue: [methodReferencesInstanceVariables := true]]. + + methodReferencesInstanceVariables ifTrue: [ + (aSendersCollection allSatisfy: [:aSenderClass | aSenderClass = aCompiledMethod methodClass]) + ifFalse: [self signalMethodAccessPrivateVariablesNotVisibleToSenderErrorMessage] + ]. + ! ! + +!InlineMethod class methodsFor: 'preconditions' stamp: 'FB 5/21/2022 17:16:46'! +methodToInlineReferencesSelfErrorMessage + + ^'The method to inline references self, but at least one sender does not have a variable as the receiver and it + does not belong to the same class'! ! + +!InlineMethod class methodsFor: 'preconditions' stamp: 'FB 5/21/2022 16:29:27'! +sender: aSender belongsToClassOf: aCompiledMethod + + ^(aSender actualClass = aCompiledMethod methodClass)! ! + +!InlineMethod class methodsFor: 'preconditions' stamp: 'FB 5/21/2022 17:15:10'! +signalMethodToInlineReferencesSelf + + self refactoringError: self methodToInlineReferencesSelfErrorMessage! ! + + +!InlineMethod class methodsFor: 'errors' stamp: 'FB 4/14/2022 15:11:22'! +messageSendCanNotBeCascadeErrorMessage + + ^'Refactoring a cascade message send is not supported'.! ! + +!InlineMethod class methodsFor: 'errors' stamp: 'FB 4/8/2022 23:35:57'! +methodAccessPrivateVariablesNotVisibleToSenderErrorMessage + + ^'Method to inline is accessing private variables that are not visible to at least one sender'! ! + +!InlineMethod class methodsFor: 'errors' stamp: 'FB 10/16/2021 21:16:21'! +methodHasMultipleReturnsErrorMessage + + ^'Method to inline has more than one possible return value'! ! + +!InlineMethod class methodsFor: 'errors' stamp: 'FB 5/21/2022 16:39:45'! +methodToInlineReferencesSuperErrorMessage + + ^'The method to inline references super but there is at least one sender that does not belong to the same class'! ! + +!InlineMethod class methodsFor: 'errors' stamp: 'FB 4/14/2022 15:09:36'! +signalMessageSendCanNotBeCascade + + ^self refactoringError: self messageSendCanNotBeCascadeErrorMessage.! ! + +!InlineMethod class methodsFor: 'errors' stamp: 'FB 4/8/2022 23:36:18'! +signalMethodAccessPrivateVariablesNotVisibleToSenderErrorMessage + + ^self refactoringError: self methodAccessPrivateVariablesNotVisibleToSenderErrorMessage.! ! + +!InlineMethod class methodsFor: 'errors' stamp: 'FB 10/16/2021 21:16:58'! +signalMethodHasMultipleReturnsErrorMessage + + ^self refactoringError: self methodHasMultipleReturnsErrorMessage.! ! + +!InlineMethod class methodsFor: 'errors' stamp: 'FB 5/21/2022 16:38:43'! +signalMethodToInlineReferencesSuper + + self refactoringError: self methodToInlineReferencesSuperErrorMessage! ! + + +!InlineMethod class methodsFor: 'implementors and senders' stamp: 'FB 10/31/2021 22:53:44'! +addImplementorsOf: aSelectorToInline to: implementors andUsagesTo: usages forClassAndMetaOf: aPotentialClassToRefactor + + self addImplementorsOf: aSelectorToInline to: implementors andUsagesTo: usages of: aPotentialClassToRefactor theNonMetaClass. + self addImplementorsOf: aSelectorToInline to: implementors andUsagesTo: usages of: aPotentialClassToRefactor theMetaClass. + +! ! + +!InlineMethod class methodsFor: 'implementors and senders' stamp: 'FB 10/31/2021 22:53:48'! +addImplementorsOf: aSelectorToInline to: implementors andUsagesTo: usages inCategoriesAndHierarchyOf: aClass organizedBy: anOrganization + + | categories | + + categories := Set new. + + self + addImplementorsOf: aSelectorToInline + to: implementors + andUsagesTo: usages + inHierarchyOf: aClass + doingPerClass: [:aClassInHierarchy | categories add: aClassInHierarchy category ]. + + categories do: [:aCategory | + self + addImplementorsOf: aSelectorToInline + to: implementors + andUsagesTo: usages + inCategory: aCategory + organizedBy: anOrganization ]. +! ! + +!InlineMethod class methodsFor: 'implementors and senders' stamp: 'FB 12/21/2021 20:24:21'! +addImplementorsOf: aSelectorToInline to: implementors andUsagesTo: usages inCategory: aCategory organizedBy: anOrganization + + | classesInCategory | + + classesInCategory := anOrganization classesAt: aCategory. + classesInCategory do: [ :aPotentialClassToRefactor | + self + addImplementorsOf: aSelectorToInline + to: implementors + andUsagesTo: usages + forClassAndMetaOf: aPotentialClassToRefactor ].! ! + +!InlineMethod class methodsFor: 'implementors and senders' stamp: 'FB 10/31/2021 22:53:54'! +addImplementorsOf: aSelectorToInline to: implementors andUsagesTo: usages inHierarchyOf: aClass + + self + addImplementorsOf: aSelectorToInline + to: implementors + andUsagesTo: usages + inHierarchyOf: aClass + doingPerClass: [ :aClassInHierarchy | ] + + ! ! + +!InlineMethod class methodsFor: 'implementors and senders' stamp: 'FB 10/31/2021 22:53:57'! +addImplementorsOf: aSelectorToInline to: implementors andUsagesTo: usages inHierarchyOf: aClass doingPerClass: aBlock + + | highestClassImplementingOldSelector | + + highestClassImplementingOldSelector := aClass highestClassImplementing: aSelectorToInline ifNone: [ aClass ]. + highestClassImplementingOldSelector theNonMetaClass withAllSubclassesDo: [ :aPotentialClassToRefactor | + aPotentialClassToRefactor isMeta ifFalse: [ + self + addImplementorsOf: aSelectorToInline + to: implementors + andUsagesTo: usages + forClassAndMetaOf: aPotentialClassToRefactor. + aBlock value: aPotentialClassToRefactor ]] + ! ! + +!InlineMethod class methodsFor: 'implementors and senders' stamp: 'FB 10/31/2021 22:52:25'! +addImplementorsOf: aSelectorToInline to: implementors andUsagesTo: usages inSystem: aSystem + + aSystem allBehaviorsDo: [ :aPotentialClassToRefactor | + self addImplementorsOf: aSelectorToInline to: implementors andUsagesTo: usages of: aPotentialClassToRefactor ]. +! ! + +!InlineMethod class methodsFor: 'implementors and senders' stamp: 'FB 11/13/2021 21:50:33'! +addImplementorsOf: aSelectorToInline to: implementors andUsagesTo: usages of: aPotentialClassToRefactor + + | potentialImplementor | + + "Phil B. requested to avoid refactoring OMeta2 classes, so right now + it avoids implementors and senders whose compilerClass is not register + as allowed compiler - Hernan" + (self canRefactor: aPotentialClassToRefactor) ifFalse: [ ^self ]. + + potentialImplementor := aPotentialClassToRefactor compiledMethodAt: aSelectorToInline ifAbsent: [ nil ]. + potentialImplementor ifNotNil: [ implementors add: potentialImplementor ]. + + (aPotentialClassToRefactor whichSelectorsReferTo: aSelectorToInline) do: [ :aSelector | + usages addAll: (self findReferencesToSelector: aSelectorToInline in: (MethodReference class: aPotentialClassToRefactor selector: aSelector))]! ! + +!InlineMethod class methodsFor: 'implementors and senders' stamp: 'FB 5/5/2022 22:14:13'! +convertToSender: aSenderSelector of: aPotentialClassToRefactor referencing: aSelector + + ^(self findReferencesToSelector: aSelector + in: (MethodReference class: aPotentialClassToRefactor selector: aSenderSelector))! ! + +!InlineMethod class methodsFor: 'implementors and senders' stamp: 'FB 10/31/2021 22:48:46'! +findReferencesToSelector: aSelectorToInline in: aMethodReference + + | references | + + references := Set new. + aMethodReference compiledMethod methodNode completeSourceRangesDo: [:aNode :ranges | + (aNode isMessageNode and: [aNode selector key = aSelectorToInline]) ifTrue: [ + ranges do: [:range | references add: (MessageNodeReference messageNode: aNode + selector: aMethodReference methodSymbol class: aMethodReference methodClass completeSourceRange: range)] + ] + ]. + + ^references. + + ! ! + +!InlineMethodApplier commentStamp: '' prior: 0! +I can apply the InlineMethod refactoring to a message. I am in charge of handling the configuration windows and instantiating an instance of InlineMethod. +Implementation notes: + +- A single implementor will have to be chosen. +- More than one message send can be refactored. +- An option to delete the implementor is provided.! + + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 6/11/2022 19:14:25'! +askForImplementorsAndMessageSends + + self + initializeImplementorsAndMessageSends; + calculateImplementorsAndMessageSends; + openImplementorSelectionWindow.! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 6/11/2022 19:14:09'! +askForImplementorsOnly + + self + initializeImplementors; + calculateImplementorsAndMessageSends; + openImplementorSelectionWindow.! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'HAW 6/11/2022 19:14:36'! +askForMessagesToInlineOnly + + self + initializeMessageSends; + calculateImplementorsAndMessageSends; + openMessageSendsSelectionWindow.! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/22/2021 19:06:58'! +askIfImplementorShouldBeRemoved + + self askIfImplementorShouldBeRemoved: 'Do you want to remove the implementor method from the system?'.! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/22/2021 19:06:41'! +askIfImplementorShouldBeRemoved: aMessage + + shouldRemoveImplementor := PopUpMenu confirm: aMessage.! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/22/2021 19:12:11'! +askIfImplementorShouldBeRemovedWhenNoSenders + + self askIfImplementorShouldBeRemoved: 'This message has no senders so inlining is a no-op. Do you want to remove the implementor method from the system?'.! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/24/2021 00:26:45'! +askIfOnlyTriggeringMessageSendShouldBeInlined + + | scopeMenu choice | + + scopeMenu := PopUpMenu labelArray: #('Inline only this message send' 'Select message sends to inline'). + choice := scopeMenu startUpWithCaption: 'What message sends should be inlined?'. + choice = 0 ifTrue: [ self endRequest ]. + shouldInlineTriggeringMessageSendOnly := choice = 1! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 10/18/2021 19:48:26'! +askScope + + | scopeMenu | + + scopeMenu := PopUpMenu labelArray: self scopeOptionLabels. + scopeChoice := scopeMenu startUpWithCaption: 'Select Refactoring Scope'. + scopeChoice = 0 ifTrue: [ self endRequest ]. + ! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/24/2021 00:23:13'! +calculateImplementorsAndMessageSends + + scopeChoice = 1 ifTrue: [ ^self implementorsAndMessageSendsForClass ]. + scopeChoice = 2 ifTrue: [ ^self implementorsAndMessageSendsForHierarchy ]. + scopeChoice = 3 ifTrue: [ ^self implementorsAndMessageSendsInCategory ]. + scopeChoice = 4 ifTrue: [ ^self implementorsAndMessageSendsInCategoryAndHierarchy ]. + scopeChoice = 5 ifTrue: [ ^self implementorsAndMessageSendsInSystem ]. + + self error: 'Unknown scope option' + + ! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 10/24/2021 15:03:32'! +createImplementors + + ^IdentitySet new +! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/24/2021 00:24:50'! +createMessageSends + + ^OrderedCollection new. +! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/24/2021 00:27:41'! +implementorsAndMessageSendsForClass + + ^self refactoringClass + addImplementorsOf: selectorToInline + to: self implementorsOrDiscardCollection + andUsagesTo: self messageSendsOrDiscardCollection + forClassAndMetaOf: selectedClass! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/24/2021 00:27:41'! +implementorsAndMessageSendsForHierarchy + + ^self refactoringClass + addImplementorsOf: selectorToInline + to: self implementorsOrDiscardCollection + andUsagesTo: self messageSendsOrDiscardCollection + inHierarchyOf: selectedClass! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/24/2021 00:27:41'! +implementorsAndMessageSendsInCategory + + ^self refactoringClass + addImplementorsOf: selectorToInline + to: self implementorsOrDiscardCollection + andUsagesTo: self messageSendsOrDiscardCollection + inCategory: selectedClass category + organizedBy: SystemOrganization! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/24/2021 00:27:41'! +implementorsAndMessageSendsInCategoryAndHierarchy + + ^self refactoringClass + addImplementorsOf: selectorToInline + to: self implementorsOrDiscardCollection + andUsagesTo: self messageSendsOrDiscardCollection + inCategoriesAndHierarchyOf: selectedClass + organizedBy: SystemOrganization ! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/24/2021 00:27:41'! +implementorsAndMessageSendsInSystem + + ^self refactoringClass + addImplementorsOf: selectorToInline + to: self implementorsOrDiscardCollection + andUsagesTo: self messageSendsOrDiscardCollection + inSystem: Smalltalk ! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 3/19/2022 18:39:34'! +implementorsOrDiscardCollection + + "This is implemented like this so we don't have to duplicate every implementorsAndMessageSendsInXXX method to + only calculate implementors or only usages. We always calculate both but if they are not needed they end + up in this collection that will not be used in the refactoring process - Fernando" + + ^self shouldAskForImplementors ifTrue: [implementors] ifFalse: [^Set new]! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/13/2021 18:19:25'! +initializeImplementors + + implementors := self createImplementors. + ! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/24/2021 00:24:27'! +initializeImplementorsAndMessageSends + + self initializeImplementors. + self initializeMessageSends. + ! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/24/2021 00:24:50'! +initializeMessageSends + + messageSends := self createMessageSends + ! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/25/2021 00:25:03'! +messageSendsOrDiscardCollection + + "This is implemented like this so we don't have to duplicate every implementorsAndUsagesInXXX method to + only calculate implementors or only usages. We always calculate both but if they are not needed they end + up in this collection that will not be used in the refactoring process - Fernando" + + ^self shouldAskForMessageSendsToInline ifTrue: [messageSends] ifFalse: [^Set new].! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 3/3/2022 21:48:32'! +openImplementorSelectionWindow + + | windowClass | + + implementors isEmpty ifTrue: [self handleRefactoringError: (RefactoringError signal: self class implementorsNotFoundErrorMessage)]. + windowClass := self shouldAskForMessageSendsToInline + ifTrue: [InlineMethodImplementorsWithShowUsagesStepWindow] + ifFalse: [InlineMethodImplementorsStepWindow]. + ^windowClass openFrom: self.! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/24/2021 00:27:26'! +openMessageSendsSelectionWindow + + | windowClass | + + windowClass := self shouldAskForImplementors + ifTrue: [InlineMethodUsagesWithShowImplementorsStepWindow] + ifFalse: [InlineMethodUsagesStepWindow]. + ^windowClass openFrom: self.! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 11/24/2021 00:26:21'! +requestRefactoringParameters + + self refactoringRequestedFromUsage ifTrue: [self askIfOnlyTriggeringMessageSendShouldBeInlined]. + self askIfImplementorShouldBeRemoved.! ! + +!InlineMethodApplier methodsFor: 'refactoring - parameters request' stamp: 'FB 10/18/2021 19:48:26'! +scopeOptionLabels + + ^{'In Class'. 'In Hierarchy'. 'In Category'. 'In Hierarchy and its Categories'. 'In System'}.! ! + + +!InlineMethodApplier methodsFor: 'accessing' stamp: 'FB 10/31/2021 16:49:55'! +implementors + + ^implementors ! ! + +!InlineMethodApplier methodsFor: 'accessing' stamp: 'FB 11/13/2021 21:15:51'! +implementors: aCollectionOfImplementors + + implementors := aCollectionOfImplementors ! ! + +!InlineMethodApplier methodsFor: 'accessing' stamp: 'FB 11/24/2021 20:05:21'! +messageSendAt: anIndex ifAbsent: ifAbsentBlock + + ^messageSends at: anIndex ifAbsent: ifAbsentBlock! ! + +!InlineMethodApplier methodsFor: 'accessing' stamp: 'FB 11/25/2021 00:24:47'! +messageSends: aCollectionOfMessageSends + + messageSends := aCollectionOfMessageSends reject: [:aMessageNodeReference | aMessageNodeReference isMessageListTitle ]! ! + +!InlineMethodApplier methodsFor: 'accessing' stamp: 'FB 11/25/2021 00:25:16'! +messageSendsToInline + + ^messageSends ! ! + +!InlineMethodApplier methodsFor: 'accessing' stamp: 'FB 11/24/2021 00:23:25'! +methodsOfUsagesToInline + + ^messageSends collect: [:aMessageNodeReference | aMessageNodeReference methodReference]! ! + +!InlineMethodApplier methodsFor: 'accessing' stamp: 'FB 10/31/2021 16:50:12'! +selectorToInline + + ^selectorToInline ! ! + +!InlineMethodApplier methodsFor: 'accessing' stamp: 'FB 11/22/2021 17:42:30'! +shouldAskForImplementors + + ^triggeringMessageSend isNil not.! ! + +!InlineMethodApplier methodsFor: 'accessing' stamp: 'FB 11/25/2021 00:25:03'! +shouldAskForMessageSendsToInline + + ^shouldInlineTriggeringMessageSendOnly not.! ! + +!InlineMethodApplier methodsFor: 'accessing' stamp: 'FB 10/18/2021 19:48:26'! +wizardStepWindow: aWizarStepWindow + + wizardStepWindow := aWizarStepWindow ! ! + + +!InlineMethodApplier methodsFor: 'refactoring - changes' stamp: 'FB 10/18/2021 19:48:26'! +closeBrowser + + wizardStepWindow delete. + ! ! + +!InlineMethodApplier methodsFor: 'refactoring - changes' stamp: 'FB 10/18/2021 19:48:26'! +doNotShowChanges + + shouldShowChanges := false! ! + +!InlineMethodApplier methodsFor: 'refactoring - changes' stamp: 'FB 10/18/2021 19:48:26'! +messageSetWindowClass + + ^MessageSetWindow + ! ! + +!InlineMethodApplier methodsFor: 'refactoring - changes' stamp: 'FB 10/18/2021 19:48:26'! +showChanges + + self showChangesInMessageSetWindow! ! + +!InlineMethodApplier methodsFor: 'refactoring - changes' stamp: 'FB 10/18/2021 19:48:26'! +showChangesInMessageSetWindow + + self messageSetWindowClass openMessageList: changes asSortedCollection label: 'Changed methods' ! ! + + +!InlineMethodApplier methodsFor: 'refactoring - creation' stamp: 'FB 6/3/2022 17:27:44'! +createAndApplyRefactoring + + self + removeMessageSendsBelongingToImplementor; + createRefactoringHandlingRefactoringExceptions; + applyRefactoring. + + shouldShowChanges ifTrue: [ self showChanges ] + + ! ! + +!InlineMethodApplier methodsFor: 'refactoring - creation' stamp: 'FB 11/24/2021 00:23:25'! +createAndApplyRefactoringWhenNoSendersAndOneImplementor: anImplementor + + implementors := Array with: anImplementor. + messageSends := #(). + shouldShowChanges := false. + + self createAndApplyRefactoring ! ! + +!InlineMethodApplier methodsFor: 'refactoring - creation' stamp: 'FB 11/24/2021 00:23:25'! +createRefactoring + + self assert: implementors size = 1. + ^self refactoringClass + from: (implementors anyOne) + intoSendersAndUsages: messageSends + removeMethod: shouldRemoveImplementor + + ! ! + +!InlineMethodApplier methodsFor: 'refactoring - creation' stamp: 'FB 10/18/2021 19:50:16'! +refactoringClass + + ^InlineMethod ! ! + +!InlineMethodApplier methodsFor: 'refactoring - creation' stamp: 'FB 6/3/2022 17:27:29'! +removeMessageSendsBelongingToImplementor + + messageSends := messageSends reject: [:messageNodeReference | + messageNodeReference compiledMethod equivalentTo: implementors anyOne + ] +! ! + + +!InlineMethodApplier methodsFor: 'initialization' stamp: 'FB 11/24/2021 00:26:29'! +initializeOn: aBrowser for: aSelector in: aSelectedClass + + "To be used when initiating refactoring from message selector pane" + + selectorToInline := aSelector. + selectedClass := aSelectedClass. + browser := aBrowser. + shouldInlineTriggeringMessageSendOnly := false. + shouldShowChanges := true.! ! + +!InlineMethodApplier methodsFor: 'initialization' stamp: 'FB 11/22/2021 17:42:30'! +initializeOn: aBrowser forMessageSend: aMessageNodeReference + + "To be used when initiating refactoring from a message send" + + selectorToInline := aMessageNodeReference selectorOfMessageNode. + triggeringMessageSend := aMessageNodeReference. + selectedClass := aMessageNodeReference actualClass. + browser := aBrowser. + shouldShowChanges := true.! ! + + +!InlineMethodApplier methodsFor: 'evaluation' stamp: 'FB 11/22/2021 19:10:54'! +ifHasNoUsagesAndOneImplementor: trueBlock ifNot: falseBlock + + | allImplementors | + + allImplementors := Smalltalk allImplementorsOf: selectorToInline. + + "I could try to see if there is one sender and that that sender is in the same method beeing renamed. That could + mean that it is a recursive call but I should also see if the receiver is self to be sure because if it is other 'type' of + object the rename could not be safe. To complex for a small posibility - Hernan" + (allImplementors size = 1 and: [ (Smalltalk allCallsOn: selectorToInline) isEmpty ]) + ifTrue: [ trueBlock value: allImplementors anyOne compiledMethod ] + ifFalse: falseBlock! ! + +!InlineMethodApplier methodsFor: 'evaluation' stamp: 'FB 11/22/2021 17:42:30'! +refactoringRequestedFromUsage + + ^triggeringMessageSend isNil not.! ! + +!InlineMethodApplier methodsFor: 'evaluation' stamp: 'FB 3/5/2022 14:06:26'! +value + + requestExitBlock := [ ^self ]. + + self requestRefactoringParametersHandlingRefactoringExceptions. + + self + ifHasNoUsagesAndOneImplementor: [ :anImplementor | + shouldRemoveImplementor ifFalse: [self askIfImplementorShouldBeRemovedWhenNoSenders ]. "Give the user another chance to delete the message" + shouldRemoveImplementor ifFalse: [^self]. + self createAndApplyRefactoringWhenNoSendersAndOneImplementor: anImplementor + ] + ifNot: [ + self askScope. + shouldInlineTriggeringMessageSendOnly ifTrue: [ + messageSends := OrderedCollection new. + messageSends add: triggeringMessageSend. + ^self askForImplementorsOnly + ]. + self shouldAskForImplementors ifFalse: [implementors := IdentitySet with: (selectedClass >> selectorToInline). ^self askForMessagesToInlineOnly]. + self askForImplementorsAndMessageSends. + ]! ! + +!InlineMethodApplier methodsFor: 'evaluation' stamp: 'FB 10/18/2021 19:48:26'! +wizardEnded + + requestExitBlock := [ ^self ]. + + self + closeBrowser; + createAndApplyRefactoring.! ! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlineMethodApplier class' category: #'Tools-Refactoring'! +InlineMethodApplier class + instanceVariableNames: ''! + +!InlineMethodApplier class methodsFor: 'instance creation' stamp: 'FB 12/21/2021 19:57:14'! +createAndValueHandlingExceptions: creationBlock + + + [super createAndValueHandlingExceptions: creationBlock] + on: Refactoring refactoringErrorClass + do: [ :refactoringError | ^self inform: refactoringError messageText ]. +! ! + +!InlineMethodApplier class methodsFor: 'instance creation' stamp: 'FB 11/22/2021 17:42:17'! +createAndValueHandlingExceptionsOn: aModel forMessageSend: aMessageNodeReference + + self createAndValueHandlingExceptions: [ self initializeOn: aModel forMessageSend: aMessageNodeReference ]. +! ! + +!InlineMethodApplier class methodsFor: 'instance creation' stamp: 'FB 11/22/2021 17:44:22'! +createAndValueHandlingExceptionsOn: aModel forMethod: aMethodReference + + self createAndValueHandlingExceptions: [ self initializeOn: aModel forMethod: aMethodReference ]. +! ! + +!InlineMethodApplier class methodsFor: 'instance creation' stamp: 'FB 3/3/2022 21:42:58'! +implementorsNotFoundErrorMessage + + ^'There are no implementors for this message in the selected scope'! ! + +!InlineMethodApplier class methodsFor: 'instance creation' stamp: 'FB 11/22/2021 17:42:17'! +initializeOn: aModel forMessageSend: aMessageNodeReference + + ^self new initializeOn: aModel forMessageSend: aMessageNodeReference + ! ! + +!InlineMethodApplier class methodsFor: 'instance creation' stamp: 'FB 11/22/2021 18:27:52'! +initializeOn: aModel forMethod: aMethodReference + + "To be called when calling from method selector or when inlining self method from the code editor" + + ^self new initializeOn: aModel for: aMethodReference selector in: aMethodReference actualClass.! ! + +!InlineMethodWizardStepWindow methodsFor: 'actions' stamp: 'FB 10/18/2021 20:25:55'! +do: aBlock withEnteredClassLabeled: aLabel + ClassNameRequestMorph + request: aLabel + initialAnswer: '' + do: [:className| self withClassNamed: className do: aBlock]! ! + +!InlineMethodWizardStepWindow methodsFor: 'actions' stamp: 'FB 10/18/2021 20:25:55'! +inform: aClass doesNotImplement: aSelector + + self inform: aClass name, ' does not implement #', aSelector ! ! + +!InlineMethodWizardStepWindow methodsFor: 'actions' stamp: 'FB 10/18/2021 20:25:55'! +justRefactor + + applier doNotShowChanges. + self refactor.! ! + +!InlineMethodWizardStepWindow methodsFor: 'actions' stamp: 'FB 10/18/2021 20:25:55'! +refactor + + applier wizardStepWindow: self. + applier wizardEnded. + ! ! + +!InlineMethodWizardStepWindow methodsFor: 'actions' stamp: 'FB 10/18/2021 20:25:55'! +withClassNamed: aName do: aBlock + + | trimmedNamed | + + trimmedNamed := aName withBlanksTrimmed. + + (Smalltalk classNamed: trimmedNamed asSymbol) + ifNotNil: aBlock + ifNil: [ self inform: 'Class ', trimmedNamed , ' does not exist' ]. +! ! + + +!InlineMethodWizardStepWindow methodsFor: 'GUI building' stamp: 'FB 10/18/2021 20:25:55'! +addButton: button to: row color: buttonColor + + button color: buttonColor. + row addMorph: button proportionalWidth: 10! ! + +!InlineMethodWizardStepWindow methodsFor: 'GUI building' stamp: 'FB 10/18/2021 20:25:55'! +addButtonsTo: row color: buttonColor + + self subclassResponsibility ! ! + +!InlineMethodWizardStepWindow methodsFor: 'GUI building' stamp: 'FB 10/18/2021 20:25:55'! +buildLowerPanes + + | codeAndButtons | + + codeAndButtons _ LayoutMorph newColumn. + codeAndButtons + addMorph: self buttonsRow fixedHeight: self defaultButtonPaneHeight; + addAdjusterMorph; + addMorph: self buildMorphicCodePane proportionalHeight: 1.0. + + ^codeAndButtons ! ! + +!InlineMethodWizardStepWindow methodsFor: 'GUI building' stamp: 'FB 10/18/2021 20:25:55'! +buttonsRow + + | buttonColor row | + + buttonColor := self buttonColor. + row := LayoutMorph newRow. + row doAdoptWidgetsColor. + row color: buttonColor. + + self addButtonsTo: row color: buttonColor. + + ^row + + ! ! + + +!InlineMethodWizardStepWindow methodsFor: 'compile methods' stamp: 'FB 10/18/2021 20:25:55'! +compiledMethodsFrom: methodReferences + + "If the method is not implemented, I leave the not implemented reference because actual senders of it + should be renamed. This is important for LiveTyping Actual Scope Refactorings - Hernan" + ^ methodReferences collect: [:aMethodReference | + aMethodReference compiledMethodIfAbsent: [ aMethodReference ]]! ! + + +!InlineMethodWizardStepWindow methodsFor: 'button creation' stamp: 'FB 10/18/2021 20:25:55'! +createCancelButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #delete + label: 'Cancel'. +! ! + +!InlineMethodWizardStepWindow methodsFor: 'button creation' stamp: 'FB 10/18/2021 20:25:55'! +createJustRefactorButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #justRefactor + label: 'Just Refactor!!'! ! + +!InlineMethodWizardStepWindow methodsFor: 'button creation' stamp: 'FB 10/18/2021 20:25:55'! +createRefactorButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #refactor + label: 'Refactor'! ! + +!InlineMethodWizardStepWindow methodsFor: 'button creation' stamp: 'FB 11/22/2021 16:23:59'! +createRemoveButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #remove + label: 'Remove'. +! ! + + +!InlineMethodWizardStepWindow methodsFor: 'initialization' stamp: 'FB 10/31/2021 17:27:23'! +initializeFrom: anInlineMethodApplier + + applier := anInlineMethodApplier ! ! + + +!InlineMethodWizardStepWindow methodsFor: 'testing' stamp: 'FB 10/18/2021 20:25:55'! +isMessageSelected + + ^model isNil ifTrue: [ false ] ifFalse: [ model selection notNil ]! ! + + +!InlineMethodWizardStepWindow methodsFor: 'accessing' stamp: 'FB 10/31/2021 17:26:48'! +selectorToInline + + ^applier selectorToInline ! ! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlineMethodWizardStepWindow class' category: #'Tools-Refactoring'! +InlineMethodWizardStepWindow class + instanceVariableNames: ''! + +!InlineMethodWizardStepWindow class methodsFor: 'instance creation' stamp: 'FB 11/22/2021 15:10:45'! +methodReferencesOf: methods + + ^methods asOrderedCollection collect: [:aCompiledMethod | aCompiledMethod methodReference ]. +! ! + +!InlineMethodWizardStepWindow class methodsFor: 'instance creation' stamp: 'FB 11/13/2021 21:16:10'! +openFrom: anInlineMethodApplier methods: methods label: aLabel selecting: somethingToSelect + + | window | + + window := self openMessageList: methods label: aLabel autoSelect: somethingToSelect. + window initializeFrom: anInlineMethodApplier. + + ^window + +! ! + +!InlineMethodImplementorsStepWindow methodsFor: 'actions' stamp: 'FB 11/22/2021 15:25:47'! +justRefactor + + self setImplementorInApplier. + super justRefactor.! ! + +!InlineMethodImplementorsStepWindow methodsFor: 'actions' stamp: 'FB 11/22/2021 15:54:27'! +refactor + + self setImplementorInApplier. + super refactor.! ! + +!InlineMethodImplementorsStepWindow methodsFor: 'actions' stamp: 'FB 11/14/2021 17:07:45'! +selectImplementor + + selectedImplementor := model selection. + self refactor.! ! + +!InlineMethodImplementorsStepWindow methodsFor: 'actions' stamp: 'FB 11/21/2021 21:00:23'! +setImplementorInApplier + + selectedImplementor := selectedImplementor ifNil: [model selection]. + applier implementors: (self compiledMethodsFrom: (Array with: selectedImplementor)). + ! ! + + +!InlineMethodImplementorsStepWindow methodsFor: 'GUI building' stamp: 'FB 11/22/2021 15:52:57'! +addButtonsTo: row color: buttonColor + + self addButton: self createRefactorButton to: row color: buttonColor. + self addButton: self createJustRefactorButton to: row color: buttonColor. + self addButton: self createCancelButton to: row color: buttonColor. +! ! + + +!InlineMethodImplementorsStepWindow methodsFor: 'button creation' stamp: 'FB 11/13/2021 19:03:50'! +createSelectImplementorButton + + ^PluggableButtonMorph + model: self + stateGetter: #isMessageSelected + action: #selectImplementor + label: 'Select'.! ! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlineMethodImplementorsStepWindow class' category: #'Tools-Refactoring'! +InlineMethodImplementorsStepWindow class + instanceVariableNames: ''! + +!InlineMethodImplementorsStepWindow class methodsFor: 'instance creation' stamp: 'FB 10/31/2021 22:16:04'! +openFrom: anInlineMethodApplier + + ^self + openFrom: anInlineMethodApplier + methods: (self methodReferencesOf: anInlineMethodApplier implementors) + label: 'Implementors of #', anInlineMethodApplier selectorToInline, ' to Refactor' + selecting: nil +! ! + +!InlineMethodImplementorsWithShowUsagesStepWindow methodsFor: 'button creation' stamp: 'FB 11/27/2021 17:12:10'! +addButtonsTo: row color: buttonColor + + self addButton: self createSelectAndSeeUsagesButton to: row color: buttonColor. + self addButton: self createRefactorButton to: row color: buttonColor. + self addButton: self createJustRefactorButton to: row color: buttonColor. + self addButton: self createCancelButton to: row color: buttonColor.! ! + +!InlineMethodImplementorsWithShowUsagesStepWindow methodsFor: 'button creation' stamp: 'FB 11/22/2021 16:16:53'! +createSelectAndSeeUsagesButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #selectAndSeeUsages + label: 'Select and see usages'. + +! ! + + +!InlineMethodImplementorsWithShowUsagesStepWindow methodsFor: 'actions' stamp: 'FB 11/24/2021 00:27:26'! +selectAndSeeUsages + + self setImplementorInApplier. + self delete. + + "Necesary indirection to support actual senders in LiveTyping - Hernan" + applier openMessageSendsSelectionWindow.! ! + +!InlineMethodImplementorsWithShowUsagesStepWindow methodsFor: 'actions' stamp: 'FB 11/22/2021 14:33:31'! +selectImplementor + + selectedImplementor := model selection. + self selectAndSeeUsages.! ! + + !InlineMethodUsagesStepWindow methodsFor: 'actions' stamp: 'FB 10/31/2021 21:38:33'! + add + + self + do: [ :classOfSenderToAdd | self askAndAddAllUsagesInSenderOf: classOfSenderToAdd ] + withEnteredClassLabeled: 'Sender of #', self selectorToInline + ! ! + +!InlineMethodUsagesStepWindow methodsFor: 'actions' stamp: 'FB 10/31/2021 23:14:50'! +addToList: aMessageNodeReference + + model addMessageNodeReference: aMessageNodeReference ifIncluded: [ self inform: 'Usage already in list' ]! ! + +!InlineMethodUsagesStepWindow methodsFor: 'actions' stamp: 'FB 10/31/2021 23:15:46'! +askAndAddAllUsagesInSenderOf: classOfSenderToAdd + + "Adds all usages of the selected sender to the usages to refactor" + | senderSelector senderToAdd | + + senderSelector := self request: 'Selector of sender of #', self selectorToInline initialAnswer: '' orCancel: [^self ]. + senderToAdd := classOfSenderToAdd + compiledMethodAt: senderSelector asSymbol + ifAbsent: [ ^self inform: classOfSenderToAdd doesNotImplement: senderSelector asSymbol]. + + (senderToAdd sendsOrRefersTo: self selectorToInline) ifFalse: [ ^self inform: senderToAdd classAndSelector, ' does not refer to #', self selectorToInline]. + + (applier refactoringClass findReferencesToSelector: self selectorToInline in: senderToAdd asMethodReference) + do: [:aMessageNodeReference | self addToList: aMessageNodeReference]! ! + +!InlineMethodUsagesStepWindow methodsFor: 'actions' stamp: 'FB 11/25/2021 00:24:47'! +changeUsages + + applier messageSends: model messageList + ! ! + +!InlineMethodUsagesStepWindow methodsFor: 'actions' stamp: 'FB 10/31/2021 17:26:16'! +refactor + + self changeUsages. + super refactor ! ! + +!InlineMethodUsagesStepWindow methodsFor: 'actions' stamp: 'FB 11/22/2021 16:24:46'! +remove + + model removeMessageFromBrowserKeepingLabel.! ! + + +!InlineMethodUsagesStepWindow methodsFor: 'GUI building' stamp: 'FB 11/22/2021 16:24:33'! +addButtonsTo: row color: buttonColor + + self addButton: self createRemoveButton to: row color: buttonColor. + self addButton: self createRefactorButton to: row color: buttonColor. + self addButton: self createJustRefactorButton to: row color: buttonColor. + self addButton: self createCancelButton to: row color: buttonColor. +! ! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlineMethodUsagesStepWindow class' category: #'Tools-Refactoring'! +InlineMethodUsagesStepWindow class + instanceVariableNames: ''! + +!InlineMethodUsagesStepWindow class methodsFor: 'instance creation' stamp: 'FB 11/24/2021 20:04:24'! +openFrom: anInlineMethodApplier + + | window messageSendsSet | + + messageSendsSet := InlineMethodMessageSendsSet applier: anInlineMethodApplier. + + messageSendsSet autoSelectString: 'asd'. + + window := self open: messageSendsSet label: 'Message sends of #', anInlineMethodApplier selectorToInline, ' to Refactor'. + window initializeFrom: anInlineMethodApplier. + + ^window.! ! + +!InlineMethodUsagesWithShowImplementorsStepWindow methodsFor: 'button creation' stamp: 'FB 11/13/2021 21:40:51'! +addButtonsTo: row color: buttonColor + + super addButtonsTo: row color: buttonColor. + self addButton: self createSeeImplementorsButton to: row color: buttonColor.! ! + +!InlineMethodUsagesWithShowImplementorsStepWindow methodsFor: 'button creation' stamp: 'FB 11/13/2021 21:40:02'! +createSeeImplementorsButton + + ^PluggableButtonMorph + model: self + stateGetter: nil + action: #seeImplementors + label: 'See Implementors'. +! ! + + +!InlineMethodUsagesWithShowImplementorsStepWindow methodsFor: 'actions' stamp: 'FB 11/22/2021 16:19:11'! +seeImplementors + + self changeUsages. + self delete. + + applier openImplementorSelectionWindow.! ! + +!InlineTemporaryVariable commentStamp: '' prior: 0! +I am a refactoring that replaces references to a temporary variable for its actual value. +Implementation notes: + +- If the refactoring is initiated from the declaration of the variable, then it must have at most one assignment. +- If there are no assignments, the only effect is the removal of the declaration. +- If the refactoring is triggered from a usage, the value used is the one from the previous last assignment and +the scope is limited to all usages up the next assignment, if any, or the end of the method.! + + +!InlineTemporaryVariable methodsFor: 'applying' stamp: 'FB 12/21/2021 20:24:52'! +apply + + self usageToInlineIsTemporaryDeclaration + ifTrue: [self inlineFromTemporaryDeclaration] + ifFalse: [self inlineFromNonDeclarationUsage]. + + self compileChanges. + +! ! + + +!InlineTemporaryVariable methodsFor: 'initialization' stamp: 'FB 3/13/2022 17:44:17'! +initializeOldVariableNode: aVariableNodeToInline usage: aUsageToInline method: aCompiledMethodToRefactor methodNode: aMethodNode + + | parseNodesPath | + + oldVariableNode := aVariableNodeToInline. + usageToInline := aUsageToInline. + variableToInline := aVariableNodeToInline name. + methodToRefactor := aCompiledMethodToRefactor. + updatedSourceCode := methodToRefactor sourceCode. + methodNode := aMethodNode. + parseNodesPath := methodNode parseNodesPathAt: usageToInline first ifAbsent: [self class signalSelectedIntervalIsNotATemporary]. + methodOrBlockNodeDeclaringTemporary := (parseNodesPath collect: [:anAssociation | anAssociation key]) + detect: [:aParseNode | aParseNode isBlockNode and: [aParseNode hasArgumentOrTemporaryNamed: variableToInline]] + ifNone: methodNode. + rangeOfNodeDeclaringTemporary := (methodOrBlockNodeDeclaringTemporary = methodNode) + ifTrue: [1 to: (methodNode sourceText size)] + ifFalse: [(methodNode completeSourceRangesOf: methodOrBlockNodeDeclaringTemporary ifAbsent: [self shouldNotHappen]) + detect: [:aSourceRange | aSourceRange includesAllOf: usageToInline]]. + sourceCodeChanges := SortedCollection sortBlock: [ :left :right | left key first < right key first ]. + +! ! + + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'HAW 6/11/2022 19:21:17'! +addParenthesesIfNeededTo: anExpression + + | firstCharacterIsOpeningParentheses lastCharacterIsClosingParentheses | + + firstCharacterIsOpeningParentheses := (anExpression at: (anExpression firstNonSeparator)) = $(. + lastCharacterIsClosingParentheses := (anExpression at: (anExpression lastNonSeparator)) = $). + + ^(firstCharacterIsOpeningParentheses and: [lastCharacterIsClosingParentheses]) + ifTrue: [anExpression] + ifFalse: ['(', anExpression, ')'].! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 12/21/2021 19:34:24'! +assertTemporaryHasAtMostOneAssignment + + self atMostOneAssignment ifFalse: [self class signalMoreThanOneAssignmentError].! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/13/2022 17:44:17'! +assertTemporaryNotUsedInBlockBetween: assignmentToInline and: anIndex + + | temporaryPositionsBetweenAssignmentAndIndex | + + temporaryPositionsBetweenAssignmentAndIndex := (methodNode consolidateAsCollection: (methodNode rangeForNode: oldVariableNode + ifAbsent: [self shouldNotHappen ])) + select: [:aPosition | aPosition first > assignmentToInline last and: [aPosition last < anIndex]]. + + temporaryPositionsBetweenAssignmentAndIndex do: [:aPosition | ((methodNode parseNodesPathAt: aPosition first ifAbsent: [self shouldNotHappen]) + anySatisfy: [:aNodeAndRange | aNodeAndRange key isBlockNode + and: [aNodeAndRange key ~= methodOrBlockNodeDeclaringTemporary ] + and: [(aNodeAndRange value includesAllOf: rangeOfNodeDeclaringTemporary) not ]]) + ifTrue: [self class signalTemporaryUsedInBlockSurroundedWithAssignments]]! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 1/9/2022 16:27:33'! +assertUnassignedTemporaryIsNotReferenced + + ((methodNode positionsForTemporaryVariable: variableToInline + ifAbsent: [self shouldNotHappen]) size > 1) ifTrue: [self class signalAssignmentNotFound] + + + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/13/2022 17:44:17'! +assignmentNodeToInline: assignmentToInline + + methodNode nodesDo: [:aNode | ((self nodeIsAssignmentToTemporaryToInline: aNode) + and: [ + |ranges| + + ranges := (methodNode rangeForNode: aNode ifAbsent: [#()]). + (methodNode isMultipleRanges: ranges) ifFalse: [ranges := {ranges}]. + ranges anySatisfy: [:range | assignmentToInline includesAllOf: range]. + ]) + ifTrue: [^aNode]]. + + self shouldNotHappen. + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 1/8/2022 13:27:10'! +assignmentsToVariableCount + + | count | + + count := 0. + methodOrBlockNodeDeclaringTemporary nodesDo: [:aNode | + (self nodeIsAssignmentToTemporaryToInline: aNode) ifTrue: [count := count + 1 ]. + ]. + + ^count. + + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 1/8/2022 13:27:42'! +atMostOneAssignment + + ^self assignmentsToVariableCount <= 1. + + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/13/2022 17:44:17'! +closestAssignmentBeforeUsage: assignments + + + ^(assignments + select: [:assignmentRange | (assignmentRange includesAllOf: usageToInline) + or: [assignmentRange last < usageToInline first]]) + detectMax: [:assignmentRange | assignmentRange last] + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 2/16/2021 17:03:49'! +compileChanges + + updatedSourceCode := updatedSourceCode copyReplacing: sourceCodeChanges. + + ^methodToRefactor methodClass compile: updatedSourceCode classified: methodToRefactor category! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 4/3/2022 23:03:19'! +computeEndOfNodeEnclosingAssignment + + endOfNodeEnclosingAssignment := (methodNode parseNodesPathAt: assignmentToInlineRange first + ifAbsent: [self shouldNotHappen]) + detect: [:nodeAndRange | nodeAndRange key isBlockNode] + ifFound: [:nodeAndRangeOfAssignment | nodeAndRangeOfAssignment value last ] + ifNone: [methodNode sourceText size]. + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/13/2022 17:44:17'! +findAssignmentOfUsage + + | lastAssignment assignments | + + assignments := self selectCompleteRangesOfAssignmentsToTemporaryFrom: methodOrBlockNodeDeclaringTemporary thatMatch: + [:range | (range includesAllOf: usageToInline) or: [range last < usageToInline first] ]. + + lastAssignment := assignments detectMax: [:assignment | assignment last]. + + lastAssignment ~= nil ifTrue: [^lastAssignment ] ifFalse: [self class signalAssignmentNotFound] + + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 5/2/2021 18:20:30'! +findLastIndexOfFirstAssignmentAfter: assignmentToInline + + | nextAssignmentsRanges | + + + nextAssignmentsRanges := self selectCompleteRangesOfAssignmentsToTemporaryFrom: methodOrBlockNodeDeclaringTemporary + thatMatch: [:range | range first > assignmentToInline last]. + + ^nextAssignmentsRanges collect: [:assignmentRange | assignmentRange last] + andFold: [:rangeEnd1 :rangeEnd2 | rangeEnd1 min: rangeEnd2] + ifEmpty: nil + + + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 5/2/2021 18:21:11'! +findOnlyAssignmentRangeInNode: aMethodOrBlockNode + + ^(self selectCompleteRangesOfAssignmentsToTemporaryFrom: aMethodOrBlockNode + thatMatch: [:aRange | true]) + ifEmpty: [^nil] + ifNotEmpty: [:rangesSet | rangesSet anyOne].! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/19/2022 13:29:23'! +findReferencesBetweenAssignmentAndIndex: anIndex + + ^((methodNode completeSourceRangesOf: oldVariableNode ifAbsent: [self shouldNotHappen]) + select: [:range | (range first >= assignmentToInlineRange last) and: [range first <= anIndex] + and: [(self rangeIsLeftPartOfAssignmentToTemporary: range) not ]])! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 4/3/2022 23:27:25'! +inlineAssignment + + | endOfNextAssignmentIndex endOfRefactoringScopeIndex | + + endOfNextAssignmentIndex := self findLastIndexOfFirstAssignmentAfter: assignmentToInlineRange. + self computeEndOfNodeEnclosingAssignment. + endOfRefactoringScopeIndex := endOfNextAssignmentIndex ifNil: [endOfNodeEnclosingAssignment ]. + self inlineAssignment: assignmentToInlineRange upTo: endOfRefactoringScopeIndex. + + (self atMostOneAssignment and: [self noReferencesToTemporaryAfter: endOfRefactoringScopeIndex ]) + ifTrue: [self removeTemporaryVariableDeclaration]. + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 4/3/2022 23:04:04'! +inlineAssignment: assignmentToInline upTo: anIndex + + | assignmentNode assignmentNodeValue expression expressionRange | + + (anIndex ~= endOfNodeEnclosingAssignment) ifTrue: [self assertTemporaryNotUsedInBlockBetween: assignmentToInline and: anIndex]. + assignmentNode := self assignmentNodeToInline: assignmentToInline. + assignmentNodeValue := assignmentNode value. + expressionRange := (methodNode completeSourceRangesOf: assignmentNodeValue ifAbsent: [self shouldNotHappen]) + detect: [:range | assignmentToInline includesAllOf: range]. + expression := methodNode sourceText copyFrom: expressionRange first to: expressionRange last. + + self inlineAssignmentNode: assignmentNode withExpression: expression upTo: anIndex; + removeAssignment: assignmentToInline.! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 4/24/2021 18:20:38'! +inlineAssignmentNode: anAssignmentNode withExpression: anExpression upTo: anIndex + + | assignmentNodeValue | + + assignmentNodeValue := anAssignmentNode value. + assignmentNodeValue isMessageNode + ifTrue: [ + assignmentNodeValue isUnaryMessageSend + ifTrue: [self inlineTemporaryNodeWithLiteralOrUnaryMessageExpression: anExpression + upTo: anIndex]. + assignmentNodeValue isInfix + ifTrue: [self inlineTemporaryNodeWithBinaryMessageExpression: anExpression + upTo: anIndex]. + assignmentNodeValue isKeywordMessageSend + ifTrue: [self inlineTemporaryNodeWithKeywordMessageExpression: anExpression + upTo: anIndex]. + + ] + ifFalse: [self inlineTemporaryNodeWithLiteralOrUnaryMessageExpression: anExpression upTo: anIndex].! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/19/2022 13:18:06'! +inlineFromNonDeclarationUsage + + assignmentToInlineRange := self findAssignmentOfUsage. + self inlineAssignment. +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/19/2022 13:17:11'! +inlineFromTemporaryDeclaration + + self assertTemporaryHasAtMostOneAssignment. + + assignmentToInlineRange := self findOnlyAssignmentRangeInNode: methodOrBlockNodeDeclaringTemporary. + + assignmentToInlineRange ~= nil + ifTrue: [self inlineAssignment] + ifFalse: [ + self assertUnassignedTemporaryIsNotReferenced. + self removeTemporaryVariableDeclaration + ] + + + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 2/16/2021 20:44:12'! +inlineTemp: aTempNode usedIn: aRange insideBinaryMessageNode: aBinaryMessageNode withBinaryExpression: aBinaryExpression + + (self temporaryNode: aTempNode referencedIn: aRange isArgumentIn: aBinaryMessageNode) + ifTrue: [self replaceRange: aRange withParenthesisedExpression: aBinaryExpression] + ifFalse: [self replaceRange: aRange withExpression: aBinaryExpression] + + + ! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/19/2022 13:26:48'! +inlineTemporaryNodeWithBinaryMessageExpression: anExpression upTo: anIndex + + | referencesToInline | + + referencesToInline := self findReferencesBetweenAssignmentAndIndex: anIndex. + referencesToInline do: [:range | + | parentNode | + + parentNode := (methodNode parseNodesPathAt: range first ifAbsent: [self shouldNotHappen]) second key. + + ((parentNode isMessageNode) and: [parentNode isKeywordMessageSend not]) + ifTrue: [ + parentNode isUnaryMessageSend ifTrue: [self replaceRange: range withParenthesisedExpression: anExpression ]. + parentNode isInfix ifTrue: [self inlineTemp: oldVariableNode usedIn: range insideBinaryMessageNode: parentNode + withBinaryExpression: anExpression]. + ] + ifFalse: [self replaceRange: range withExpression: anExpression.] + ]. ! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/19/2022 13:26:48'! +inlineTemporaryNodeWithKeywordMessageExpression: anExpression upTo: anIndex + + | referencesToInline | + + referencesToInline := self findReferencesBetweenAssignmentAndIndex: anIndex. + referencesToInline do: [:range | + | parentNode | + + parentNode := (methodNode parseNodesPathAt: range first ifAbsent: [self shouldNotHappen]) second key. + + (parentNode isMessageNode) + ifTrue: [ + parentNode isUnaryMessageSend ifTrue: [self replaceRange: range withParenthesisedExpression: anExpression ]. + ((parentNode isInfix) or: parentNode isKeywordMessageSend) ifTrue: [(self tempNodeIsReceiverOrArgumentOfReceiverWhenUsedIn: range) + ifTrue: [self replaceRange: range withParenthesisedExpression: anExpression] + ifFalse: [self replaceRange: range withExpression: anExpression ]] + ] + ifFalse: [self replaceRange: range withExpression: anExpression.] + ]. ! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/19/2022 13:26:48'! +inlineTemporaryNodeWithLiteralOrUnaryMessageExpression: anExpression upTo: anIndex + + | referencesToInline | + + referencesToInline := self findReferencesBetweenAssignmentAndIndex: anIndex. + + referencesToInline do: [:range | + self replaceRange: range withExpression: anExpression. + ]. + + + + ! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 4/3/2022 23:26:14'! +noReferencesToTemporaryAfter: endOfRefactoringScopeIndex + + ^(methodNode consolidateAsCollection: (methodNode rangeForNode: oldVariableNode + ifAbsent: [self shouldNotHappen ])) + noneSatisfy: [:aPosition | aPosition first > endOfRefactoringScopeIndex]. + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 11/28/2020 16:23:56'! +nodeIsAssignmentToTemporaryToInline: aNode + + ^ (aNode isAssignmentToTemporary) and: [aNode variable name = variableToInline]! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/13/2022 17:44:17'! +range: aRange isArgumentIn: aBinaryMessageNode + + ^ (methodNode consolidateAsCollection: (methodNode rangeForNode: aBinaryMessageNode ifAbsent: [self shouldNotHappen])) + anySatisfy: [:aBinaryMessageNodeRange | aBinaryMessageNodeRange includesAllOf: aRange]! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/13/2022 17:44:17'! +rangeIsLeftPartOfAssignmentToTemporary: aRange + + methodNode nodesDo: [:aNode | + (self nodeIsAssignmentToTemporaryToInline: aNode) ifTrue: [ + | ranges completeRanges | + + ranges := methodNode consolidateAsCollection: (methodNode rangeForNode: aNode ifAbsent: [self shouldNotHappen ]). + completeRanges := methodNode consolidateAsCollection:(methodNode completeSourceRangesOf: aNode ifAbsent: [self shouldNotHappen ]). + ((completeRanges anySatisfy: [:aCompleteRange | aCompleteRange includesAllOf: aRange]) + and: [ranges noneSatisfy: [:aNonCompleteRange | aNonCompleteRange includesAllOf: aRange ]]) ifTrue: [^true] + ] + ]. + + ^false + + ! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/16/2022 18:41:08'! +rangeIsPartOfTemporaryDeclaration: aRange + + ^(methodNode parseNodesPathAt: aRange first ifAbsent: [self shouldNotHappen]) + detect: [:aNodeAndRange | aNodeAndRange key isTemporariesDeclaration ] + ifFound: [:foundNodeAndRange | ^true] + ifNone: [^false].! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 5/2/2021 18:34:13'! +removeAssignment: assignmentToInline + + self replaceRange: assignmentToInline withExpression: ''. + + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 5/2/2021 19:14:06'! +removeTemporaryVariableDeclaration + + | temporariesDeclarationNodes temporariesDeclarationNode intervalToRemove sourceText | + + temporariesDeclarationNode := methodOrBlockNodeDeclaringTemporary temporariesDeclaration. + temporariesDeclarationNodes := temporariesDeclarationNode temporaryDeclarationNodes. + sourceText := methodNode sourceText. + temporariesDeclarationNodes size = 1 + ifTrue: [ + intervalToRemove := (methodNode rangeForNode: temporariesDeclarationNode + ifAbsent: [self shouldNotHappen ]) + asSourceCodeInterval expandUntilStartOfNextStatementOn: sourceText. + ] + ifFalse: [ + | temporaryDeclarationNode | + temporaryDeclarationNode := temporariesDeclarationNodes detect: [:aTemporaryDeclarationNode | + aTemporaryDeclarationNode declaresVariable: oldVariableNode ]. + intervalToRemove := (methodNode rangeForNode: temporaryDeclarationNode ifAbsent: [self shouldNotHappen ]) + asSourceCodeInterval expandUntilNextNonBlankCharacterOn: sourceText. + ]. + + self replaceRange: intervalToRemove withExpression: '' + ! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 12/28/2021 20:01:40'! +replaceRange: aRange withExpression: anExpression + + sourceCodeChanges add: (aRange -> anExpression). + + ! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 2/20/2021 19:55:15'! +replaceRange: aRange withParenthesisedExpression: anExpression + + self replaceRange: aRange withExpression: (self addParenthesesIfNeededTo: anExpression). + + ! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 5/2/2021 18:20:30'! +selectCompleteRangesOfAssignmentsToTemporaryFrom: aParseNode thatMatch: aConditionBlock + + | assignments | + + assignments := Set new. + aParseNode nodesDo: [:aNode | + (self nodeIsAssignmentToTemporaryToInline: aNode) + ifTrue: [ + | nodeRanges satisfyingRanges | + nodeRanges := methodNode completeSourceRanges at: aNode ifAbsent: []. + satisfyingRanges := (nodeRanges select: aConditionBlock) + collect:[:range | range asSourceCodeInterval + expandUntilStartOfNextStatementOn: methodNode sourceText]. + assignments addAll: (satisfyingRanges)] + ]. + + ^assignments + + + + + + +! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 3/13/2022 17:44:17'! +tempNodeIsReceiverOrArgumentOfReceiverWhenUsedIn: aRange + + methodNode nodesDo: [ :aNode | + (aNode isMessageNode + and: [(methodNode completeSourceRangesOf: aNode ifAbsent: [self shouldNotHappen]) + anySatisfy: [:completeRange | (completeRange includesAllOf: aRange) and: [completeRange last > aRange last] ]] + and: [(aNode receiver equivalentTo: oldVariableNode) + or: [aNode receiver isMessageNode and: [aNode receiver arguments + anySatisfy: [:argument | argument equivalentTo: oldVariableNode]]]] ) + ifTrue: [^true] + ]. + ^false.! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 2/14/2021 16:55:38'! +tempNodeToInline + + ^methodNode tempNodes select: [:aNode | aNode name = variableToInline].! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 2/16/2021 20:14:05'! +temporaryNode: aTempNode referencedIn: aRange isArgumentIn: aBinaryMessageNode + + ^ (aBinaryMessageNode arguments first equivalentTo: aTempNode) and: [self range: aRange isArgumentIn: aBinaryMessageNode]! ! + +!InlineTemporaryVariable methodsFor: 'applying primitives - private' stamp: 'FB 5/2/2021 18:07:51'! +usageToInlineIsTemporaryDeclaration + + ^(methodNode parseNodesPathAt: usageToInline first ifAbsent: [self shouldNotHappen ]) + anySatisfy: [:aNodeAndRangeAssociation | aNodeAndRangeAssociation key isTemporaryDeclaration]. + + + + + +! ! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlineTemporaryVariable class' category: #'Tools-Refactoring'! +InlineTemporaryVariable class + instanceVariableNames: 'variableToInline blockNodeDeclaringTemporary'! + +!InlineTemporaryVariable class methodsFor: 'errors' stamp: 'FB 11/29/2020 01:42:06'! +assignmentNotFoundErrorMessage + + ^'Variable is never assigned' +! ! + +!InlineTemporaryVariable class methodsFor: 'errors' stamp: 'FB 11/28/2020 16:27:34'! +moreThanOneAssignmentErrorMessage + + ^'There are multiple assignments that could be inlined. Please select a specific usage to inline'. +! ! + +!InlineTemporaryVariable class methodsFor: 'errors' stamp: 'FB 12/28/2021 20:02:39'! +selectionIsNotATemporaryVariableErrorMessage + + ^'Selected interval is not a temporary variable'.! ! + +!InlineTemporaryVariable class methodsFor: 'errors' stamp: 'FB 12/29/2021 21:11:34'! +signalAssignmentNotFound + + ^self refactoringError: (self assignmentNotFoundErrorMessage) + + + + + +! ! + +!InlineTemporaryVariable class methodsFor: 'errors' stamp: 'FB 12/21/2021 19:36:51'! +signalMoreThanOneAssignmentError + + self refactoringError: self moreThanOneAssignmentErrorMessage. + + + + + +! ! + +!InlineTemporaryVariable class methodsFor: 'errors' stamp: 'FB 12/28/2021 20:02:39'! +signalSelectedIntervalIsNotATemporary + + ^self refactoringError: self selectionIsNotATemporaryVariableErrorMessage +! ! + +!InlineTemporaryVariable class methodsFor: 'errors' stamp: 'FB 3/25/2021 20:15:05'! +signalTemporaryUsedInBlockSurroundedWithAssignments + + ^self refactoringError: self temporaryUsedInBlockSurroundedWithAssignmentsErrorMessage +! ! + +!InlineTemporaryVariable class methodsFor: 'errors' stamp: 'FB 3/25/2021 20:15:05'! +temporaryUsedInBlockSurroundedWithAssignmentsErrorMessage + + ^'Temporary is used in block and has multiple assignments'.! ! + + +!InlineTemporaryVariable class methodsFor: 'instance creation - private' stamp: 'FB 4/11/2021 20:18:01'! +findTemporaryNamed: temporaryName atUsage: usageInterval inMethodNode: aMethodNode + + | oldVariableNodeAndUsageInterval parseNodesPath | + + parseNodesPath := aMethodNode parseNodesPathAt: usageInterval first ifAbsent: [self signalSelectedIntervalIsNotATemporary]. + oldVariableNodeAndUsageInterval := parseNodesPath + detect: [:anAssociation | + | parseNode | + parseNode := anAssociation key. + (parseNode isTemp and: [parseNode isNamed: temporaryName])] + ifNone:[self signalSelectedIntervalIsNotATemporary]. + + ^{oldVariableNodeAndUsageInterval key. oldVariableNodeAndUsageInterval value}. +! ! + + +!InlineTemporaryVariable class methodsFor: 'instance creation' stamp: 'FB 4/11/2021 20:18:52'! +named: tempVarToInlineName atUsageInterval: usageInterval inMethod: compiledMethodToRefactor + + | oldVariableNodeAndUsageInterval methodNode | + methodNode := compiledMethodToRefactor methodNode. + oldVariableNodeAndUsageInterval := self findTemporaryNamed: tempVarToInlineName atUsage: usageInterval + inMethodNode: methodNode. + + ^self new + initializeOldVariableNode: oldVariableNodeAndUsageInterval first + usage: oldVariableNodeAndUsageInterval second + method: compiledMethodToRefactor methodNode: methodNode.! ! + +!InlineTemporaryVariableApplier methodsFor: 'refactoring - creation' stamp: 'FB 5/20/2021 20:54:28'! +createRefactoring + + ^ self refactoringClass + named: temporaryToInline + atUsageInterval: usageInterval + inMethod: methodToRefactor.! ! + +!InlineTemporaryVariableApplier methodsFor: 'refactoring - creation' stamp: 'FB 5/20/2021 20:28:41'! +refactoringClass + + ^ InlineTemporaryVariable ! ! + + +!InlineTemporaryVariableApplier methodsFor: 'refactoring - changes' stamp: 'FB 6/3/2021 19:22:49'! +requestRefactoringParameters! ! + +!InlineTemporaryVariableApplier methodsFor: 'refactoring - changes' stamp: 'FB 5/20/2021 20:55:04'! +showChanges + + codeProvider currentMethodRefactored! ! + + +!InlineTemporaryVariableApplier methodsFor: 'initialization' stamp: 'FB 5/20/2021 20:52:16'! +initializeOn: aCodeProvider forTemporary: aTemporaryToInline at: aUsageInterval of: aMethodToRefactor + + codeProvider := aCodeProvider. + temporaryToInline := aTemporaryToInline. + usageInterval := aUsageInterval. + methodToRefactor := aMethodToRefactor.! ! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlineTemporaryVariableApplier class' category: #'Tools-Refactoring'! +InlineTemporaryVariableApplier class + instanceVariableNames: ''! + +!InlineTemporaryVariableApplier class methodsFor: 'refactoring - creation' stamp: 'FB 12/21/2021 19:56:05'! +createAndValueHandlingExceptions: creationBlock + + + [super createAndValueHandlingExceptions: creationBlock] + on: Refactoring refactoringErrorClass + do: [ :refactoringError | ^self inform: refactoringError messageText ]. +! ! + +!InlineTemporaryVariableApplier class methodsFor: 'refactoring - creation' stamp: 'FB 6/3/2021 19:20:00'! +on: anEditor for: usageInterval of: aMethodToRefactor + + | tempToInline | + + tempToInline := anEditor wordUnder: usageInterval first. + + ^self new initializeOn: anEditor codeProvider forTemporary: tempToInline + at: usageInterval of: aMethodToRefactor ! ! + +!InlineTemporaryVariableApplier class methodsFor: 'refactoring - creation' stamp: 'FB 5/20/2021 20:27:02'! +refactoringClass + + ^ InlineTemporaryVariable ! ! + +!InlineMethodMessageSendsSet methodsFor: 'initialization' stamp: 'HAW 6/11/2022 19:15:58'! +addMessageNodeReference: aMessageNodeReference ifIncluded: anIncludedBlock + + (messageList includes: aMessageNodeReference) + ifTrue: [anIncludedBlock value] + ifFalse: [messageList add: aMessageNodeReference]! ! + +!InlineMethodMessageSendsSet methodsFor: 'initialization' stamp: 'FB 10/31/2021 15:52:40'! +initialize + + selectedIndex := 0. + super initialize ! ! + +!InlineMethodMessageSendsSet methodsFor: 'initialization' stamp: 'FB 10/31/2021 17:15:15'! +initializeApplier: anInlineMethodApplier + + applier := anInlineMethodApplier.! ! + + +!InlineMethodMessageSendsSet methodsFor: 'message list' stamp: 'FB 10/31/2021 15:52:41'! +messageListIndex + + ^selectedIndex ! ! + +!InlineMethodMessageSendsSet methodsFor: 'message list' stamp: 'FB 10/31/2021 15:52:41'! +messageListIndex: anIndex + + selectedIndex := anIndex. + ^super messageListIndex: anIndex ! ! + + +!InlineMethodMessageSendsSet methodsFor: 'source code ranges' stamp: 'FB 11/24/2021 23:24:15'! +messageSendsRangesOf: aMessageNodeReference + + | messageSend | + + messageSend := applier messageSendAt: self messageListIndex ifAbsent: [ ^#() ]. + messageSend completeSourceRange isEmpty + ifTrue: [^#()] + ifFalse: [^Array with: messageSend completeSourceRange] + + ! ! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'InlineMethodMessageSendsSet class' category: #'Tools-Refactoring'! +InlineMethodMessageSendsSet class + instanceVariableNames: ''! + +!InlineMethodMessageSendsSet class methodsFor: 'instance creation' stamp: 'FB 11/25/2021 00:25:16'! +applier: anInlineMethodApplier + + ^(self messageList: anInlineMethodApplier messageSendsToInline) initializeApplier: anInlineMethodApplier! ! + +!MessageNodeReference methodsFor: 'printing' stamp: 'FB 11/25/2021 00:12:18'! +displayStringOrText + "To be used in the UI" + + ^stringVersion ifNil: [String streamContents: [:aStream | self printOn: aStream ]].! ! + +!MessageNodeReference methodsFor: 'printing' stamp: 'FB 3/19/2022 19:43:35'! +prefixStringVersionWith: aString + + "TODO: duplicated code from MethodReference" + + self removeStringVersionPrefix. + stringVersion _ '[', aString, '] - ', (stringVersion ifNil: [self displayStringOrText]).! ! + +!MessageNodeReference methodsFor: 'printing' stamp: 'FB 11/25/2021 00:13:41'! +printOn: aStream + + classReference printOn: aStream. + aStream nextPutAll: '>>'. + selector printOn: aStream. + aStream newLine. + messageNode printOn: aStream. + aStream newLine. + completeSourceRange printOn: aStream.! ! + +!MessageNodeReference methodsFor: 'printing' stamp: 'FB 3/19/2022 19:41:12'! +removeStringVersionPrefix + + "TODO: duplicated code from MethodReference" + + stringVersion ifNotNil: [:string | | i prefixCoda | + prefixCoda _ '] - '. + i _ stringVersion findString: prefixCoda. + i = 0 ifFalse: [stringVersion _ stringVersion copyFrom: i + prefixCoda size to: stringVersion size ]. + ]. + + ! ! + +!MessageNodeReference methodsFor: 'printing' stamp: 'FB 11/24/2021 23:26:59'! +stringVersion + + ^stringVersion! ! + +!MessageNodeReference methodsFor: 'printing' stamp: 'FB 11/24/2021 23:26:47'! +stringVersion: aString + + stringVersion := aString.! ! + + +!MessageNodeReference methodsFor: 'accesing' stamp: 'FB 11/14/2021 18:04:33'! +actualClass + + ^classReference! ! + +!MessageNodeReference methodsFor: 'accesing' stamp: 'FB 11/3/2021 19:51:41'! +compiledMethod + + ^classReference >> selector ! ! + +!MessageNodeReference methodsFor: 'accesing' stamp: 'FB 10/31/2021 23:04:04'! +completeSourceRange + + ^completeSourceRange! ! + +!MessageNodeReference methodsFor: 'accesing' stamp: 'FB 3/19/2022 19:13:52'! +isPossibleMessageSend + + "Implements polymorphism with PossbileMessageNodeReference" + + ^false! ! + +!MessageNodeReference methodsFor: 'accesing' stamp: 'FB 10/31/2021 21:00:34'! +messageNode + + ^messageNode ! ! + +!MessageNodeReference methodsFor: 'accesing' stamp: 'FB 11/14/2021 18:15:07'! +messageSendsRangesOf: aSelector + + "To use polimorphysm with MethodReference - Fernando" + + ^completeSourceRange! ! + +!MessageNodeReference methodsFor: 'accesing' stamp: 'FB 11/3/2021 20:03:36'! +methodNode + + ^methodNode! ! + +!MessageNodeReference methodsFor: 'accesing' stamp: 'FB 11/14/2021 17:19:18'! +methodReference + + ^MethodReference class: classReference selector: selector.! ! + +!MessageNodeReference methodsFor: 'accesing' stamp: 'FB 11/14/2021 18:05:14'! +methodSymbol + + ^selector! ! + +!MessageNodeReference methodsFor: 'accesing' stamp: 'FB 11/14/2021 18:06:31'! +selectorOfMessageNode + + ^messageNode selector key! ! + + +!MessageNodeReference methodsFor: 'comparing' stamp: 'HAW 6/11/2022 19:24:06'! +asPossibleMessageNodeReference + + ^PossibleMessageNodeReference + messageNode: messageNode + selector: selector + class: classReference + completeSourceRange: completeSourceRange.! ! + +!MessageNodeReference methodsFor: 'comparing' stamp: 'HAW 6/11/2022 19:24:24'! +equivalentTo: anObject + + ^(anObject isKindOf: MessageNodeReference) + and: [anObject actualClass = classReference] + and: [anObject methodNode sourceText = methodNode sourceText ] + and: [anObject messageNode equivalentTo: messageNode ] + and: [anObject completeSourceRange = completeSourceRange ] + ! ! + + +!MessageNodeReference methodsFor: 'testing' stamp: 'FB 11/25/2021 00:30:20'! +isMessageListTitle + + ^completeSourceRange = #() +! ! + + +!MessageNodeReference methodsFor: 'initialization' stamp: 'FB 3/19/2022 19:41:58'! +messageNode: aMessageNode selector: aSelector class: aClass completeSourceRange: aCompleteSourceRange + + messageNode := aMessageNode. + selector := aSelector. + classReference := aClass. + completeSourceRange := aCompleteSourceRange. + "When no source range is passed it means this is a dummy message node reference that works as a title in the message list window + and the selector is not even defined in the class - Fernando" + self isMessageListTitle ifFalse: [methodNode := (classReference >> selector) methodNode.]. + ! ! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'MessageNodeReference class' category: #'Tools-Refactoring'! +MessageNodeReference class + instanceVariableNames: ''! + +!MessageNodeReference class methodsFor: 'initialization' stamp: 'FB 11/13/2021 17:39:03'! +messageNode: aMessageNode selector: aSelector class: aClass completeSourceRange: aCompleteSourceRange + + ^self new messageNode: aMessageNode selector: aSelector class: aClass completeSourceRange: aCompleteSourceRange.! ! + +!PossibleMessageNodeReference methodsFor: 'accesing' stamp: 'FB 3/19/2022 19:13:17'! +isPossibleMessageSend + + ^true! ! + + +!PossibleMessageNodeReference methodsFor: 'initialization' stamp: 'FB 3/19/2022 19:23:16'! +messageNode: aMessageNode selector: aSelector class: aClass completeSourceRange: aCompleteSourceRange + + super messageNode: aMessageNode selector: aSelector class: aClass completeSourceRange: aCompleteSourceRange. + self prefixStringVersionWith: self class possibleMessageSendStringVersionHeader.! ! + +"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! + +!classDefinition: 'PossibleMessageNodeReference class' category: #'Tools-Refactoring'! +PossibleMessageNodeReference class + instanceVariableNames: ''! + +!PossibleMessageNodeReference class methodsFor: 'printing' stamp: 'FB 3/19/2022 19:10:06'! +possibleMessageSendStringVersionHeader + + "TODO: duplicated code from PossibleSender" + + ^'Possible'! ! + + +!PossibleMessageNodeReference class methodsFor: 'instance creation' stamp: 'FB 3/19/2022 19:15:35'! +messageNode: aMessageNode selector: aSelector class: aClass completeSourceRange: aCompleteSourceRange + + ^self new messageNode: aMessageNode selector: aSelector class: aClass completeSourceRange: aCompleteSourceRange.! ! + +!CompiledMethod reorganize! +('accessing' accessorDescriptionOf:at: bytecodeSetName clearFlag defaultSelector encoderClass endPC flag flushCache frameSize initialPC methodClass methodClass: methodClassAssociation methodClassAssociation: methodReference numArgs numLiterals numTemps primitive properties properties: returnField scanner searchForClass searchForSelector selector selector: trailer) +('comparing' = equivalentTo: hash) +('testing' accessesInstanceVariable: hasArgumentOrTemporaryNamed: hasNewPropertyFormat hasReportableSlip hasVariableBindingTo: is: isGetterOf:at: isInstalled isQuick isReturnField isReturnSelf isReturnSpecial isSetterOf:at: isTestMethod isValid readsInstanceVariable: referencesParameterAt: referencesSelf referencesSuper sendsOrRefersTo: usesClosureBytecodes writesInstanceVariable:) +('printing' abstractSymbolic classAndSelector decompileString longPrintOn: longPrintOn:indent: longPrintRelativeOn:indent: primitiveErrorVariableName printClassAndSelectorOn: printOn: printPrimitiveOn: storeLiteralsOn:forClass: storeOn: symbolic symbolicLinesDo:) +('literals' allLiterals hasLiteral: hasLiteralSuchThat: hasLiteralThorough: header headerDescription indexOfLiteral: literalAt: literalAt:put: literalStrings literals literalsDo: objectAt: objectAt:put: refersToLiteral: sendsSelector: xtraBindings) +('scanning' messages messagesDo: messagesSequence readsField: readsRef: scanFor: scanLongLoad: scanLongStore: scanVeryLongLoad:offset: scanVeryLongStore:offset: sendsToSuper writesField: writesFieldCode:with:using: writesRef:) +('source code management' checkOKToAdd:at:in: destroySourcePointer fileIndex filePosition getPreamble getSource getSourceFor:in: getSourceFromFile linesOfCode putSource:fromParseNode:class:category:inFile:priorMethod: putSource:fromParseNode:class:category:withStamp:inFile:priorMethod:overridesMethod: putSource:fromParseNode:inFile:withPreamble: setSourcePointer: setSourcePosition:inFile: sourceCode sourcePointer) +('file in/out' objectForDataStream: readDataFrom:size: storeDataOn: zapSourcePointer) +('evaluating' valueWithReceiver:arguments:) +('decompiling' compilerClass decompile decompilerClass methodForDecompile methodNode methodNode: parserClass selectorAndArgumentsAsString) +('breakpoints' hasBreakpoint) +('code analysis' scanForEqSmallConstant) +('debugger support' abstractPCForConcretePC: blockExtentsInto:from:to:scanner:numberer: debuggerMap mapFromBlockKeys:toSchematicTemps: pcPreviousTo: startpcsToBlockExtents tempsSubSequenceFrom:) +('private' penultimateLiteral penultimateLiteral:) +('accessing-pragmas & properties' pragmaAt: pragmas propertyKeysAndValuesDo: propertyValueAt: propertyValueAt:ifAbsent: propertyValueAt:put: removeProperties removeProperty: removeProperty:ifAbsent: withPropertiesDo: withPropertiesDo:ifSelector:) +('closures' containsBlockClosures embeddedBlockClosures) +('tracing' outboundPointersDo:) +('converting' asMethodReference asString) +('time stamp' author dateAndTime dateMethodLastSubmitted dateSortingValue timeStamp) +('inspecting' explorerContents inspectorClass) +('organization' category) +('initialization' copyWithTrailerBytes: needsFrameSize:) +('auto complete' autoCompleterDocumentationAppendingToParameter:toReturn: commentAutoCompleterDocumentationAppendigTo:using: commentAutoCompleterDocumentationOf: dynamicTypingAutoCompleterDocumentation receiverTextAutoCompleterDocumentation selectorAutoCompleterDocumentationAppendingTo:using:appendingToParameter:) +('source code ranges' messageSendsRangesOf:) +('ometa2preload' createMethodNode) +('user interface support' browse) +('copying' flattenTo:) +! + + +!Interval reorganize! +('accessing' anyOne at: at:put: extent first increment isEmpty last rangeIncludes: size) +('comparing' = hash) +('adding' add:) +('removing' remove:) +('enumerating' do: permutationsDo: reverseDo:) +('printing' printOn: storeOn:) +('private' setFrom:to:count: species) +('testing' includes: includesAllOf: isInterval) +('arithmetic' + -) +('converting' asSourceCodeInterval) +! + + +!SourceCodeInterval reorganize! +('converting' asSourceCodeInterval) +('source code' codeAfterIntervalOn: expandToMatchExpressionOn: expandUntilNextNonBlankCharacterOn: expandUntilStartOfNextStatementOn: expandUntilStatementEndOn: lastCharacterOfRangeOn: nextNonBlankCharacterIs:on: nextNonBlankCharacterIsDotOn: trimToMatchExpressionOn:) +('private - source code' canBeExpandedStartingWith:endingWith: canBeTrimmed: expandBy: trimLeft:right:) +('testing' endsOnDotOn: intervalEndsOnEndOfStatementIn: isEndOfLastStatementOn: isEndOfTemporariesDeclarationOn: isLastStatementOfBlockOn:) +! + + +!SourceCodeInterval class reorganize! +('error messages' canNotExpandIncompleteStatementError) +! + + +!ParseNode reorganize! +('code generation' pc pc:) +('code generation (closures)' optimizedBlockHoistTempsInto:) +('code generation (new scheme)' emitCodeForBlockValue:encoder: emitCodeForBranchOn:dist:pop:encoder: emitCodeForEffect:encoder: emitCodeForJump:encoder: emitCodeForReturn:encoder: sizeCode:forBranchOn:dist: sizeCode:forJump: sizeCodeForBlockValue: sizeCodeForEffect: sizeCodeForReturn:) +('comment') +('converting' asReturnNode) +('encoding' encodeSelector:) +('printing' nodePrintOn:indent: printCommentOn:indent: printOn: printOn:indent: printOn:indent:precedence: printSourceCode printWithClosureAnalysis printWithClosureAnalysisOn: printWithClosureAnalysisOn:indent: printWithClosureAnalysisOn:indent:precedence:) +('source ranges' expandRange:basedOn: expandRange:basedOnChildRange: expandRanges:basedOn:using:) +('testing' assignmentCheck:at: canCascade ensureCanCascade: equivalentTo: isArg isAssignmentNode isAssignmentToTemporary isBacktickNode isBlockNode isBraceNode isCascadeNode isComplex isConstantCharacter isConstantNumber isFalsePseudoVariable isInstanceVariableNode isJust: isLiteralNode isLiteralVariableNode isMessage isMessage:receiver:arguments: isMessageNamed: isMessageNode isMethodNode isNilPseudoVariable isOnlySubnodeOf:in: isReturn isReturnSelf isReturningIf isSelectorNode isSelfBasicNewMessageSend isSelfNewMessageSend isSelfPseudoVariable isSpecialConstant isSuperPseudoVariable isTemp isTempOrArg isTemporariesDeclaration isTemporaryDeclaration isThisContextPseudoVariable isTruePseudoVariable isUndefTemp isUnusedTemp isVariableNode isVariableReference nowHasDef nowHasRef printsInNewLine referencesSelf referencesSuper toDoIncrement:) +('tiles' currentValueIn:) +('visiting' accept: nodesDo:) +('private' consolidateAsCollection: ifNilReceiver nextWordFrom:setCharacter: printSingleComment:on:indent:) +('accessing' comment comment:) +! + + +!AssignmentNode reorganize! +('code generation' emitCodeForEffect:encoder: emitCodeForValue:encoder: sizeCodeForEffect: sizeCodeForValue:) +('code generation (closures)' analyseTempsWithin:rootNode:assignmentPools:) +('equation translation' variable) +('initialization' toDoIncrement: value variable:value:from: variable:value:from:sourceRange:) +('printing' printOn:indent: printOn:indent:precedence: printWithClosureAnalysisOn:indent: printWithClosureAnalysisOn:indent:precedence:) +('source ranges' expandRanges:basedOn:using:) +('testing' equivalentTo: isAssignmentNode isAssignmentToTemporary isComplex referencesSelf referencesSuper) +('visiting' accept:) +('initialize-release' variable:value:) +! + + +!BlockNode reorganize! +('accessing' addArgument: arguments arguments: block closureCreationNode firstArgument nArgsSlot nArgsSlot: numberOfArguments optimized returnLast returnNilIfNoOther returnSelfIfNoOther: startOfLastStatement startOfLastStatement: temporaries temporaries: temporariesDeclaration temporariesDeclaration: tempsMark tempsMark:) +('code generation' code) +('code generation (closures)' actualScope addHoistedTemps: addRemoteTemp:rootNode: addTempNode: analyseArguments:temporaries:rootNode: analyseTempsWithin:rootNode:assignmentPools: blockExtent computeCopiedValues: constructClosureCreationNode: deoptimize emitCodeForClosureValue:encoder: emitCodeForEvaluatedClosureValue:encoder: ifHasRemoteTempNodeEnsureInitializationStatementExists: makeTemporariesRemovable nilReadBeforeWrittenTemps noteOptimizedIn: optimizedBlockHoistTempsInto: postNumberingProcessTempsWithin:rootNode: reindexingLocalsDo:encoder: remoteTempNodeName removeTempNode:ifAbsent: sizeCodeForClosureValue: sizeCodeForEvaluatedClosureValue:) +('code generation (new scheme)' emitCodeExceptLast:encoder: emitCodeForEvaluatedEffect:encoder: emitCodeForEvaluatedValue:encoder: emitCodeForValue:encoder: sizeCodeExceptLast: sizeCodeForEvaluatedEffect: sizeCodeForEvaluatedValue: sizeCodeForValue:) +('enumerating' statementsDo:) +('equation translation' statements statements:) +('initialization' arguments:statements:returns:from: noteSourceRangeStart:end:encoder: statements:returns:) +('printing' decompileString printArgumentsOn:indent: printOn:indent: printStatementsOn:indent: printTemporaries:on:doPrior: printWithClosureAnalysisArgumentsOn:indent: printWithClosureAnalysisOn:indent: printWithClosureAnalysisStatementsOn:indent: printWithClosureAnalysisTemporariesOn:indent:) +('source ranges' expandRanges:basedOn:using:) +('testing' equivalentTo: hasArgumentOrTemporaryNamed: isBlockNode isComplex isJust: isJustCaseError isQuick printsInNewLine referencesSelf referencesSuper returns) +('visiting' accept:) +('private' hasEquivalentStatementsWith:) +! + + +!MethodNode reorganize! +('visiting' accept:) +('accessing' argumentNames arguments arguments: body numberOfStatements primitiveErrorVariableName removeProperty: tempNodes temporaries temporaries: temporariesDeclaration temporariesDeclaration:) +('converting' decompileString preen preenLocalIfNotNilArg) +('code generation' encoder generate generate: generate:ifQuick: generate:using: generate:using:ifQuick: generatePreSpur:using: generateSpur:using: parserClass properties selector selectorNode) +('printing' classAndSelector ifPrimitivePrintOn: methodClass printCommentOn: printOn: printPragmasOn: printPrimitiveOn: printPropertiesOn: printSelectorAndArgumentsOn: printTemporariesOn: printWithClosureAnalysisOn: selectorAndArgumentsAsString sourceText tempNames) +('source mapping' addPositionTo:of:inside: completeSourceRanges completeSourceRangesDo: completeSourceRangesOf:ifAbsent: messageSendKeywordAndParameterPositionsAt:of:ifAbsent: messageSendKeywordPositionsAt:of:ifAbsent: messageSendLastPositionsOf:ifAbsent: messageSendSelectorKeywordPositionsOf:ifAbsent: nextPositionAfterAddPositionTo:of:startingAt: parameterDefinitionPositionAt: parseNodeIncluding:ifAbsent: parseNodesPathAt:ifAbsent: positionsForInstanceVariable:ifAbsent: positionsForLiteralNode:ifAbsent: positionsForLiteralVariableNode:ifAbsent: positionsForTemporaryVariable:ifAbsent: positionsInLiteralArrayOf: positionsOf:containedIn: rangeForNode:ifAbsent: rawSourceRanges rawSourceRangesAndMethodDo: selectorKeywordPositionAt: selectorKeywordsPositions selectorLastPosition singleCompleteSourceRangeOf: singleCompleteSourceRangeOf:ifPresent:ifAbsent: withParseNodeIncluding:do:ifAbsent:) +('primitive error codes' removeAndRenameLastTempIfErrorCode) +('debugger support' blockExtentsToTempsMap hasGeneratedMethod) +('code generation (closures)' addLocalsToPool: ensureClosureAnalysisDone locationCounter noteBlockEntry: noteBlockExit: referencedValuesWithinBlockExtent:) +('initialization' block selector: selector:arguments:precedence:temporaries:block:encoder:primitive: selector:arguments:precedence:temporaries:block:encoder:primitive:properties: selector:arguments:precedence:temporaries:block:encoder:primitive:properties:selectorKeywordsRanges: selector:arguments:precedence:temporariesDeclaration:block:encoder:primitive:properties: selector:arguments:precedence:temporariesDeclaration:block:encoder:primitive:properties:selectorKeywordsRanges: sourceText:) +('testing' allParseNodesWithin:satisfy: anyParseNodeWithin:satisfy: equivalentTo: hasArgumentOrTemporaryNamed: hasLocalNamed: isMethodNode isMultipleRanges: referencesSelf referencesSuper) +('source ranges' definitionStartPosition) +! + + +!VariableNode reorganize! +('visiting' accept:) +('testing' assignmentCheck:at: equivalentTo: index isFalsePseudoVariable isNamed: isNilPseudoVariable isSelfPseudoVariable isSuperPseudoVariable isThisContextPseudoVariable isTruePseudoVariable isUndeclared isVariableNode isVariableReference referencesSelf referencesSuper varNodeType) +('code generation (closures)' beingAssignedToAnalyseTempsWithin:rootNode:assignmentPools:) +('tiles' currentValueIn: variableGetterBlockIn:) +('code generation (new scheme)' emitCodeForReturn:encoder: emitCodeForStore:encoder: emitCodeForStorePop:encoder: emitCodeForValue:encoder: sizeCodeForStore: sizeCodeForStorePop: sizeCodeForValue:) +('code generation' emitCodeForLoad:forValue:encoder: fieldOffset sizeCodeForReturn:) +('accessing' name) +('printing' printOn:indent: printWithClosureAnalysisOn:indent:) +('initialization' asStorableNode: name: name:index:type: name:key:code: name:key:index:type: nameAndKey:) +! + + +!MessageNode reorganize! +('visiting' accept: argumentsInEvaluationOrder) +('code generation (closures)' analyseTempsWithin:rootNode:assignmentPools:) +('equation translation' arguments arguments: eval originalArguments originalReceiver receiver receiver: selector) +('printing' macroPrinter precedence printCaseOn:indent: printIfNil:indent: printIfNilNotNil:indent: printIfOn:indent: printKeywords:arguments:on:indent: printOn:indent: printOn:indent:precedence: printParenReceiver:on:indent: printReceiver:on:indent: printRepeatOn:indent: printToDoOn:indent: printWhileOn:indent: printWithClosureAnalysisCaseOn:indent: printWithClosureAnalysisIfNil:indent: printWithClosureAnalysisIfNilNotNil:indent: printWithClosureAnalysisIfOn:indent: printWithClosureAnalysisKeywords:arguments:on:indent: printWithClosureAnalysisOn:indent: printWithClosureAnalysisOn:indent:precedence: printWithClosureAnalysisParenReceiver:on:indent: printWithClosureAnalysisReceiver:on:indent: printWithClosureAnalysisToDoOn:indent: printWithClosureAnalysisWhileOn:indent:) +('source ranges' expandRanges:basedOn:using: keywordAndParameterPositionAt:encodedWith:ifAbsent: keywordPositionAt: keywordRanges receiverSourceRangesFrom:) +('testing' canCascade ensureCanCascade: equivalentTo: isCascade isComplex isKeywordMessageSend isMessage isMessage:receiver:arguments: isMessageNamed: isMessageNode isNilIf isOptimized isOptimizedLoop isReturningIf isSelfBasicNewMessageSend isSelfNewMessageSend referencesSelf referencesSuper toDoIncrement: toDoLimit:) +('cascading' receiver:arguments:precedence:) +('private' checkBlock:as:from:maxArgs: compare:with: hasEquivalentArgumentsWith: hasEquivalentReceiverWith: ifNilReceiver pvtCheckForPvtSelector: transform:) +('code generation' emitCodeForEffect:encoder: emitCodeForRepeat:encoder:value: emitCodeForToDo:encoder:value: emitCodeForValue:encoder: sizeCodeForCase:value: sizeCodeForEffect: sizeCodeForRepeat:value: sizeCodeForToDo:value: sizeCodeForValue: sizeCodeForWhile:value:) +('code generation (new scheme)' emitCodeForCase:encoder:value: emitCodeForIf:encoder:value: emitCodeForIfNil:encoder:value: emitCodeForWhile:encoder:value: sizeCodeForIf:value: sizeCodeForIfNil:value:) +('macro transformations' noteSpecialSelector: toDoFromWhileWithInit: transformAnd: transformBoolean: transformCase: transformIfFalse: transformIfFalseIfTrue: transformIfNil: transformIfNilIfNotNil: transformIfNotNilIfNil: transformIfTrue: transformIfTrueIfFalse: transformOr: transformRepeat: transformToDo: transformWhile:) +('initialization' receiver:selector:arguments:precedence: receiver:selector:arguments:precedence:from: receiver:selector:arguments:precedence:from:sourceRange:keywordsRanges: selector:) +('accessing' selectorSymbol) +('initialize-release' receiver:selector:arguments:precedence:from:sourceRange:) +('expression types' cascadeReceiver) +! + + +!ReturnNode reorganize! +('visiting' accept:) +('code generation (closures)' analyseTempsWithin:rootNode:assignmentPools:) +('converting' asReturnNode) +('code generation' code) +('code generation (new scheme)' emitCodeForReturn:encoder: emitCodeForValue:encoder: sizeCodeForReturn: sizeCodeForValue:) +('printing' expr printOn:indent: printWithClosureAnalysisOn:indent:) +('testing' equivalentTo: isImplicitSelfReturnIn: isReturn isReturnSelf isSpecialConstant isVariableReference referencesSelf referencesSuper) +('initialization') +('initialize-release' expr: expr:encoder:sourceRange:) +! + + +!SmalltalkEditor reorganize! +('accessing-selection') +('contextual add/remove parameter' changeSelector:in:at:using: changeSelectorOf:in:at:using: changeSelectorTo:in:using: contextualAddParameter contextualAddParameter: contextualChangeSelectorInMethodUsing: contextualChangeSelectorOf:in:using: contextualChangeSelectorUsing: contextualExtractAsParameter contextualExtractAsParameter: contextualRemoveParameter contextualRemoveParameter: extractAsParameter) +('contextual push up/down inst. var' apply:inClassDefinitionOf:in: contextualPushDownInClassDefinition contextualPushUpInClassDefinition ifEditingClassDefinitionDoOrWarn: inClassDefinitionContextuallyApply: informRefactoringCanOnlyBeAppliedInClassDefinition) +('contextual rename' contextualRename contextualRename: contextualRenameInClassDefinition contextualRenameInClassDefinitionOf:in: contextualRenameInMethod contextualRenameOf:in: ifSourceCodeRefactoringCanBeAppliedDo: isEditingClassDefinition rename:in:at: renameClassOn:for: renameGlobalOn:for: renameInstanceVariableOn:for:at: renameSelectorFor:in: renameSelectorOf:in:at: renameTemporary:at: selectedClassOrMetaClassOrUndefinedObject withClassDefinitionNodeAndClassDo:ifErrorsParsing: withMethodNodeAndClassDo:ifErrorsParsing:) +('do-its' afterCompiling:do:for:in:ifFail: afterCompiling:do:ifFail: debug:receiver:in: debugIt doIt doItProfiling: doItSourceCodeFor:in: evaluate:andDo:ifFail:profiled: evaluateSelectionAndDo:ifFail:profiled: exploreIt inspectIt inspectSelectionOrLine printIt profileIt selectForInspection:in: selectMessageNode:in: selectNodeRange:in: selectNodeUnderCursorForInspectionIn: withReceiverRangeOf:in:selectorPosition:do:) +('editing keys' acceptAndDebugTest: acceptAndTest: acceptAndTestAll: browseIt: debugIt: doIt: exploreIt: fileItIn: implementorsOfIt: inspectIt: methodStringsContainingit: pasteInitials: printIt: referencesToIt: save: sendersOfIt:) +('events' clickAndHalf) +('explain' explainAnySel: explainChar: explainClass: explainCtxt: explainDelimitor: explainGlobal: explainInst: explainMySel: explainNumber: explainPartSel: explainTemp:) +('extract to temporary' extractToTemporary extractToTemporary:) +('extract method' extractMethod extractMethod:) +('menu' createMenuCollectingOptionsWith: getMenu getMenu2 openMenu openMenu2 openMenu: openSmalltalkEditorRefactoringMenu refactoringMenu) +('menu messages' browseClassFromIt browseImplementorsAt: browseIt classCommentsContainingIt explain fileItIn implementorsOfIt implementorsOfItWhenErrorsParsing methodSourceContainingIt methodStringsContainingit paste referencesToIt referencesToSelectedLiteral selectedSelector selectedSymbol sendersOfIt sendersOfItWhenErrorsParsing withSelectorAt:do:ifBehavior:otherwise: withSelectorUnderCursorDo:ifBehavior:otherwise:) +('new selection' nextTokenFrom:direction: notify:at:in: selectPrecedingIdentifier wordLeftDelimiters wordRightDelimiters) +('tdd' acceptAndDebugTest acceptAndTest acceptAndTestAll acceptAndWithMethodDo: acceptThenTestMethodAndSuite: runAndDebuggIfNecessary: runTestSuite: testSuiteForCategoryOf: testSuiteOf:) +('temp to inst var' temporaryToInstanceVariable temporaryToInstanceVariable: withNodeUnderCursorDo:ifAbsent:) +('typing/selecting keys' argNext: argPrev: displayIfFalse: displayIfTrue: newLine: normalCharacter:) +('private' codeProvider hasValidCurrentCompiledMethod performCodeExtractionRefactoringWith:) +('quick action (shift+click)' hoverHelpStringOfEvaluating: hoverHelpToShowEvaluating: implementorsOfNodeUnder: quickPrintOfNodeUnder:) +('inline method' actualImplementorsOfIt actualImplementorsOfIt: actualLocalImplementorsOfIt actualLocalImplementorsOfIt: actualSendersOfIt actualSendersOfIt: balloonTypeInfoAt: balloonTypeInfoInMethodAt: balloonTypeInfoOf:in:definedAt: balloonTypeInfoOfInstanceVariableAt: showSelectionTypeInfo showSelectionTypeInfo: showSelectionTypeInfoInMethod showTypeInfoOf:in:definedAt: showTypeInfoOfInstanceVariable typeCheckMethod typeCheckMethod: contextualInlineMethod contextualInlineMethod: contextualInlineMethodOf:in: inlineMethodInUsage:) +('inline temporaray variable' inlineTemporaryVariable inlineTemporaryVariable:) +! + + +!BrowserWindow reorganize! +('GUI building' buildLowerPanes buildMorphicClassColumnWith: buildMorphicClassList buildMorphicCommentPane buildMorphicMessageCatList buildMorphicMessageList buildMorphicSwitches buildMorphicSystemCategoryList buildMorphicWindow buildNoSysCatMorphicWindow createClassButton createCodePaneMorph createCommentButton createInstanceButton windowColor) +('menu building' addExtraMenu2ItemsTo: classListMenu classListMenu2 messageCategoryMenu messageListMenu messageListMenu2 systemCatSingletonMenu systemCategoryMenu) +('menu commands' browseAllClasses openSystemCategoryBrowser) +('keyboard shortcuts' messageListKey:from: systemCatListKey:from: systemCatSingletonKey:from:) +('updating' classAdded: classRenamed:from:to:inCategory: disableCodePaneEditing editSelectionChanged enableCodePaneEditing isEditSelectionNone update:) +('refactorings' addInstVar addParameter changeKeywordOrder classRefactoringMenu inlineMethod messageRefactoringMenu moveToInstanceOrClassMethod openClassRefactoringMenu openMessageRefactoringMenu pushDownInstanceVariable pushDownSelector pushUpInstanceVariable pushUpSelector removeAllUnreferencedInstVar removeInstVar removeParameter renameInstVar renameSelector) +('commands' findClass) +! + + +!MethodReference reorganize! +('queries' actualClass actualClassIfAbsent: category classIsMeta classSymbol compiledMethod compiledMethodIfAbsent: isValid methodSymbol selector sourceCode sourceCodeIfAbsent:) +('setting' indentLevel: prefixStringVersionWith: removeStringVersionPrefix setClass:methodSymbol:stringVersion: setClassSymbol:classIsMeta:methodSymbol:stringVersion: setStandardClass:methodSymbol:) +('string version' stringVersion) +('comparisons' <= = hash) +('services' updateReferencesTo:toBe:) +('printing' displayStringOrText printClassAndSelectorOn: printOn:) +('auto complete' dynamicTypingAutoCompleterDocumentation methodClass) +('source code ranges' messageSendsRangesOf:) +('testing' hasVariableBindingTo: isMessageListTitle referencesParameterAt:) +('decompiling' methodNode) +! + + +!RefactoringApplier class reorganize! +('value handling exceptions' createAndValueHandlingExceptions:) +('initialization' initialize) +('appliers - registering' registerAddParameterApplier: registerExtractAsParameterApplier: registerInlineMethodApplier: registerRemoveParameterApplier: registerRenameSelectorApplier:) +('appliers - getting' addParameterApplier extractAsParameterApplier inlineMethodApplier removeParameterApplier renameSelectorApplier) +('appliers - id' addParameterApplierId extractAsParameterApplierId inlineMethodApplierId removeParameterApplierId renameSelectorApplierId) +('appliers - resetting' resetAddParameterApplier resetExtractAsParameterApplier resetInlineMethodApplier resetRemoveParameterApplier resetRenameSelectorApplier) +('appliers - private' applierAt:ifAbsent: registerApplierAt:with: resetApplierAt:) +! + + +!RefactoringMenues class reorganize! +('editor menus' messageRefactoringMenuOptions smalltalkEditorMenuOptions smalltalkEditorRefactoringMenuOptions) +('browser menues' classListMenuOptions classRefactoringMenuOptions messageListMenuOptions) +('initialization' initialize) +('shortcuts' smalltalkEditorCmdShortcutsSpec) +! diff --git a/Packages/BaseImageTests.pck.st b/Packages/BaseImageTests.pck.st index 964373f6..1fa24041 100644 --- a/Packages/BaseImageTests.pck.st +++ b/Packages/BaseImageTests.pck.st @@ -1,6 +1,6 @@ -'From Cuis 6.0 [latest update: #5234] on 7 June 2022 at 4:13:43 pm'! -'Description Fix to assertRenamesToWithoutBlanks:'! -!provides: 'BaseImageTests' 1 293! +'From Cuis 6.0 [latest update: #5234] on 11 June 2022 at 11:48:46 pm'! +'Description Inline method and temp var tests'! +!provides: 'BaseImageTests' 1 294! !requires: '__Refactoring-TestData__' 1 0 nil! SystemOrganization addCategory: 'BaseImageTests-Kernel-Objects'! SystemOrganization addCategory: 'BaseImageTests-Kernel-Classes'! @@ -66,104 +66,64 @@ Notification subclass: #MyTestNotification MyTestNotification class instanceVariableNames: ''! -!classDefinition: #BinarySearchTest category: 'BaseImageTests-Collections'! -TestCase subclass: #BinarySearchTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Collections'! -!classDefinition: 'BinarySearchTest class' category: 'BaseImageTests-Collections'! -BinarySearchTest class - instanceVariableNames: ''! - -!classDefinition: #CollectTest category: 'BaseImageTests-Collections'! -TestCase subclass: #CollectTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Collections'! -!classDefinition: 'CollectTest class' category: 'BaseImageTests-Collections'! -CollectTest class - instanceVariableNames: ''! - -!classDefinition: #CollectionTest category: 'BaseImageTests-Collections'! -TestCase subclass: #CollectionTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Collections'! -!classDefinition: 'CollectionTest class' category: 'BaseImageTests-Collections'! -CollectionTest class - instanceVariableNames: ''! - -!classDefinition: #DictionaryTest category: 'BaseImageTests-Collections'! -TestCase subclass: #DictionaryTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Collections'! -!classDefinition: 'DictionaryTest class' category: 'BaseImageTests-Collections'! -DictionaryTest class - instanceVariableNames: ''! - -!classDefinition: #IntervalTest category: 'BaseImageTests-Collections'! -TestCase subclass: #IntervalTest +!classDefinition: #BecomeTest category: 'BaseImageTests-Kernel-Objects'! +TestCase subclass: #BecomeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Collections'! -!classDefinition: 'IntervalTest class' category: 'BaseImageTests-Collections'! -IntervalTest class + category: 'BaseImageTests-Kernel-Objects'! +!classDefinition: 'BecomeTest class' category: 'BaseImageTests-Kernel-Objects'! +BecomeTest class instanceVariableNames: ''! -!classDefinition: #OrderedCollectionTest category: 'BaseImageTests-Collections'! -TestCase subclass: #OrderedCollectionTest +!classDefinition: #BooleanTest category: 'BaseImageTests-Kernel-Objects'! +TestCase subclass: #BooleanTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Collections'! -!classDefinition: 'OrderedCollectionTest class' category: 'BaseImageTests-Collections'! -OrderedCollectionTest class + category: 'BaseImageTests-Kernel-Objects'! +!classDefinition: 'BooleanTest class' category: 'BaseImageTests-Kernel-Objects'! +BooleanTest class instanceVariableNames: ''! -!classDefinition: #OrderedDictionaryTest category: 'BaseImageTests-Collections'! -TestCase subclass: #OrderedDictionaryTest +!classDefinition: #IfNotNilTests category: 'BaseImageTests-Kernel-Objects'! +TestCase subclass: #IfNotNilTests instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Collections'! -!classDefinition: 'OrderedDictionaryTest class' category: 'BaseImageTests-Collections'! -OrderedDictionaryTest class + category: 'BaseImageTests-Kernel-Objects'! +!classDefinition: 'IfNotNilTests class' category: 'BaseImageTests-Kernel-Objects'! +IfNotNilTests class instanceVariableNames: ''! -!classDefinition: #SequenceableCollectionTest category: 'BaseImageTests-Collections'! -TestCase subclass: #SequenceableCollectionTest +!classDefinition: #ObjectTest category: 'BaseImageTests-Kernel-Objects'! +TestCase subclass: #ObjectTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Collections'! -!classDefinition: 'SequenceableCollectionTest class' category: 'BaseImageTests-Collections'! -SequenceableCollectionTest class + category: 'BaseImageTests-Kernel-Objects'! +!classDefinition: 'ObjectTest class' category: 'BaseImageTests-Kernel-Objects'! +ObjectTest class instanceVariableNames: ''! -!classDefinition: #TextTest category: 'BaseImageTests-Collections'! -TestCase subclass: #TextTest +!classDefinition: #SpecialSelectorsTest category: 'BaseImageTests-Kernel-Objects'! +TestCase subclass: #SpecialSelectorsTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Collections'! -!classDefinition: 'TextTest class' category: 'BaseImageTests-Collections'! -TextTest class + category: 'BaseImageTests-Kernel-Objects'! +!classDefinition: 'SpecialSelectorsTest class' category: 'BaseImageTests-Kernel-Objects'! +SpecialSelectorsTest class instanceVariableNames: ''! -!classDefinition: #WeakIdentitySetTest category: 'BaseImageTests-Collections'! -TestCase subclass: #WeakIdentitySetTest +!classDefinition: #WeakMessageSendTest category: 'BaseImageTests-Kernel-Objects'! +TestCase subclass: #WeakMessageSendTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Collections'! -!classDefinition: 'WeakIdentitySetTest class' category: 'BaseImageTests-Collections'! -WeakIdentitySetTest class + category: 'BaseImageTests-Kernel-Objects'! +!classDefinition: 'WeakMessageSendTest class' category: 'BaseImageTests-Kernel-Objects'! +WeakMessageSendTest class instanceVariableNames: ''! !classDefinition: #BehaviorTest category: 'BaseImageTests-Kernel-Classes'! @@ -346,6 +306,76 @@ RandomTest subclass: #ParkMiller93RandomTest ParkMiller93RandomTest class instanceVariableNames: ''! +!classDefinition: #CharacterSetTest category: 'BaseImageTests-Kernel-Text'! +TestCase subclass: #CharacterSetTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Kernel-Text'! +!classDefinition: 'CharacterSetTest class' category: 'BaseImageTests-Kernel-Text'! +CharacterSetTest class + instanceVariableNames: ''! + +!classDefinition: #CharacterTest category: 'BaseImageTests-Kernel-Text'! +TestCase subclass: #CharacterTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Kernel-Text'! +!classDefinition: 'CharacterTest class' category: 'BaseImageTests-Kernel-Text'! +CharacterTest class + instanceVariableNames: ''! + +!classDefinition: #StringTest category: 'BaseImageTests-Kernel-Text'! +TestCase subclass: #StringTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Kernel-Text'! +!classDefinition: 'StringTest class' category: 'BaseImageTests-Kernel-Text'! +StringTest class + instanceVariableNames: ''! + +!classDefinition: #SymbolTest category: 'BaseImageTests-Kernel-Text'! +TestCase subclass: #SymbolTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Kernel-Text'! +!classDefinition: 'SymbolTest class' category: 'BaseImageTests-Kernel-Text'! +SymbolTest class + instanceVariableNames: ''! + +!classDefinition: #UnicodeStringsTest category: 'BaseImageTests-Kernel-Text'! +TestCase subclass: #UnicodeStringsTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Kernel-Text'! +!classDefinition: 'UnicodeStringsTest class' category: 'BaseImageTests-Kernel-Text'! +UnicodeStringsTest class + instanceVariableNames: ''! + +!classDefinition: #UnicodeSymbolsTest category: 'BaseImageTests-Kernel-Text'! +TestCase subclass: #UnicodeSymbolsTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Kernel-Text'! +!classDefinition: 'UnicodeSymbolsTest class' category: 'BaseImageTests-Kernel-Text'! +UnicodeSymbolsTest class + instanceVariableNames: ''! + +!classDefinition: #UnicodeTest category: 'BaseImageTests-Kernel-Text'! +TestCase subclass: #UnicodeTest + instanceVariableNames: 'bytesOfExample1' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Kernel-Text'! +!classDefinition: 'UnicodeTest class' category: 'BaseImageTests-Kernel-Text'! +UnicodeTest class + instanceVariableNames: ''! + !classDefinition: #DateAndTimeTest category: 'BaseImageTests-Kernel-Chronology'! TestCase subclass: #DateAndTimeTest instanceVariableNames: '' @@ -506,88 +536,218 @@ TestCase subclass: #SemaphoreTest SemaphoreTest class instanceVariableNames: ''! -!classDefinition: #ArrayTest category: 'BaseImageTests-Collections-Arrayed'! -TestCase subclass: #ArrayTest +!classDefinition: #BinarySearchTest category: 'BaseImageTests-Collections'! +TestCase subclass: #BinarySearchTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Collections-Arrayed'! -!classDefinition: 'ArrayTest class' category: 'BaseImageTests-Collections-Arrayed'! -ArrayTest class + category: 'BaseImageTests-Collections'! +!classDefinition: 'BinarySearchTest class' category: 'BaseImageTests-Collections'! +BinarySearchTest class instanceVariableNames: ''! -!classDefinition: #Float32ArrayTest category: 'BaseImageTests-Collections-Arrayed'! -TestCase subclass: #Float32ArrayTest +!classDefinition: #CollectTest category: 'BaseImageTests-Collections'! +TestCase subclass: #CollectTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Collections-Arrayed'! -!classDefinition: 'Float32ArrayTest class' category: 'BaseImageTests-Collections-Arrayed'! -Float32ArrayTest class + category: 'BaseImageTests-Collections'! +!classDefinition: 'CollectTest class' category: 'BaseImageTests-Collections'! +CollectTest class instanceVariableNames: ''! -!classDefinition: #Float64ArrayTest category: 'BaseImageTests-Collections-Arrayed'! -TestCase subclass: #Float64ArrayTest +!classDefinition: #CollectionTest category: 'BaseImageTests-Collections'! +TestCase subclass: #CollectionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Collections-Arrayed'! -!classDefinition: 'Float64ArrayTest class' category: 'BaseImageTests-Collections-Arrayed'! -Float64ArrayTest class + category: 'BaseImageTests-Collections'! +!classDefinition: 'CollectionTest class' category: 'BaseImageTests-Collections'! +CollectionTest class instanceVariableNames: ''! -!classDefinition: #ExceptionHandlingConditionTest category: 'BaseImageTests-Exceptions'! -TestCase subclass: #ExceptionHandlingConditionTest +!classDefinition: #DictionaryTest category: 'BaseImageTests-Collections'! +TestCase subclass: #DictionaryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Exceptions'! -!classDefinition: 'ExceptionHandlingConditionTest class' category: 'BaseImageTests-Exceptions'! -ExceptionHandlingConditionTest class + category: 'BaseImageTests-Collections'! +!classDefinition: 'DictionaryTest class' category: 'BaseImageTests-Collections'! +DictionaryTest class instanceVariableNames: ''! -!classDefinition: #ExceptionTests category: 'BaseImageTests-Exceptions'! -TestCase subclass: #ExceptionTests +!classDefinition: #IntervalTest category: 'BaseImageTests-Collections'! +TestCase subclass: #IntervalTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Exceptions'! -!classDefinition: 'ExceptionTests class' category: 'BaseImageTests-Exceptions'! -ExceptionTests class + category: 'BaseImageTests-Collections'! +!classDefinition: 'IntervalTest class' category: 'BaseImageTests-Collections'! +IntervalTest class instanceVariableNames: ''! -!classDefinition: #ProgressInitiationExceptionTest category: 'BaseImageTests-Exceptions'! -TestCase subclass: #ProgressInitiationExceptionTest +!classDefinition: #OrderedCollectionTest category: 'BaseImageTests-Collections'! +TestCase subclass: #OrderedCollectionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Exceptions'! -!classDefinition: 'ProgressInitiationExceptionTest class' category: 'BaseImageTests-Exceptions'! -ProgressInitiationExceptionTest class + category: 'BaseImageTests-Collections'! +!classDefinition: 'OrderedCollectionTest class' category: 'BaseImageTests-Collections'! +OrderedCollectionTest class instanceVariableNames: ''! -!classDefinition: #ArrayLiteralTest category: 'BaseImageTests-Compiler'! -TestCase subclass: #ArrayLiteralTest +!classDefinition: #OrderedDictionaryTest category: 'BaseImageTests-Collections'! +TestCase subclass: #OrderedDictionaryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Compiler'! -!classDefinition: 'ArrayLiteralTest class' category: 'BaseImageTests-Compiler'! -ArrayLiteralTest class + category: 'BaseImageTests-Collections'! +!classDefinition: 'OrderedDictionaryTest class' category: 'BaseImageTests-Collections'! +OrderedDictionaryTest class instanceVariableNames: ''! -!classDefinition: #ClassDefinitionNodeAnalyzerTest category: 'BaseImageTests-Compiler'! -TestCase subclass: #ClassDefinitionNodeAnalyzerTest - instanceVariableNames: 'iv1' +!classDefinition: #SequenceableCollectionTest category: 'BaseImageTests-Collections'! +TestCase subclass: #SequenceableCollectionTest + instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Compiler'! -!classDefinition: 'ClassDefinitionNodeAnalyzerTest class' category: 'BaseImageTests-Compiler'! -ClassDefinitionNodeAnalyzerTest class + category: 'BaseImageTests-Collections'! +!classDefinition: 'SequenceableCollectionTest class' category: 'BaseImageTests-Collections'! +SequenceableCollectionTest class instanceVariableNames: ''! -!classDefinition: #ClosureCompilerTest category: 'BaseImageTests-Compiler'! -TestCase subclass: #ClosureCompilerTest +!classDefinition: #TextTest category: 'BaseImageTests-Collections'! +TestCase subclass: #TextTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Collections'! +!classDefinition: 'TextTest class' category: 'BaseImageTests-Collections'! +TextTest class + instanceVariableNames: ''! + +!classDefinition: #WeakIdentitySetTest category: 'BaseImageTests-Collections'! +TestCase subclass: #WeakIdentitySetTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Collections'! +!classDefinition: 'WeakIdentitySetTest class' category: 'BaseImageTests-Collections'! +WeakIdentitySetTest class + instanceVariableNames: ''! + +!classDefinition: #ArrayTest category: 'BaseImageTests-Collections-Arrayed'! +TestCase subclass: #ArrayTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Collections-Arrayed'! +!classDefinition: 'ArrayTest class' category: 'BaseImageTests-Collections-Arrayed'! +ArrayTest class + instanceVariableNames: ''! + +!classDefinition: #Float32ArrayTest category: 'BaseImageTests-Collections-Arrayed'! +TestCase subclass: #Float32ArrayTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Collections-Arrayed'! +!classDefinition: 'Float32ArrayTest class' category: 'BaseImageTests-Collections-Arrayed'! +Float32ArrayTest class + instanceVariableNames: ''! + +!classDefinition: #Float64ArrayTest category: 'BaseImageTests-Collections-Arrayed'! +TestCase subclass: #Float64ArrayTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Collections-Arrayed'! +!classDefinition: 'Float64ArrayTest class' category: 'BaseImageTests-Collections-Arrayed'! +Float64ArrayTest class + instanceVariableNames: ''! + +!classDefinition: #ReadStreamTest category: 'BaseImageTests-Collections-Streams'! +TestCase subclass: #ReadStreamTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Collections-Streams'! +!classDefinition: 'ReadStreamTest class' category: 'BaseImageTests-Collections-Streams'! +ReadStreamTest class + instanceVariableNames: ''! + +!classDefinition: #ReadWriteStreamTest category: 'BaseImageTests-Collections-Streams'! +TestCase subclass: #ReadWriteStreamTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Collections-Streams'! +!classDefinition: 'ReadWriteStreamTest class' category: 'BaseImageTests-Collections-Streams'! +ReadWriteStreamTest class + instanceVariableNames: ''! + +!classDefinition: #WriteStreamTest category: 'BaseImageTests-Collections-Streams'! +TestCase subclass: #WriteStreamTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Collections-Streams'! +!classDefinition: 'WriteStreamTest class' category: 'BaseImageTests-Collections-Streams'! +WriteStreamTest class + instanceVariableNames: ''! + +!classDefinition: #ExceptionHandlingConditionTest category: 'BaseImageTests-Exceptions'! +TestCase subclass: #ExceptionHandlingConditionTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Exceptions'! +!classDefinition: 'ExceptionHandlingConditionTest class' category: 'BaseImageTests-Exceptions'! +ExceptionHandlingConditionTest class + instanceVariableNames: ''! + +!classDefinition: #ExceptionTests category: 'BaseImageTests-Exceptions'! +TestCase subclass: #ExceptionTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Exceptions'! +!classDefinition: 'ExceptionTests class' category: 'BaseImageTests-Exceptions'! +ExceptionTests class + instanceVariableNames: ''! + +!classDefinition: #ProgressInitiationExceptionTest category: 'BaseImageTests-Exceptions'! +TestCase subclass: #ProgressInitiationExceptionTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Exceptions'! +!classDefinition: 'ProgressInitiationExceptionTest class' category: 'BaseImageTests-Exceptions'! +ProgressInitiationExceptionTest class + instanceVariableNames: ''! + +!classDefinition: #ArrayLiteralTest category: 'BaseImageTests-Compiler'! +TestCase subclass: #ArrayLiteralTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Compiler'! +!classDefinition: 'ArrayLiteralTest class' category: 'BaseImageTests-Compiler'! +ArrayLiteralTest class + instanceVariableNames: ''! + +!classDefinition: #ClassDefinitionNodeAnalyzerTest category: 'BaseImageTests-Compiler'! +TestCase subclass: #ClassDefinitionNodeAnalyzerTest + instanceVariableNames: 'iv1' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Compiler'! +!classDefinition: 'ClassDefinitionNodeAnalyzerTest class' category: 'BaseImageTests-Compiler'! +ClassDefinitionNodeAnalyzerTest class + instanceVariableNames: ''! + +!classDefinition: #ClosureCompilerTest category: 'BaseImageTests-Compiler'! +TestCase subclass: #ClosureCompilerTest instanceVariableNames: '' classVariableNames: 'CmpRR CogRTLOpcodes Jump MoveCqR Nop' poolDictionaries: '' @@ -716,6 +876,56 @@ TestCase subclass: #SourceCodeIntervalTest SourceCodeIntervalTest class instanceVariableNames: ''! +!classDefinition: #SystemConsistencyTest category: 'BaseImageTests-System-Support'! +TestCase subclass: #SystemConsistencyTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-System-Support'! +!classDefinition: 'SystemConsistencyTest class' category: 'BaseImageTests-System-Support'! +SystemConsistencyTest class + instanceVariableNames: ''! + +!classDefinition: #SystemDictionaryTest category: 'BaseImageTests-System-Support'! +TestCase subclass: #SystemDictionaryTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-System-Support'! +!classDefinition: 'SystemDictionaryTest class' category: 'BaseImageTests-System-Support'! +SystemDictionaryTest class + instanceVariableNames: ''! + +!classDefinition: #TranscriptTest category: 'BaseImageTests-System-Support'! +TestCase subclass: #TranscriptTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-System-Support'! +!classDefinition: 'TranscriptTest class' category: 'BaseImageTests-System-Support'! +TranscriptTest class + instanceVariableNames: ''! + +!classDefinition: #TrieTest category: 'BaseImageTests-System-Text'! +TestCase subclass: #TrieTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-System-Text'! +!classDefinition: 'TrieTest class' category: 'BaseImageTests-System-Text'! +TrieTest class + instanceVariableNames: ''! + +!classDefinition: #TrieUnicodeTest category: 'BaseImageTests-System-Text'! +TestCase subclass: #TrieUnicodeTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-System-Text'! +!classDefinition: 'TrieUnicodeTest class' category: 'BaseImageTests-System-Text'! +TrieUnicodeTest class + instanceVariableNames: ''! + !classDefinition: #FileIOAccessorTest category: 'BaseImageTests-System-FileMan'! TestCase subclass: #FileIOAccessorTest instanceVariableNames: '' @@ -786,6 +996,56 @@ TestCase subclass: #BitBltTest BitBltTest class instanceVariableNames: ''! +!classDefinition: #RectangleTest category: 'BaseImageTests-Graphics-Primitives'! +TestCase subclass: #RectangleTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Graphics-Primitives'! +!classDefinition: 'RectangleTest class' category: 'BaseImageTests-Graphics-Primitives'! +RectangleTest class + instanceVariableNames: ''! + +!classDefinition: #ColorFormTest category: 'BaseImageTests-Graphics-Display Objects'! +TestCase subclass: #ColorFormTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Graphics-Display Objects'! +!classDefinition: 'ColorFormTest class' category: 'BaseImageTests-Graphics-Display Objects'! +ColorFormTest class + instanceVariableNames: ''! + +!classDefinition: #GrayFormTest category: 'BaseImageTests-Graphics-Display Objects'! +TestCase subclass: #GrayFormTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Graphics-Display Objects'! +!classDefinition: 'GrayFormTest class' category: 'BaseImageTests-Graphics-Display Objects'! +GrayFormTest class + instanceVariableNames: ''! + +!classDefinition: #StrikeFontTest category: 'BaseImageTests-Graphics-Text'! +TestCase subclass: #StrikeFontTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Graphics-Text'! +!classDefinition: 'StrikeFontTest class' category: 'BaseImageTests-Graphics-Text'! +StrikeFontTest class + instanceVariableNames: ''! + +!classDefinition: #JpegTest category: 'BaseImageTests-Graphics-Files'! +TestCase subclass: #JpegTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Graphics-Files'! +!classDefinition: 'JpegTest class' category: 'BaseImageTests-Graphics-Files'! +JpegTest class + instanceVariableNames: ''! + !classDefinition: #AffineTransformationTest category: 'BaseImageTests-Morphic-Kernel'! TestCase subclass: #AffineTransformationTest instanceVariableNames: '' @@ -836,32 +1096,62 @@ TestCase subclass: #WorldTest WorldTest class instanceVariableNames: ''! -!classDefinition: #SmalltalkCompleterTest category: 'BaseImageTests-Tools-Autocompletion'! -TestCase subclass: #SmalltalkCompleterTest - instanceVariableNames: 'instanceVariable1 classToBrowse selectorToBrowse' - classVariableNames: 'ClassVariableForTesting' - poolDictionaries: 'poolDictionaryForTesting' - category: 'BaseImageTests-Tools-Autocompletion'! -!classDefinition: 'SmalltalkCompleterTest class' category: 'BaseImageTests-Tools-Autocompletion'! -SmalltalkCompleterTest class - instanceVariableNames: ''! - -!classDefinition: #DynamicTypingSmalltalkCompleterTest category: 'BaseImageTests-Tools-Autocompletion'! -SmalltalkCompleterTest subclass: #DynamicTypingSmalltalkCompleterTest +!classDefinition: #MethodReferenceTest category: 'BaseImageTests-Tools-Browser'! +TestCase subclass: #MethodReferenceTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Tools-Autocompletion'! -!classDefinition: 'DynamicTypingSmalltalkCompleterTest class' category: 'BaseImageTests-Tools-Autocompletion'! -DynamicTypingSmalltalkCompleterTest class + category: 'BaseImageTests-Tools-Browser'! +!classDefinition: 'MethodReferenceTest class' category: 'BaseImageTests-Tools-Browser'! +MethodReferenceTest class instanceVariableNames: ''! -!classDefinition: #TaskbarTest category: 'BaseImageTests-Tools-Taskbar'! -TestCase subclass: #TaskbarTest - instanceVariableNames: 'taskbar needsDelete' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Tools-Taskbar'! +!classDefinition: #SHST80RangeTypeTest category: 'BaseImageTests-Tools-Syntax Highlighting'! +TestCase subclass: #SHST80RangeTypeTest + instanceVariableNames: '' + classVariableNames: 'ClassVar1' + poolDictionaries: '' + category: 'BaseImageTests-Tools-Syntax Highlighting'! +!classDefinition: 'SHST80RangeTypeTest class' category: 'BaseImageTests-Tools-Syntax Highlighting'! +SHST80RangeTypeTest class + instanceVariableNames: ''! + +!classDefinition: #DebuggerTest category: 'BaseImageTests-Tools-Debugger'! +TestCase subclass: #DebuggerTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Tools-Debugger'! +!classDefinition: 'DebuggerTest class' category: 'BaseImageTests-Tools-Debugger'! +DebuggerTest class + instanceVariableNames: ''! + +!classDefinition: #SmalltalkCompleterTest category: 'BaseImageTests-Tools-Autocompletion'! +TestCase subclass: #SmalltalkCompleterTest + instanceVariableNames: 'instanceVariable1 classToBrowse selectorToBrowse' + classVariableNames: 'ClassVariableForTesting' + poolDictionaries: 'poolDictionaryForTesting' + category: 'BaseImageTests-Tools-Autocompletion'! +!classDefinition: 'SmalltalkCompleterTest class' category: 'BaseImageTests-Tools-Autocompletion'! +SmalltalkCompleterTest class + instanceVariableNames: ''! + +!classDefinition: #DynamicTypingSmalltalkCompleterTest category: 'BaseImageTests-Tools-Autocompletion'! +SmalltalkCompleterTest subclass: #DynamicTypingSmalltalkCompleterTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Tools-Autocompletion'! +!classDefinition: 'DynamicTypingSmalltalkCompleterTest class' category: 'BaseImageTests-Tools-Autocompletion'! +DynamicTypingSmalltalkCompleterTest class + instanceVariableNames: ''! + +!classDefinition: #TaskbarTest category: 'BaseImageTests-Tools-Taskbar'! +TestCase subclass: #TaskbarTest + instanceVariableNames: 'taskbar needsDelete' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Tools-Taskbar'! !classDefinition: 'TaskbarTest class' category: 'BaseImageTests-Tools-Taskbar'! TaskbarTest class instanceVariableNames: ''! @@ -896,16 +1186,6 @@ TestCase subclass: #DifferenceFinderTest DifferenceFinderTest class instanceVariableNames: ''! -!classDefinition: #TestValueWithinFix category: 'BaseImageTests-Fixed Bugs'! -TestCase subclass: #TestValueWithinFix - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Fixed Bugs'! -!classDefinition: 'TestValueWithinFix class' category: 'BaseImageTests-Fixed Bugs'! -TestValueWithinFix class - instanceVariableNames: ''! - !classDefinition: #DynamicallyCodeCreationTest category: 'BaseImageTests-Tools-Refactoring'! TestCase subclass: #DynamicallyCodeCreationTest instanceVariableNames: 'classCategories setUpAssertionsPassed' @@ -926,6 +1206,16 @@ DynamicallyCodeCreationTest subclass: #CompilerTest CompilerTest class instanceVariableNames: ''! +!classDefinition: #ChangesTest category: 'BaseImageTests-Tools-Changes'! +DynamicallyCodeCreationTest subclass: #ChangesTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Tools-Changes'! +!classDefinition: 'ChangesTest class' category: 'BaseImageTests-Tools-Changes'! +ChangesTest class + instanceVariableNames: ''! + !classDefinition: #ExtractMethodFinderTest category: 'BaseImageTests-Tools-Refactoring'! DynamicallyCodeCreationTest subclass: #ExtractMethodFinderTest instanceVariableNames: 'classToRefactor' @@ -1006,6 +1296,26 @@ RefactoringTest subclass: #ExtractToTemporaryTest ExtractToTemporaryTest class instanceVariableNames: ''! +!classDefinition: #InlineMethodTest category: 'BaseImageTests-Tools-Refactoring'! +RefactoringTest subclass: #InlineMethodTest + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Tools-Refactoring'! +!classDefinition: 'InlineMethodTest class' category: 'BaseImageTests-Tools-Refactoring'! +InlineMethodTest class + instanceVariableNames: ''! + +!classDefinition: #InlineTemporaryVariableTest category: 'BaseImageTests-Tools-Refactoring'! +RefactoringTest subclass: #InlineTemporaryVariableTest + instanceVariableNames: 'newVariable' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Tools-Refactoring'! +!classDefinition: 'InlineTemporaryVariableTest class' category: 'BaseImageTests-Tools-Refactoring'! +InlineTemporaryVariableTest class + instanceVariableNames: ''! + !classDefinition: #InsertSuperclassTest category: 'BaseImageTests-Tools-Refactoring'! RefactoringTest subclass: #InsertSuperclassTest instanceVariableNames: '' @@ -1166,351 +1476,77 @@ RefactoringTest subclass: #TemporaryToInstanceVariableTest TemporaryToInstanceVariableTest class instanceVariableNames: ''! -!classDefinition: #ChangesTest category: 'BaseImageTests-Tools-Changes'! -DynamicallyCodeCreationTest subclass: #ChangesTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Tools-Changes'! -!classDefinition: 'ChangesTest class' category: 'BaseImageTests-Tools-Changes'! -ChangesTest class - instanceVariableNames: ''! - -!classDefinition: #ReadStreamTest category: 'BaseImageTests-Collections-Streams'! -TestCase subclass: #ReadStreamTest +!classDefinition: #TestValueWithinFix category: 'BaseImageTests-Fixed Bugs'! +TestCase subclass: #TestValueWithinFix instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Collections-Streams'! -!classDefinition: 'ReadStreamTest class' category: 'BaseImageTests-Collections-Streams'! -ReadStreamTest class + category: 'BaseImageTests-Fixed Bugs'! +!classDefinition: 'TestValueWithinFix class' category: 'BaseImageTests-Fixed Bugs'! +TestValueWithinFix class instanceVariableNames: ''! -!classDefinition: #ReadWriteStreamTest category: 'BaseImageTests-Collections-Streams'! -TestCase subclass: #ReadWriteStreamTest - instanceVariableNames: '' +!classDefinition: #BecomeTestExperiment category: 'BaseImageTests-Kernel-Objects'! +Object subclass: #BecomeTestExperiment + instanceVariableNames: 'a b' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Collections-Streams'! -!classDefinition: 'ReadWriteStreamTest class' category: 'BaseImageTests-Collections-Streams'! -ReadWriteStreamTest class + category: 'BaseImageTests-Kernel-Objects'! +!classDefinition: 'BecomeTestExperiment class' category: 'BaseImageTests-Kernel-Objects'! +BecomeTestExperiment class instanceVariableNames: ''! -!classDefinition: #WriteStreamTest category: 'BaseImageTests-Collections-Streams'! -TestCase subclass: #WriteStreamTest - instanceVariableNames: '' +!classDefinition: #ExceptionTester category: 'BaseImageTests-Exceptions'! +Object subclass: #ExceptionTester + instanceVariableNames: 'log suiteLog iterationsBeforeTimeout' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-Collections-Streams'! -!classDefinition: 'WriteStreamTest class' category: 'BaseImageTests-Collections-Streams'! -WriteStreamTest class + category: 'BaseImageTests-Exceptions'! +!classDefinition: 'ExceptionTester class' category: 'BaseImageTests-Exceptions'! +ExceptionTester class instanceVariableNames: ''! -!classDefinition: #SystemConsistencyTest category: 'BaseImageTests-System-Support'! -TestCase subclass: #SystemConsistencyTest +!classDefinition: #RefactoringClassTestData category: 'BaseImageTests-Tools-Refactoring'! +Object subclass: #RefactoringClassTestData instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' - category: 'BaseImageTests-System-Support'! -!classDefinition: 'SystemConsistencyTest class' category: 'BaseImageTests-System-Support'! -SystemConsistencyTest class + category: 'BaseImageTests-Tools-Refactoring'! +!classDefinition: 'RefactoringClassTestData class' category: 'BaseImageTests-Tools-Refactoring'! +RefactoringClassTestData class instanceVariableNames: ''! -!classDefinition: #SystemDictionaryTest category: 'BaseImageTests-System-Support'! -TestCase subclass: #SystemDictionaryTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-System-Support'! -!classDefinition: 'SystemDictionaryTest class' category: 'BaseImageTests-System-Support'! -SystemDictionaryTest class - instanceVariableNames: ''! -!classDefinition: #TranscriptTest category: 'BaseImageTests-System-Support'! -TestCase subclass: #TranscriptTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-System-Support'! -!classDefinition: 'TranscriptTest class' category: 'BaseImageTests-System-Support'! -TranscriptTest class - instanceVariableNames: ''! +!BecomeTest commentStamp: '' prior: 0! +Tests that common uses of #become: and related methods don't crash the system when some method could resume execution on a 'becomed' instance.! -!classDefinition: #RectangleTest category: 'BaseImageTests-Graphics-Primitives'! -TestCase subclass: #RectangleTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Graphics-Primitives'! -!classDefinition: 'RectangleTest class' category: 'BaseImageTests-Graphics-Primitives'! -RectangleTest class - instanceVariableNames: ''! +!SpecialSelectorsTest commentStamp: '' prior: 0! +Tests for proper behavior of Special Selectors, for example #@! -!classDefinition: #ColorFormTest category: 'BaseImageTests-Graphics-Display Objects'! -TestCase subclass: #ColorFormTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Graphics-Display Objects'! -!classDefinition: 'ColorFormTest class' category: 'BaseImageTests-Graphics-Display Objects'! -ColorFormTest class - instanceVariableNames: ''! +!FloatTest commentStamp: 'fbs 3/8/2004 22:13' prior: 0! +I provide a test suite for Float values. Examine my tests to see how Floats should behave, and see how to use them.! -!classDefinition: #GrayFormTest category: 'BaseImageTests-Graphics-Display Objects'! -TestCase subclass: #GrayFormTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Graphics-Display Objects'! -!classDefinition: 'GrayFormTest class' category: 'BaseImageTests-Graphics-Display Objects'! -GrayFormTest class - instanceVariableNames: ''! +!SmallIntegerTest commentStamp: 'fbs 3/8/2004 22:13' prior: 0! +I provide a test suite for SmallInteger values. Examine my tests to see how SmallIntegers should behave, and see how to use them.! -!classDefinition: #BecomeTest category: 'BaseImageTests-Kernel-Objects'! -TestCase subclass: #BecomeTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Objects'! -!classDefinition: 'BecomeTest class' category: 'BaseImageTests-Kernel-Objects'! -BecomeTest class - instanceVariableNames: ''! +!ProcessTest commentStamp: 'ul 8/16/2011 11:35' prior: 0! +I hold test cases for generic Process-related behaviour.! -!classDefinition: #BooleanTest category: 'BaseImageTests-Kernel-Objects'! -TestCase subclass: #BooleanTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Objects'! -!classDefinition: 'BooleanTest class' category: 'BaseImageTests-Kernel-Objects'! -BooleanTest class - instanceVariableNames: ''! +!SemaphoreTest commentStamp: 'tlk 5/5/2006 13:32' prior: 0! +A SemaphoreTest is sunit test for simple and multiEx semaphores -!classDefinition: #IfNotNilTests category: 'BaseImageTests-Kernel-Objects'! -TestCase subclass: #IfNotNilTests - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Objects'! -!classDefinition: 'IfNotNilTests class' category: 'BaseImageTests-Kernel-Objects'! -IfNotNilTests class - instanceVariableNames: ''! +Instance Variables none; does not have common test fixture accross all tests (because its testing differenct sorts of semaphores (could refactor into muliple testcases if there were more test conditions. +! -!classDefinition: #ObjectTest category: 'BaseImageTests-Kernel-Objects'! -TestCase subclass: #ObjectTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Objects'! -!classDefinition: 'ObjectTest class' category: 'BaseImageTests-Kernel-Objects'! -ObjectTest class - instanceVariableNames: ''! +!WriteStreamTest commentStamp: '' prior: 0! +Tests cases for Stream messages: -!classDefinition: #SpecialSelectorsTest category: 'BaseImageTests-Kernel-Objects'! -TestCase subclass: #SpecialSelectorsTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Objects'! -!classDefinition: 'SpecialSelectorsTest class' category: 'BaseImageTests-Kernel-Objects'! -SpecialSelectorsTest class - instanceVariableNames: ''! +nextPutAll: when: +nextPut: when: +print: when:. -!classDefinition: #WeakMessageSendTest category: 'BaseImageTests-Kernel-Objects'! -TestCase subclass: #WeakMessageSendTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Objects'! -!classDefinition: 'WeakMessageSendTest class' category: 'BaseImageTests-Kernel-Objects'! -WeakMessageSendTest class - instanceVariableNames: ''! - -!classDefinition: #MethodReferenceTest category: 'BaseImageTests-Tools-Browser'! -TestCase subclass: #MethodReferenceTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Tools-Browser'! -!classDefinition: 'MethodReferenceTest class' category: 'BaseImageTests-Tools-Browser'! -MethodReferenceTest class - instanceVariableNames: ''! - -!classDefinition: #CharacterSetTest category: 'BaseImageTests-Kernel-Text'! -TestCase subclass: #CharacterSetTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Text'! -!classDefinition: 'CharacterSetTest class' category: 'BaseImageTests-Kernel-Text'! -CharacterSetTest class - instanceVariableNames: ''! - -!classDefinition: #CharacterTest category: 'BaseImageTests-Kernel-Text'! -TestCase subclass: #CharacterTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Text'! -!classDefinition: 'CharacterTest class' category: 'BaseImageTests-Kernel-Text'! -CharacterTest class - instanceVariableNames: ''! - -!classDefinition: #StringTest category: 'BaseImageTests-Kernel-Text'! -TestCase subclass: #StringTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Text'! -!classDefinition: 'StringTest class' category: 'BaseImageTests-Kernel-Text'! -StringTest class - instanceVariableNames: ''! - -!classDefinition: #SymbolTest category: 'BaseImageTests-Kernel-Text'! -TestCase subclass: #SymbolTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Text'! -!classDefinition: 'SymbolTest class' category: 'BaseImageTests-Kernel-Text'! -SymbolTest class - instanceVariableNames: ''! - -!classDefinition: #UnicodeStringsTest category: 'BaseImageTests-Kernel-Text'! -TestCase subclass: #UnicodeStringsTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Text'! -!classDefinition: 'UnicodeStringsTest class' category: 'BaseImageTests-Kernel-Text'! -UnicodeStringsTest class - instanceVariableNames: ''! - -!classDefinition: #UnicodeSymbolsTest category: 'BaseImageTests-Kernel-Text'! -TestCase subclass: #UnicodeSymbolsTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Text'! -!classDefinition: 'UnicodeSymbolsTest class' category: 'BaseImageTests-Kernel-Text'! -UnicodeSymbolsTest class - instanceVariableNames: ''! - -!classDefinition: #UnicodeTest category: 'BaseImageTests-Kernel-Text'! -TestCase subclass: #UnicodeTest - instanceVariableNames: 'bytesOfExample1' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Text'! -!classDefinition: 'UnicodeTest class' category: 'BaseImageTests-Kernel-Text'! -UnicodeTest class - instanceVariableNames: ''! - -!classDefinition: #SHST80RangeTypeTest category: 'BaseImageTests-Tools-Syntax Highlighting'! -TestCase subclass: #SHST80RangeTypeTest - instanceVariableNames: '' - classVariableNames: 'ClassVar1' - poolDictionaries: '' - category: 'BaseImageTests-Tools-Syntax Highlighting'! -!classDefinition: 'SHST80RangeTypeTest class' category: 'BaseImageTests-Tools-Syntax Highlighting'! -SHST80RangeTypeTest class - instanceVariableNames: ''! - -!classDefinition: #DebuggerTest category: 'BaseImageTests-Tools-Debugger'! -TestCase subclass: #DebuggerTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Tools-Debugger'! -!classDefinition: 'DebuggerTest class' category: 'BaseImageTests-Tools-Debugger'! -DebuggerTest class - instanceVariableNames: ''! - -!classDefinition: #StrikeFontTest category: 'BaseImageTests-Graphics-Text'! -TestCase subclass: #StrikeFontTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Graphics-Text'! -!classDefinition: 'StrikeFontTest class' category: 'BaseImageTests-Graphics-Text'! -StrikeFontTest class - instanceVariableNames: ''! - -!classDefinition: #JpegTest category: 'BaseImageTests-Graphics-Files'! -TestCase subclass: #JpegTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Graphics-Files'! -!classDefinition: 'JpegTest class' category: 'BaseImageTests-Graphics-Files'! -JpegTest class - instanceVariableNames: ''! - -!classDefinition: #TrieTest category: 'BaseImageTests-System-Text'! -TestCase subclass: #TrieTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-System-Text'! -!classDefinition: 'TrieTest class' category: 'BaseImageTests-System-Text'! -TrieTest class - instanceVariableNames: ''! - -!classDefinition: #TrieUnicodeTest category: 'BaseImageTests-System-Text'! -TestCase subclass: #TrieUnicodeTest - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-System-Text'! -!classDefinition: 'TrieUnicodeTest class' category: 'BaseImageTests-System-Text'! -TrieUnicodeTest class - instanceVariableNames: ''! - -!classDefinition: #ExceptionTester category: 'BaseImageTests-Exceptions'! -Object subclass: #ExceptionTester - instanceVariableNames: 'log suiteLog iterationsBeforeTimeout' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Exceptions'! -!classDefinition: 'ExceptionTester class' category: 'BaseImageTests-Exceptions'! -ExceptionTester class - instanceVariableNames: ''! - -!classDefinition: #RefactoringClassTestData category: 'BaseImageTests-Tools-Refactoring'! -Object subclass: #RefactoringClassTestData - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Tools-Refactoring'! -!classDefinition: 'RefactoringClassTestData class' category: 'BaseImageTests-Tools-Refactoring'! -RefactoringClassTestData class - instanceVariableNames: ''! - -!classDefinition: #BecomeTestExperiment category: 'BaseImageTests-Kernel-Objects'! -Object subclass: #BecomeTestExperiment - instanceVariableNames: 'a b' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel-Objects'! -!classDefinition: 'BecomeTestExperiment class' category: 'BaseImageTests-Kernel-Objects'! -BecomeTestExperiment class - instanceVariableNames: ''! - - -!FloatTest commentStamp: 'fbs 3/8/2004 22:13' prior: 0! -I provide a test suite for Float values. Examine my tests to see how Floats should behave, and see how to use them.! - -!SmallIntegerTest commentStamp: 'fbs 3/8/2004 22:13' prior: 0! -I provide a test suite for SmallInteger values. Examine my tests to see how SmallIntegers should behave, and see how to use them.! - -!ProcessTest commentStamp: 'ul 8/16/2011 11:35' prior: 0! -I hold test cases for generic Process-related behaviour.! - -!SemaphoreTest commentStamp: 'tlk 5/5/2006 13:32' prior: 0! -A SemaphoreTest is sunit test for simple and multiEx semaphores - -Instance Variables none; does not have common test fixture accross all tests (because its testing differenct sorts of semaphores (could refactor into muliple testcases if there were more test conditions. -! +Made at Cuis Sprint #1 +! !DecompilerTests commentStamp: 'sd 9/26/2004 13:24' prior: 0! Apparently the decompiler does not really work totally. @@ -1679,6 +1715,19 @@ WeakSet. #scanFor:. WeakSet. #scanForLoadedSymbol:. }! +!SystemConsistencyTest commentStamp: '' prior: 0! +General system - wide image health tests.! + +!TranscriptTest commentStamp: '' prior: 0! +Tests cases for Stream messages: + +nextPutAll: when: +nextPut: when: +print: when:. + +Made at Cuis Sprint #1 +! + !FileManTest commentStamp: 'jmv 5/31/2016 10:49' prior: 0! FileManTest suite run! @@ -1700,35 +1749,6 @@ Tests for MorphicTranslation! !TaskbarTest commentStamp: '' prior: 0! Tests for the Taskbar.! -!WriteStreamTest commentStamp: '' prior: 0! -Tests cases for Stream messages: - -nextPutAll: when: -nextPut: when: -print: when:. - -Made at Cuis Sprint #1 -! - -!SystemConsistencyTest commentStamp: '' prior: 0! -General system - wide image health tests.! - -!TranscriptTest commentStamp: '' prior: 0! -Tests cases for Stream messages: - -nextPutAll: when: -nextPut: when: -print: when:. - -Made at Cuis Sprint #1 -! - -!BecomeTest commentStamp: '' prior: 0! -Tests that common uses of #become: and related methods don't crash the system when some method could resume execution on a 'becomed' instance.! - -!SpecialSelectorsTest commentStamp: '' prior: 0! -Tests for proper behavior of Special Selectors, for example #@! - !BecomeTestExperiment commentStamp: '' prior: 0! To be used by BecomeTest! @@ -1737,7598 +1757,7827 @@ isResumable ^true! ! -!BinarySearchTest methodsFor: 'testing' stamp: 'sqr 5/25/2016 14:36'! -testquickFindFirst +!BecomeTest methodsFor: 'testing' stamp: 'jmv 1/29/2019 12:03:40'! +testBecome + | e | + BecomeTestExperiment twoVars. + e _ BecomeTestExperiment new. + self should: [ e messStuffUpWBecome ] raise: MethodInCallStackToBecomeInvalid! ! - | collection | - collection := 1000 to: 2100. - collection withIndexDo: - [:eachElement :eachIndex | - self assert: (collection quickFindFirst: [:one | one >= eachElement]) = eachIndex. - self assert: (collection quickFindFirst: [:one | one >= (eachElement - 0.5)]) = eachIndex - ]. - self assert: (collection quickFindFirst: [:one | one > 2101]) = 0! ! +!BecomeTest methodsFor: 'testing' stamp: 'jmv 1/29/2019 12:03:42'! +testShapeMutation + | e | + BecomeTestExperiment twoVars. + e _ BecomeTestExperiment new. + self should: [ e messStuffUp ] raise: MethodInCallStackToBecomeInvalid! ! -!BinarySearchTest methodsFor: 'testing' stamp: 'sqr 5/25/2016 14:36'! -testquickFindLast +!BooleanTest methodsFor: 'and tests' stamp: 'HAW 7/8/2018 20:03:35'! +testAndAndAndAndTrueTable - | collection | - collection := 1000 to: 2100. - collection withIndexDo: - [:eachElement :eachIndex | - self assert: (collection quickFindLast: [:one | one <= eachElement]) = eachIndex. - self assert: (collection quickFindLast: [:one | one <= (eachElement + 0.5)]) = eachIndex - ]. - self assert: (collection quickFindLast: [:one | one < 0]) = 0! ! - -!BinarySearchTest methodsFor: 'testing' stamp: 'sqr 5/25/2016 14:46'! -testquickIndexOf - - | collection | - collection := 1000 to: 2100. - collection withIndexDo: - [:eachElement :eachIndex | - self assert: (collection quickIndexOf: eachElement) = eachIndex - ]. - self assert: (collection quickIndexOf: 999) = 0. - self assert: (collection quickIndexOf: 2101) = 0! ! - -!BinarySearchTest methodsFor: 'testing' stamp: 'sqr 5/25/2016 15:01'! -testquickIndexOfWithSemistableOrder - - | collection | - collection := SortedCollection - sortBlock: [:x :y | x key <= y key]. - 1 to: 1000 do: [:each | collection add: each -> each]. - 1 to: 50 do: [:each | collection add: 42 -> each]. - self assert: (collection quickIndexOf: 42 -> 6) = 48! ! - -!CollectTest methodsFor: 'testing' stamp: 'jmv 11/30/2014 11:34'! -testIdentitySet - " - CollectTest new testIdentitySet - " - | col result | - col _ #(1 2 3 1.0 2.0 3.0) asIdentitySet. - result _ col collect: [ :elem | elem yourself ]. - self assert: result class = IdentitySet. - self assert: result = #(1 2 3 1.0 2.0 3.0) asIdentitySet. - self assert: result = col! ! - -!CollectTest methodsFor: 'testing' stamp: 'jmv 11/30/2014 10:51'! -testOrderedCollection - " - CollectTest new testOrderedCollection - " - | col result | - col _ #(1 2 3 4 5) asOrderedCollection. - result _ col collect: [ :elem | elem * 2 ]. - self assert: result class = OrderedCollection. - self assert: result = #(2 4 6 8 10) asOrderedCollection! ! - -!CollectTest methodsFor: 'testing' stamp: 'jmv 11/30/2014 11:34'! -testSet - " - CollectTest new testSet - " - | col result | - col _ #(1 2 3 1.0 2.0 3.0) asSet. - result _ col collect: [ :elem | elem yourself ]. - self assert: result class = Set. - self assert: result = #(1 2 3) asSet. - self assert: result = col! ! - -!CollectTest methodsFor: 'testing' stamp: 'jmv 11/30/2014 11:01'! -testSortedCollection - " - CollectTest new testSortedCollection - " - | col result | - col _ #(1 2 3 4 5) asSortedCollection: [ :a :b | a > b ]. - result _ col collect: [ :elem | elem * 2 ]. - self assert: result class = OrderedCollection. - self assert: result = #(10 8 6 4 2) asOrderedCollection! ! + self + evaluate: [ :first :second :third :fourth :fifth | + self + assert: (first and: [second] and: [third] and: [fourth] and: [fifth]) + equals: ((((first and: [second]) and: [third]) and: [ fourth ]) and: [ fifth ]) ] + forCombinationOf: 5 + + + + ! ! -!CollectionTest methodsFor: 'groupBy tests' stamp: 'HAW 7/5/2018 15:14:11'! -testGroupByHavingSelectsTheResultOfGroupBy +!BooleanTest methodsFor: 'and tests' stamp: 'HAW 7/8/2018 20:03:46'! +testAndAndAndTrueTable - | collectionToGroupBy groupedByEven | + self + evaluate: [ :first :second :third :fourth | + self + assert: (first and: [second] and: [third] and: [fourth]) + equals: (((first and: [second]) and: [third]) and: [ fourth ]) ] + forCombinationOf: 4 + - collectionToGroupBy := OrderedCollection with: 1 with: 2 with: 3 with: 4 with: 5. - groupedByEven := collectionToGroupBy groupBy: [ :anInteger | anInteger even ] having: [ :group | group size > 2 ]. - self assert: 1 equals: (groupedByEven size). - self assert: (collectionToGroupBy select: [ :anInteger | anInteger odd ]) equals: (groupedByEven at: false) ! ! + ! ! -!CollectionTest methodsFor: 'groupBy tests' stamp: 'HAW 7/5/2018 15:15:41'! -testGroupByReturnsADictionaryThatGroupsACollectionByThePluggableKey +!BooleanTest methodsFor: 'and tests' stamp: 'HAW 7/8/2018 20:04:00'! +testAndAndTrueTable - | collectionToGroupBy groupedByEven | + self + evaluate: [ :first :second :third | + self + assert: (first and: [second] and: [third]) + equals: ((first and: [second]) and: [third]) ] + forCombinationOf: 3 + - collectionToGroupBy := OrderedCollection with: 1 with: 2 with: 3 with: 4 with: 5. - groupedByEven := collectionToGroupBy groupBy: [ :anInteger | anInteger even ]. - self assert: 2 equals: groupedByEven size. - self assert: (collectionToGroupBy select: [ :anInteger | anInteger even ]) equals: (groupedByEven at: true). - self assert:(collectionToGroupBy select: [ :anInteger | anInteger odd ]) equals: (groupedByEven at: false).! ! + ! ! -!CollectionTest methodsFor: 'average tests' stamp: 'HAW 11/17/2018 11:45:15'! -testAverageFailsWhenTheCollectionIsEmpty +!BooleanTest methodsFor: 'or tests' stamp: 'HAW 7/8/2018 20:04:10'! +testOrOrOrOrTrueTable self - should: [ #() average: [ :each | each ] ] - raise: Error - description: Collection emptyCollectionDescription! ! + evaluate: [ :first :second :third :fourth :fifth | + self + assert: (first or: [second] or: [third] or: [fourth] or: [fifth]) + equals: ((((first or: [second]) or: [third]) or: [ fourth ]) or: [ fifth ]) ] + forCombinationOf: 5 + + + + ! ! -!CollectionTest methodsFor: 'average tests' stamp: 'HAW 11/17/2018 11:45:19'! -testAverageIfEmptyCalculatesItAsUsualWhenTheCollectionIsNotEmpty +!BooleanTest methodsFor: 'or tests' stamp: 'HAW 7/8/2018 20:04:18'! +testOrOrOrTrueTable - | someNumbers | + self + evaluate: [ :first :second :third :fourth | + self + assert: (first or: [second] or: [third] or: [fourth]) + equals: (((first or: [second]) or: [third]) or: [ fourth ]) ] + forCombinationOf: 4 + - someNumbers _ #(1 5). + + ! ! - self - assert: (someNumbers average: [ :each | each ] ifEmpty: [ self fail ]) - equals: someNumbers average! ! +!BooleanTest methodsFor: 'or tests' stamp: 'HAW 7/8/2018 20:04:25'! +testOrOrTrueTable -!CollectionTest methodsFor: 'average tests' stamp: 'HAW 11/17/2018 11:45:22'! -testAverageIfEmptyEvaluatesEmptyBlockWhenTheCollectionIsEmpty + self + evaluate: [ :first :second :third | + self + assert: (first or: [second] or: [third]) + equals: ((first or: [second]) or: [third]) ] + forCombinationOf: 3 + + + + ! ! - | emptyBlock | +!BooleanTest methodsFor: 'combination generation' stamp: 'HAW 7/8/2018 19:51:52'! +evaluate: aBlock collectingValuesInto: values at: aPosition - emptyBlock _ [ 0 ]. + aPosition = 0 + ifTrue: [ aBlock valueWithArguments: values ] + ifFalse: [ + #(true false) do: [ :value | + values at: aPosition put: value. + self evaluate: aBlock collectingValuesInto: values at: aPosition - 1 ]]! ! - self - assert: (#() average: [ :each | each asInteger ] ifEmpty: emptyBlock) - equals: emptyBlock value! ! +!BooleanTest methodsFor: 'combination generation' stamp: 'HAW 7/8/2018 19:50:53'! +evaluate: aBlock forCombinationOf: aNumberOfValues -!CollectionTest methodsFor: 'average tests' stamp: 'jmv 1/6/2021 11:57:27'! -testsAverageWorksWithABlock + self evaluate: aBlock collectingValuesInto: (Array new: aNumberOfValues) at: aNumberOfValues + ! ! - self assert: ({ '1' . '2' . '3' } average: [ :each | each asNumber ]) equals: 2! ! +!BooleanTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:13:00'! +testIsBoolean + self assert: (true is: #Boolean). + self assert: (false is: #Boolean).! ! -!CollectionTest methodsFor: 'as comma separated tests' stamp: 'HAW 3/6/2019 15:11:08'! -assertAsCommaSeparated: aCollection equals: expectedString - - self - assert: (String streamContents: [ :stream | aCollection asCommaSeparated: [ :elem | stream print: elem + 1] on: stream ]) - equals: expectedString! ! +!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! +testIfNilIfNotNil0Arg -!CollectionTest methodsFor: 'as comma separated tests' stamp: 'HAW 3/6/2019 15:12:31'! -testAsCommaSeparatedOnWorksAsCommaStringAnd + self assert: (5@4 ifNil: [#foo] ifNotNil: [#bar]) = #bar. + self assert: (nil ifNil: [#foo] ifNotNil: [#bar]) = #foo! ! - self assertAsCommaSeparated: #() equals: ''. - self assertAsCommaSeparated: #(1) equals: '2'. - self assertAsCommaSeparated: #(1 2) equals: '2 and 3'. - self assertAsCommaSeparated: #(1 2 3) equals: '2, 3 and 4'.! ! +!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! +testIfNilIfNotNil0ArgAsVar -!CollectionTest methodsFor: 'as comma separated tests' stamp: 'HAW 3/6/2019 15:11:51'! -testAsCommaStringAndDoesNotAddAnythingWhenEmpty + | block1 block2 | + block1 := [#foo]. + block2 := [#bar]. + self assert: (5@4 ifNil: block1 ifNotNil: block2) = #bar. + self assert: (nil ifNil: block1 ifNotNil: block2) = #foo! ! - self assert: #() asCommaStringAnd isEmpty ! ! +!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! +testIfNilIfNotNil1Arg -!CollectionTest methodsFor: 'as comma separated tests' stamp: 'HAW 3/6/2019 15:11:59'! -testAsCommaStringAndDoesNotAddAnythingWhenHasOneElement + self assert: (5@4 ifNil: [#foo] ifNotNil: [:a | a printString]) = '5@4'. + self assert: (nil ifNil: [#foo] ifNotNil: [:a | a printString]) = #foo! ! - self assert: #(1) asCommaStringAnd equals: '1' ! ! +!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! +testIfNilIfNotNil1ArgAsVar -!CollectionTest methodsFor: 'as comma separated tests' stamp: 'HAW 3/6/2019 15:12:06'! -testAsCommaStringAndSeparatesWithAndWhenTwoOneElements + | block1 block2 | + block1 := [#foo]. + block2 := [:a | a printString]. + self assert: (5@4 ifNil: block1 ifNotNil: block2) = '5@4'. + self assert: (nil ifNil: block1 ifNotNil: block2) = #foo! ! - self assert: #(1 2) asCommaStringAnd equals: '1 and 2' ! ! +!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! +testIfNotNil0Arg -!CollectionTest methodsFor: 'as comma separated tests' stamp: 'HAW 3/6/2019 15:12:21'! -testAsCommaStringAndSeparatesWithCommaButLastOneWithAndWhenMoreThanTwoElements + self assert: (5@4 ifNotNil: [#foo]) = #foo. + self assert: (nil ifNotNil: [#foo]) = nil! ! - self assert: #(1 2 3) asCommaStringAnd equals: '1, 2 and 3' ! ! +!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! +testIfNotNil0ArgAsVar -!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/16/2019 00:08:43'! -testItMaintainsTheSameCollectionSpecies + | block | + block := [#foo]. + self assert: (5@4 ifNotNil: block) = #foo. + self assert: (nil ifNotNil: block) = nil! ! - self assert: (OrderedCollection with: 1 with: 2) equals: (OrderedCollection with: 1 with: #(2)) flatten! ! +!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! +testIfNotNil1Arg -!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/15/2019 23:31:15'! -testWhenCollectionContainsASingleLevelOfElementsItReturnsTheSameCollection + self assert: (5@4 ifNotNil: [:a | a printString]) = '5@4'. + self assert: (nil ifNotNil: [:a | a printString]) = nil! ! - self assert: #(1 2 3) equals: #(1 2 3) flatten! ! +!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! +testIfNotNil1ArgAsVar -!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/16/2019 00:01:02'! -testWhenCollectionContainsMoreThanTwoLevelsltReturnsTheElementsOfAllNestedCollections - - self assert: #(1 2 3 4 5) equals: #(1 #(2 3) #(4 #(5))) flatten! ! - -!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/16/2019 00:03:22'! -testWhenCollectionContainsStringCollectionsItDoesNotFlattenTheStrings - - self assert: #('string1' 'string2' 'string3') equals: #('string1' #('string2' 'string3')) flatten! ! - -!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/16/2019 00:02:07'! -testWhenCollectionContainsStringsItReturnsTheSameCollection + | block | + block := [:a | a printString]. + self assert: (5@4 ifNotNil: block) = '5@4'. + self assert: (nil ifNotNil: block) = nil! ! - self assert: #('string1' 'string2' 'string3') equals: #('string1' 'string2' 'string3') flatten! ! +!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! +testIfNotNilIfNil0Arg -!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/16/2019 00:03:37'! -testWhenCollectionContainsTwoLevelsOfElementsItReturnsTheElementsOfAllNestedCollections - - self assert: #(1 2 3) equals: #(#(1) #(2 3)) flatten - ! ! + self assert: (5@4 ifNotNil: [#foo] ifNil: [#bar]) = #foo. + self assert: (nil ifNotNil: [#foo] ifNil: [#bar]) = #bar! ! -!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/15/2019 23:24:15'! -testWhenCollectionIsEmptyItReturnsTheSameCollection +!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! +testIfNotNilIfNil0ArgAsVar - self assert: #() equals: #() flatten! ! + | block1 block2 | + block1 := [#foo]. + block2 := [#bar]. + self assert: (5@4 ifNotNil: block2 ifNil: block1) = #bar. + self assert: (nil ifNotNil: block2 ifNil: block1) = #foo! ! -!CollectionTest methodsFor: 'misc tests' stamp: 'jpb 8/2/2019 23:18:50'! -testIsCollection - self assert: (Bag new is: #Collection).! ! +!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! +testIfNotNilIfNil1Arg -!CollectionTest methodsFor: 'misc tests' stamp: 'jmv 6/12/2019 18:22:57'! -testSetEquality - self assert: Set new = IdentitySet new. - self assert: Set new hash = IdentitySet new hash. - self assert: Dictionary new = IdentityDictionary new. - self assert: Dictionary new hash = IdentityDictionary new hash. - self assert: Dictionary new = OrderedDictionary new. - self assert: Dictionary new hash = OrderedDictionary new hash. - self assert: IdentityDictionary new = OrderedDictionary new. - self assert: IdentityDictionary new hash = OrderedDictionary new hash. + self assert: (5@4 ifNotNil: [:a | a printString] ifNil: [#foo]) = '5@4'. + self assert: (nil ifNotNil: [:a | a printString] ifNil: [#foo]) = #foo! ! - self deny: Set new = Dictionary new! ! +!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:47'! +testIfNotNilIfNil1ArgAsVar -!DictionaryTest methodsFor: 'tests' stamp: 'jpb 8/2/2019 23:17:49'! -testIsCollection - self assert: (Dictionary new is: #Collection)! ! + | block1 block2 | + block1 := [#foo]. + block2 := [:a | a printString]. + self assert: (5@4 ifNotNil: block2 ifNil: block1) = '5@4'. + self assert: (nil ifNotNil: block2 ifNil: block1) = #foo! ! -!DictionaryTest methodsFor: 'tests' stamp: 'HAW 4/4/2019 08:18:05'! -testKeyNotFoundSignalTheRightMessage +!ObjectTest methodsFor: 'error tests' stamp: 'HAW 10/23/2019 09:23:56'! +testErrorSignalsTheRightException + | reason | + + reason := 'something went wrong'. self - should: [ Dictionary new errorKeyNotFound ] + should: [ self error: reason ] raise: Error - withMessageText: Dictionary keyNotFoundErrorDescription ! ! - -!IntervalTest methodsFor: 'testing' stamp: 'jmv 12/18/2018 10:56:31'! -testAt - " - IntervalTest new testAt - " - self assert: (2 to: 5 by: 2) first = 2. - self assert: ((2 to: 5 by: 2) at: 1) = 2. - self assert: ((2 to: 5 by: 2) at: 2) = 4. - self assert: (2 to: 5 by: 2) last = 4. + withMessageText: reason ! ! - self assert: (0 to: 2.4 by: 0.1) first = 0. - self assert: ((0 to: 2.4 by: 0.1) at: 1) = 0. - self assert: (((0 to: 2.4 by: 0.1) at: 2) isWithin: 1 floatsFrom: 0.1). - self assert: (((0 to: 2.4 by: 0.1) at: 3) isWithin: 1 floatsFrom: 0.2). - self assert: (((0 to: 2.4 by: 0.1) at: 23) isWithin: 1 floatsFrom: 2.2). - self assert: ((0 to: 2.4 by: 0.1) at: 24) = 2.3. - self assert: ((0 to: 2.4 by: 0.1) at: 25) = 2.4. - self assert: (0 to: 2.4 by: 0.1) last = 2.4.! ! +!ObjectTest methodsFor: 'error tests' stamp: 'HAW 10/23/2019 09:24:03'! +testShouldNotHappenBecauseSignalsTheRightError -!IntervalTest methodsFor: 'testing' stamp: 'jmv 12/18/2018 10:56:59'! -testFloatInterval - " - IntervalTest new testFloatInterval - " + | reason | - self assert: (0 to: 2.4 by: 0.1) size = 25. - self assert: (0 to: 2.4 by: 0.1) first = 0. - self assert: (0 to: 2.4 by: 0.1) last = 2.4. + reason := 'something went wrong'. + self + should: [ self shouldNotHappenBecause: reason ] + raise: Error + withMessageText: self shouldNotHappenBecauseErrorMessage, reason ! ! - 2 to: 200 do: [ :n | - self assert: (0.0 to: 1.0 count: n) size = n. - self assert: (0.0 to: 1.0 count: n) first = 0.0. - self assert: ((0.0 to: 1.0 count: n) last isWithin: 1 floatsFrom: 1.0)]. - 2 to: 200 do: [ :n | - self assert: (1.0 to: 0.0 count: n) size = n. - self assert: (1.0 to: 0.0 count: n) first = 1.0. - self assert: ((1.0 to: 0.0 count: n) last isWithin: 1 floatsFrom: 0.0)].! ! +!ObjectTest methodsFor: 'error tests' stamp: 'HAW 10/23/2019 09:24:11'! +testShouldNotHappenSignalsTheRightError -!IntervalTest methodsFor: 'testing' stamp: 'HAW 3/17/2019 07:20:11'! -testFloatToByDo - " - IntervalTest new testFloatToByDo - " - | interval toByDo | + self + should: [ self shouldNotHappen ] + raise: Error + withMessageText: self shouldNotHappenErrorMessage ! ! - "See comment at #to:by:do:" - self shouldFail: [ - interval _ 0 to: 2.4 by: 0.1. - toByDo _ Array streamContents: [ :strm | - 0 to: 2.4 by: 0.1 do: [ :each | - strm nextPut: each ]]. - self assert: toByDo size = interval size. - 1 to: toByDo size do: [ :i | - self assert: (toByDo at: i) = (interval at: i) ]]! ! +!SpecialSelectorsTest methodsFor: 'testing' stamp: 'jmv 6/5/2017 12:17:20'! +testCollectionAtSymbol + self assert: (#(1 2 3) @ #(10 20 30)) class == Array! ! -!IntervalTest methodsFor: 'testing' stamp: 'jmv 3/27/2016 17:18'! -testIntegerInterval - " - IntervalTest new testIntegerInterval - " - | z | - self assert: (2 to: 5 by: 2) size = 2. - self assert: (2 to: 5 by: 2) last = 4. - z _ 0. - (2 to: 5 by: 2) do: [ :i | z _ i ]. - self assert: z = 4! ! +!SpecialSelectorsTest methodsFor: 'testing' stamp: 'jmv 6/5/2017 12:16:49'! +testNumberAtSymbol + self assert: (1@2) class == Point! ! -!IntervalTest methodsFor: 'testing' stamp: 'jmv 4/27/2016 14:29'! -testIntegerToByDo - " - IntervalTest new testIntegerToByDo - " - | interval toByDo | - interval _ 2 to: 5 by: 2. - toByDo _ Array streamContents: [ :strm | - 2 to: 5 by: 2 do: [ :each | - strm nextPut: each ]]. - self assert: toByDo size = interval size. - 1 to: toByDo size do: [ :i | - self assert: (toByDo at: i) = (interval at: i) ]! ! +!WeakMessageSendTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:44:58'! +testIsMessageSend + self assert: (WeakMessageSend new is: #MessageSend).! ! -!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:43:33'! -testDoesNotIncludeNumbersOutsideTheInInterval +!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HernanWilkinson 1/19/2017 20:32:36'! +testAllSuperclassesUpToFailsWhenWantsToStopOnInvalidSuperclass - | from1To10 | - - from1To10 := 1 to: 10. + | invalidSuperclass | - self deny: (from1To10 includes: 0). - self deny: (from1To10 includes: 11)! ! - -!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:35:03'! -testDoesNotIncludeObjectsThatAreNotNumbers - - self deny: ((1 to: 10) includes: $a)! ! + invalidSuperclass := Collection. + self + should: [ SmallInteger allSuperclassesUpTo: invalidSuperclass ] + raise: Error + withExceptionDo: [:anError | + self assert: anError messageText equals: (nil superclassNotValidErrorDescriptionFor: invalidSuperclass) ] + + ! ! -!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:53:40'! -testDoesNotIncludedNumbersThatAreInRangeButNotReachedByTheStep +!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HAW 2/10/2017 10:51:40'! +testAllSuperclassesUpToPutsFirstSuperclassesFirst - | from1To10By2 | + | superclasses | - from1To10By2 := 1 to: 10 by: 2. + superclasses := SmallInteger allSuperclassesUpTo: Number. - self deny: (from1To10By2 includes: 0). - self deny: (from1To10By2 includes: 2). - self deny: (from1To10By2 includes: 6). - self deny: (from1To10By2 includes: 10).! ! + self assert: 2 equals: superclasses size. + self assert: Integer equals: superclasses first. + self assert: Number equals: superclasses second! ! -!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:54:48'! -testDoesNotIncludedNumbersThatAreInRangeButNotReachedByTheStepWithReversedIntervals +!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HAW 2/10/2017 10:52:55'! +testAllSuperclassesUpToStopsOnRightClass - | from10To1ByMinus2 | + | superclasses | - from10To1ByMinus2 := 10 to: 1 by: -2. + superclasses := SmallInteger allSuperclassesUpTo: Integer. - self deny: (from10To1ByMinus2 includes: 0). - self deny: (from10To1ByMinus2 includes: 1). - self deny: (from10To1ByMinus2 includes: 5). - self deny: (from10To1ByMinus2 includes: 9).! ! + self assert: 1 equals: superclasses size. + self assert: (superclasses includes: Integer) + + ! ! -!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:43:03'! -testIncludedNumbersRespectAStepDifferentToOne +!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HAW 8/3/2019 09:29:49'! +testHighestClassImplementingReturnsReceiverWhenNoOtherSuperclassImplementsSelector - | from1To10By2 | + | higestClass | - from1To10By2 := 1 to: 10 by: 2. + higestClass := OrderedCollection highestClassImplementing: #addFirst: ifNone: [ self fail ]. - self assert: (from1To10By2 includes: 1). - self assert: (from1To10By2 includes: 5). - self assert: (from1To10By2 includes: 9).! ! + self assert: OrderedCollection equals: higestClass + ! ! -!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:55:55'! -testIncludedNumbersRespectNegativeSteps +!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HAW 8/3/2019 09:30:01'! +testHighestClassImplementingReturnsTheTopSuperclassImplementingSelector - | from10To1ByMinus2 | + | higestClass | - from10To1ByMinus2 := 10 to: 1 by: -2. + higestClass := OrderedCollection highestClassImplementing: #select: ifNone: [ self fail ]. - self assert: (from10To1ByMinus2 includes: 10). - self assert: (from10To1ByMinus2 includes: 6). - self assert: (from10To1ByMinus2 includes: 2).! ! + self assert: Collection equals: higestClass + ! ! -!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:43:26'! -testIncludesNumbersInsideTheInterval +!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HAW 8/3/2019 09:29:55'! +testHighestClassImplementingValuesIfNoneBlockWhenSelectorIsNotImplemented - | from1To10 | + OrderedCollection highestClassImplementing: #x ifNone: [ ^self ]. - from1To10 := 1 to: 10. - - self assert: (from1To10 includes: 1). - self assert: (from1To10 includes: 5). - self assert: (from1To10 includes: 10).! ! + self fail! ! -!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:43:21'! -testIncludesNumbersInsideTheIntervalEvenForReversedIntervals +!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HAW 2/10/2017 10:52:30'! +testWithAllSuperclassesUpToIncludesReceiverClass - | from10To1 | + | superclasses | - from10To1 := 10 to: 1 by: -1. + superclasses := SmallInteger withAllSuperclassesUpTo: Number. - self assert: (from10To1 includes: 1). - self assert: (from10To1 includes: 5). - self assert: (from10To1 includes: 10).! ! + self assert: 3 equals: superclasses size. + self assert: SmallInteger equals: superclasses first. + self assert: Integer equals: superclasses second. + self assert: Number equals: superclasses third ! ! -!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 12:01:44'! -testIntervalWithOneNumberAndNegativeStepBiggerThanOneIncludeOnlyThatNumber +!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 6/28/2020 11:57:28'! +testAllAccessToInstVarReturnsAccessReceiversBranch - | from1To1ByMinus2 | - - from1To1ByMinus2 := 1 to: 1 by: -2. - - self assert: (from1To1ByMinus2 includes: 1). - self deny: (from1To1ByMinus2 includes: -1). - self deny: (from1To1ByMinus2 includes: 3).! ! + | references | -!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 12:01:54'! -testIntervalWithOneNumberAndNegativeStepIncludeOnlyThatNumber + "Just in case the hierarchy changes... not much of a chance but... - Hernan" + self deny: (IdentitySet includesBehavior: Dictionary). + self deny: (Dictionary includesBehavior: IdentitySet). + self assert: (IdentitySet includesBehavior: Set). + self assert: (Dictionary includesBehavior: Set). + self assert: (IdentityDictionary includesBehavior: Dictionary). - | from1To1ByMinus1 | - - from1To1ByMinus1 := 1 to: 1 by: -1. - - self assert: (from1To1ByMinus1 includes: 1). - self deny: (from1To1ByMinus1 includes: 0). - self deny: (from1To1ByMinus1 includes: 2).! ! + references := IdentitySet allAccessesTo: 'array'. -!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 12:00:46'! -testIntervalWithOneNumberAndStepBiggerThanOneIncludesOnlyTheNumber + self assert: (references noneSatisfy: [ :aReference | aReference methodClass = IdentityDictionary ])! ! - | from1To1By2 | - - from1To1By2 := 1 to: 1 by: 2. - - self assert: (from1To1By2 includes: 1). - self deny: (from1To1By2 includes: -1). - self deny: (from1To1By2 includes: 3).! ! +!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 4/9/2020 16:17:49'! +testAllAccessToIsEmptyForVariableNotDefinedInClass -!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:59:06'! -testIntervalWithOneNumberIncludesOnlyTheNumber + self assert: (Object allAccessesTo: 'iv1') isEmpty! ! - | from1To1 | - - from1To1 := 1 to: 1. - - self assert: (from1To1 includes: 1). - self deny: (from1To1 includes: 0). - self deny: (from1To1 includes: 2).! ! +!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 6/28/2020 11:53:39'! +testAllBroadAccessToReturnsAccessInAllHierarchy -!OrderedCollectionTest methodsFor: 'tests' stamp: 'jpb 8/2/2019 23:18:24'! -testIsCollection - self assert: (OrderedCollection new is: #Collection).! ! + | references | -!OrderedCollectionTest methodsFor: 'tests' stamp: 'HAW 5/18/2019 17:01:20'! -testStreamContentsWorksAsExpected + "Just in case the hierarchy changes... not much of a chance but... - Hernan" + self deny: (IdentitySet includesBehavior: Dictionary). + self deny: (Dictionary includesBehavior: IdentitySet). + self assert: (IdentitySet includesBehavior: Set). + self assert: (Dictionary includesBehavior: Set). - | contents | - - contents := OrderedCollection streamContents: [ :stream | stream nextPut: 1 ]. - - self assert: (OrderedCollection with: 1) equals: contents! ! + references := IdentitySet allBroadAccessesTo: 'array'. -!OrderedCollectionTest methodsFor: 'tests' stamp: 'HAW 5/18/2019 17:04:16'! -testWriteStreamOnOrderedCollectionGrowsAsExpected + self assert: (references anySatisfy: [ :aReference | aReference methodClass = Dictionary ])! ! - | contents | +!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 8/2/2018 16:54:42'! +testAllUnreferencedInstanceVariablesReturnsOnlyUnreferencedVariables + + | unreferencedVariables | - contents := OrderedCollection streamContents: [ :stream | - 1 to: 101 do: [ :aNumber | stream nextPut: aNumber ]]. + unreferencedVariables := BehaviorTestSubclass allUnreferencedInstanceVariables. - 1 to: 101 do: [ :aNumber | self assert: aNumber equals: (contents at: aNumber) ] - ! ! - -!OrderedDictionaryTest methodsFor: 'tests' stamp: 'jmv 5/25/2018 10:36:59'! -testOrder - | data dict orderingByCollect orderingByDo orderingBySelect aux desiredOrder | + self assert: 1 equals: unreferencedVariables size. + self assert: (unreferencedVariables includes: 'unreferenced') ! ! - "Test that #do:, #select: and #collect: iterate in the correct order" - dict _ OrderedDictionary new. - data _ self sampleData. - desiredOrder _ data collect: [ :pair | pair second ]. - data do: [ :pair | - dict at: pair first put: pair second ]. +!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 8/2/2018 16:54:45'! +testHasReferencesToInstanceVariableNamedLooksInClassOnly - orderingByDo _ Array streamContents: [ :strm | dict do: [ :each | strm nextPut: each ]]. - self assert: orderingByDo = desiredOrder. + self deny: (self class hasReferencesToInstanceVariableNamed: 'referenced'). + self assert: (BehaviorTestSubclass hasReferencesToInstanceVariableNamed: 'referenced'). + ! ! - aux _ dict select: [ :each | true ]. - orderingBySelect _ Array streamContents: [ :strm | aux do: [ :each | strm nextPut: each ]]. - self assert: orderingBySelect = desiredOrder. +!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 8/2/2018 16:54:48'! +testIsInstanceVariableNamedReferencedInHierarchyLooksReferencesInHierarchy - aux _ dict collect: [ :each | each yourself ]. - orderingByCollect _ Array streamContents: [ :strm | aux do: [ :each | strm nextPut: each ]]. - self assert: orderingByCollect = desiredOrder. + self assert: (self class isInstanceVariableNamedReferencedInHierarchy: 'referenced'). + self deny: (self class isInstanceVariableNamedReferencedInHierarchy: 'unreferenced'). + ! ! +!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 6/28/2020 11:48:19'! +testProtoObjectAllRegularInstVarNamesDoesNotFail - "Test that order is correct even if different. Also test alternative way to add stuff to dict." - dict _ OrderedDictionary new. - data _ self sampleData reversed. - desiredOrder _ data collect: [ :pair | pair second ]. - data do: [ :pair | - dict add: pair first -> pair second ]. + self + shouldnt: [ ProtoObject allRegularInstVarNames ] + raise: Error! ! - orderingByDo _ Array streamContents: [ :strm | dict do: [ :each | strm nextPut: each ]]. - self assert: orderingByDo = desiredOrder. +!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 8/2/2018 16:54:52'! +testUnreferencedInstanceVariablesReturnsOnlyUnreferencedVariables - aux _ dict select: [ :each | true ]. - orderingBySelect _ Array streamContents: [ :strm | aux do: [ :each | strm nextPut: each ]]. - self assert: orderingBySelect = desiredOrder. + | unreferencedVariables | + + unreferencedVariables := self class unreferencedInstanceVariables. + + self assert: 1 equals: unreferencedVariables size. + self assert: (unreferencedVariables includes: 'unreferenced') ! ! - aux _ dict collect: [ :each | each yourself ]. - orderingByCollect _ Array streamContents: [ :strm | aux do: [ :each | strm nextPut: each ]]. - self assert: orderingByCollect = desiredOrder. -! ! +!BehaviorTestSubclass methodsFor: 'test data' stamp: 'HAW 8/2/2018 16:54:29'! +methodReferencingReferencedVariable -!OrderedDictionaryTest methodsFor: 'tests' stamp: 'jmv 5/25/2018 10:41:04'! -testRemove - | data dict dataToRemove desiredOrder orderingByDo | + ^referenced ! ! - "Test that #do:, #select: and #collect: iterate in the correct order" - dict _ OrderedDictionary new. - data _ self sampleData. - dataToRemove _ self sampleData2. +!BehaviorTestSubclass class methodsFor: 'as yet unclassified' stamp: 'HAW 2/28/2019 19:18:42'! +isAbstract - data do: [ :pair | - dict at: pair first put: pair second ]. - dataToRemove do: [ :pair | - dict removeKey: pair first ]. + ^true! ! - orderingByDo _ Array streamContents: [ :strm | dict do: [ :each | strm nextPut: each ]]. +!CategorizerTest methodsFor: 'assertions' stamp: 'HAW 9/24/2020 19:46:47'! +assertAddsWithoutBlanks: aCategoryWithBlanks - desiredOrder _ OrderedCollection new. - data do: [ :pair | desiredOrder add: pair second ]. - dataToRemove do: [ :pair | desiredOrder remove: pair second ]. + | categorizer | - self assert: orderingByDo = desiredOrder asArray.! ! - -!OrderedDictionaryTest methodsFor: 'aux' stamp: 'jmv 5/25/2018 10:16:25'! -sampleData - ^ { {1. 'uno'}. {6. 'seis'}. {8. 'ocho'}. {7. 'siete'}. {2. 'dos'}. {3. 'tres'}. {4. 'cuatro'}. {5. 'cinco'}}! ! + categorizer := self createCategorizer. + + categorizer addCategory: aCategoryWithBlanks. + + self assert: (categorizer categories includes: aCategoryWithBlanks withBlanksTrimmed). + self deny: (categorizer categories includes: aCategoryWithBlanks). + + + ! ! -!OrderedDictionaryTest methodsFor: 'aux' stamp: 'jmv 5/25/2018 10:16:35'! -sampleData2 - ^ { {1. 'uno'}. {8. 'ocho'}. {3. 'tres'}}! ! +!CategorizerTest methodsFor: 'assertions' stamp: 'HAW 9/24/2020 19:46:54'! +assertClassifiesWithoutBlanks: aCategoryWithBlanks -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/25/2019 09:49:41'! -testCombinationsAtATimeDoShouldEvaluateBlockWithEmptyCollection + | categorizer | - | combinationWasEmpty | + categorizer := self createCategorizer. - combinationWasEmpty := false. - 'ab' combinations: 0 atATimeDo: [ :combination | combinationWasEmpty := combination isEmpty ]. + categorizer classify: 1 under: aCategoryWithBlanks suppressIfDefault: false. - self assert: combinationWasEmpty! ! + self assert: (categorizer categoryOfElement: 1) equals: aCategoryWithBlanks withBlanksTrimmed + ! ! -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/25/2019 09:59:32'! -testCombinationsAtATimeDoWorksAsExpected +!CategorizerTest methodsFor: 'assertions' stamp: 'HAW 2/1/2022 17:55:04'! +assertRenamesToWithoutBlanks: aCategoryWithBlanks + + | categorizer categoryToRename | - | combinations | - - combinations := OrderedCollection new. - 'abc' combinations: 2 atATimeDo: [ :combination | combinations add: combination copy]. + categorizer := self createCategorizer. - self assert: 3 equals: combinations size. - self assert: (combinations includes: #($a $b)). - self assert: (combinations includes: #($a $c)). - self assert: (combinations includes: #($b $c)).! ! + categoryToRename := 'someCategory'. + categorizer classify: 1 under: categoryToRename suppressIfDefault: false. + categorizer renameCategory: categoryToRename to: aCategoryWithBlanks. + + self assert: (categorizer categories includes: aCategoryWithBlanks withBlanksTrimmed). + self deny: (categorizer categories includes: aCategoryWithBlanks). + self deny: (categorizer categories includes: categoryToRename). + self assert: aCategoryWithBlanks withBlanksTrimmed equals: (categorizer categoryOfElement: 1) + ! ! -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:33:35'! -testDoSeparatedByDoesNotValueSeparatedBlockForCollectionsOfOneElement +!CategorizerTest methodsFor: 'tests' stamp: 'HAW 9/24/2020 19:57:50'! +testClassifiesWithoutLeadingBlanks - | collectionToTraverse traversedElements | + self assertClassifiesWithoutBlanks: self categoryWithLeadingBlanks ! ! - collectionToTraverse := OrderedCollection with: 1. - traversedElements := OrderedCollection new. - self shouldntFail: [ collectionToTraverse do: [ :anElement | traversedElements add: anElement ] separatedBy: [ self fail ] ]. +!CategorizerTest methodsFor: 'tests' stamp: 'HAW 9/24/2020 19:57:33'! +testClassifiesWithoutTrailingBlanks - self assert: collectionToTraverse equals: traversedElements! ! + self assertClassifiesWithoutBlanks: self categoryWithTrailingBlanks ! ! -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:38:06'! -testDoSeparatedByDoesNotValueSeparatedBlockOnLastElement +!CategorizerTest methodsFor: 'tests' stamp: 'HAW 9/24/2020 19:56:18'! +testRemovesLeadingBlanksWhenAddingCategory - | collectionToTraverse traversedElements | - - collectionToTraverse := OrderedCollection with: 1 with: 2. - traversedElements := OrderedCollection new. - - self shouldntFail: [ collectionToTraverse do: [ :anElement | traversedElements add: anElement ] separatedBy: [ traversedElements add: $-] ]. + self assertAddsWithoutBlanks: self categoryWithLeadingBlanks. + + ! ! - self assert: (OrderedCollection with: 1 with: $- with: 2) equals: traversedElements! ! +!CategorizerTest methodsFor: 'tests' stamp: 'HAW 9/24/2020 19:55:58'! +testRemovesTrailingBlanksWhenAddingCategory -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:29:27'! -testDoSeparatedByDoesNothingForEmptyCollection + self assertAddsWithoutBlanks: self categoryWithTrailingBlanks. + + ! ! - self shouldntFail: [ #() do: [ :anElement | self fail ] separatedBy: [ self fail ] ]! ! +!CategorizerTest methodsFor: 'tests' stamp: 'HAW 9/24/2020 19:58:11'! +testRenamesWithoutLeadingBlanks -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/21/2020 17:00:14'! -testFirstAvailableReturnsAllObjectsWhenRequestedMoreThanTheSize + self assertRenamesToWithoutBlanks: self categoryWithLeadingBlanks ! ! - self assert: #(10 20 30) equals: (#(10 20 30) firstAvailable: 4)! ! +!CategorizerTest methodsFor: 'tests' stamp: 'HAW 9/24/2020 19:58:01'! +testRenamesWithoutTrailingBlanks -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/21/2020 17:00:43'! -testFirstAvailableReturnsAllObjectsWhenRequestedTheReceiversSize + self assertRenamesToWithoutBlanks: self categoryWithTrailingBlanks ! ! - self assert: #(10 20 30) equals: (#(10 20 30) firstAvailable: 3)! ! +!CategorizerTest methodsFor: 'support' stamp: 'HAW 9/24/2020 16:41:35'! +categoryWithLeadingBlanks -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/21/2020 16:58:40'! -testFirstAvailableReturnsTheFirstRequestedObjectsWhenTheyAreAvailable + ^ ' withLeadingBlanks'! ! - self assert: #(10 20) equals: (#(10 20 30) firstAvailable: 2)! ! +!CategorizerTest methodsFor: 'support' stamp: 'HAW 9/24/2020 16:41:23'! +categoryWithTrailingBlanks -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/21/2020 17:03:20'! -testLastAvailableReturnsAllObjectsWhenRequestedMoreThanTheSize + ^ 'withTrailingBlanks '! ! - self assert: #(10 20 30) equals: (#(10 20 30) lastAvailable: 4)! ! +!CategorizerTest methodsFor: 'support' stamp: 'HAW 9/24/2020 19:46:47'! +createCategorizer -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/21/2020 17:02:57'! -testLastAvailableReturnsAllObjectsWhenRequestedTheReceiversSize + ^ Categorizer defaultList: #()! ! - self assert: #(10 20 30) equals: (#(10 20 30) lastAvailable: 3)! ! +!ClassOrganizerTest methodsFor: 'support' stamp: 'HAW 9/24/2020 19:53:00'! +createCategorizer -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/21/2020 17:02:27'! -testLastAvailableReturnsTheLastRequestedObjectsWhenTheyAreAvailable + ^ ClassOrganizer defaultList: #()! ! - self assert: #(20 30) equals: (#(10 20 30) lastAvailable: 2)! ! +!ClassTest methodsFor: 'definition tests' stamp: 'HAW 10/24/2019 09:34:44'! +testDefinitionReplacingCategoryWithReplacesTheCategoryWithTheGivenOne -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:36:00'! -testWithIndexDoSeparatedByDoesNotValueSeparatedBlockForCollectionsOfOneElement + | classDefinition newCategory newCategoryDefinition | + + newCategory := 'NewCategory'. + newCategoryDefinition := 'category: ''', newCategory, ''''. + classDefinition := self class definitionReplacingCategoryWith: newCategory. + + self assert: (classDefinition includesSubString: newCategoryDefinition). + self deny: (classDefinition includesSubString: self class category) + - | collectionToTraverse traversedElements | +! ! - collectionToTraverse := OrderedCollection with: $a. - traversedElements := OrderedCollection new. +!ClassTest methodsFor: 'definition tests' stamp: 'HAW 10/24/2019 09:42:54'! +testDefinitionReplacingCategoryWithWorksWhenCategoryIsNil - self shouldntFail: [ collectionToTraverse withIndexDo: [ :anElement :index | traversedElements add: anElement -> index ] separatedBy: [ self fail ] ]. + | classDefinition newCategory newCategoryDefinition currentCategory | + + newCategory := 'NewCategory'. + newCategoryDefinition := 'category: ''', newCategory, ''''. + currentCategory := self class category. + [SystemOrganization removeElement: self class name. + classDefinition := self class definitionReplacingCategoryWith: newCategory. + + self assert: (classDefinition includesSubString: newCategoryDefinition). + self deny: (classDefinition includesSubString: self class category asString) ] + ensure: [ + SystemOrganization classify: self class name under: currentCategory ]. - self assert: 1 equals: traversedElements size. - self assert: $a->1 equals: traversedElements first! ! + -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:40:01'! -testWithIndexDoSeparatedByDoesNotValueSeparatedBlockOnLastElement +! ! - | collectionToTraverse traversedElements | +!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/18/2018 16:27:22'! +effectiveZeroExponentForTrigonometry - collectionToTraverse := OrderedCollection with: $a with: $b. - traversedElements := OrderedCollection new. + ^-50! ! - collectionToTraverse - withIndexDo: [ :anElement :index | traversedElements add: anElement -> index ] - separatedBy: [ traversedElements add: $-]. +!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/15/2018 01:19:37'! +hyperbolicPrecision - self assert: 3 equals: traversedElements size. - self assert: $a->1 equals: traversedElements first. - self assert: $- equals: traversedElements second. - self assert: $b->2 equals: traversedElements third! ! + ^16! ! -!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:30:18'! -testWithIndexDoSeparatedByDoesNothingForEmptyCollection +!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/15/2018 01:12:19'! +trigonometricDegreePrecision - self shouldntFail: [ #() withIndexDo: [ :anElement :index | self fail ] separatedBy: [ self fail ] ]! ! + ^4! ! -!TextTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:40:53'! -testIsText - self assert: (Text new is: #Text).! ! +!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/15/2018 00:25:51'! +trigonometricPrecision -!WeakIdentitySetTest methodsFor: 'testing' stamp: 'jmv 8/24/2012 08:24'! -test - " - (also tests WeakSet a bit) - WeakIdentitySetTest new test - " - | ary1 ary2 count w wi | - ary1 _ { 3@4 . 4@5 }. - ary2 _ { 13@4 . 14@5 }. - w _ WeakSet new. - w addAll: ary1. - wi _ WeakIdentitySet new. - wi addAll: ary2. - - self assert: w size = 2. - count _ 0. - w do: [ :each | - count _ count + 1. - self assert: each class == Point ]. - self assert: count = 2. - self assert: (w includes: ary1 first). - self assert: (w includes: ary1 second). - self assert: (w includes: 3@4). - self assert: (w includes: 4@5). + ^3! ! - self assert: wi size = 2. - count _ 0. - wi do: [ :each | - count _ count + 1. - self assert: each class == Point ]. - self assert: count = 2. - self assert: (wi includes: ary2 first). - self assert: (wi includes: ary2 second). - self deny: (wi includes: 13@4). - self deny: (wi includes: 14@5). +!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/15/2018 00:22:44'! +verify: aFloat is: anInteger floatsAwayFrom: anotherFloat - "Now make one element in each disappear" - ary1 at: 1 put: 9. - ary2 at: 1 put: 99. - Smalltalk garbageCollect. + self assert: (aFloat floatsAwayFrom: anotherFloat) = anInteger. + self assert: (anotherFloat floatsAwayFrom: aFloat) = anInteger negated. + self assert: (aFloat negated floatsAwayFrom: anotherFloat negated) = anInteger negated. + self assert: (anotherFloat negated floatsAwayFrom: aFloat negated) = anInteger! ! - "A little weird, but yes, elements that disappeared are still counted, but NOT iterated!!" - self assert: w size = 2. - count _ 0. - w do: [ :each | - count _ count + 1 ]. - self assert: count = 1. - self deny: (w includes: ary1 first). - self assert: (w includes: ary1 second). +!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/18/2018 16:27:33'! +verify: aFloat isDegreeTrigonometricallyEqualTo: anotherFloat - self assert: wi size = 2. "A little weird, but yes, elements that disappeared are still counted" - count _ 0. - wi do: [ :each | - count _ count + 1 ]. - self assert: count = 1. - self deny: (wi includes: ary2 first). - self assert: (wi includes: ary2 second).! ! + aFloat = 0.0 ifTrue: [ + anotherFloat = 0.0 ifTrue: [^self ]. + ^self assert: anotherFloat asFloat exponent <= self effectiveZeroExponentForTrigonometry]. + anotherFloat = 0.0 ifTrue: [^self assert: aFloat asFloat exponent <= self effectiveZeroExponentForTrigonometry]. + self verify: aFloat asFloat isWithin: self trigonometricDegreePrecision floatsAwayFrom: anotherFloat asFloat! ! -!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HernanWilkinson 1/19/2017 20:32:36'! -testAllSuperclassesUpToFailsWhenWantsToStopOnInvalidSuperclass +!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/18/2018 16:27:38'! +verify: aFloat isHyperbolicallyEqualTo: anotherFloat - | invalidSuperclass | - - invalidSuperclass := Collection. - self - should: [ SmallInteger allSuperclassesUpTo: invalidSuperclass ] - raise: Error - withExceptionDo: [:anError | - self assert: anError messageText equals: (nil superclassNotValidErrorDescriptionFor: invalidSuperclass) ] - - ! ! + aFloat = 0.0 ifTrue: [ + anotherFloat = 0.0 ifTrue: [^self ]. + ^anotherFloat asFloat exponent <= self effectiveZeroExponentForTrigonometry]. + anotherFloat = 0.0 ifTrue: [^aFloat asFloat exponent <= self effectiveZeroExponentForTrigonometry]. + self verify: aFloat asFloat isWithin: self hyperbolicPrecision floatsAwayFrom: anotherFloat asFloat! ! -!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HAW 2/10/2017 10:51:40'! -testAllSuperclassesUpToPutsFirstSuperclassesFirst +!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/18/2018 16:27:41'! +verify: aFloat isTrigonometricallyEqualTo: anotherFloat - | superclasses | - - superclasses := SmallInteger allSuperclassesUpTo: Number. - - self assert: 2 equals: superclasses size. - self assert: Integer equals: superclasses first. - self assert: Number equals: superclasses second! ! + aFloat = 0.0 ifTrue: [ + anotherFloat = 0.0 ifTrue: [^self ]. + ^self assert: anotherFloat asFloat exponent <= self effectiveZeroExponentForTrigonometry]. + anotherFloat = 0.0 ifTrue: [^self assert: aFloat asFloat exponent <= self effectiveZeroExponentForTrigonometry]. + self verify: aFloat asFloat isWithin: self trigonometricPrecision floatsAwayFrom: anotherFloat asFloat! ! -!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HAW 2/10/2017 10:52:55'! -testAllSuperclassesUpToStopsOnRightClass +!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/15/2018 00:22:57'! +verify: aFloat isWithin: anInteger floatsAwayFrom: anotherFloat - | superclasses | - - superclasses := SmallInteger allSuperclassesUpTo: Integer. - - self assert: 1 equals: superclasses size. - self assert: (superclasses includes: Integer) - - ! ! + self assert: (aFloat floatsAwayFrom: anotherFloat) abs <= anInteger. + self assert: (anotherFloat floatsAwayFrom: aFloat) abs <= anInteger. + self assert: (aFloat negated floatsAwayFrom: anotherFloat negated) abs <= anInteger. + self assert: (anotherFloat negated floatsAwayFrom: aFloat negated) abs <= anInteger! ! -!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HAW 8/3/2019 09:29:49'! -testHighestClassImplementingReturnsReceiverWhenNoOtherSuperclassImplementsSelector +!AbstractNumberTest methodsFor: 'helpers' stamp: 'jmv 12/18/2018 10:40:29'! +verify: aFloat isWithinOneFloatAwayFrom: anotherFloat - | higestClass | - - higestClass := OrderedCollection highestClassImplementing: #addFirst: ifNone: [ self fail ]. - - self assert: OrderedCollection equals: higestClass - ! ! + self verify: aFloat isWithin: 1 floatsAwayFrom: anotherFloat! ! -!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HAW 8/3/2019 09:30:01'! -testHighestClassImplementingReturnsTheTopSuperclassImplementingSelector +!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 2/21/2019 17:38:32'! +testAdd - | higestClass | - - higestClass := OrderedCollection highestClassImplementing: #select: ifNone: [ self fail ]. - - self assert: Collection equals: higestClass - ! ! - -!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HAW 8/3/2019 09:29:55'! -testHighestClassImplementingValuesIfNoneBlockWhenSelectorIsNotImplemented - - OrderedCollection highestClassImplementing: #x ifNone: [ ^self ]. - - self fail! ! + self assert: 1.0 + 1.0 = 2.0. + self assert: Float fminNormalized + Float fminDenormalized > Float fminNormalized. + self assert: Float fminNormalized + Float fminDenormalized - Float fminNormalized = Float fminDenormalized. + self assert: 1.0 + Float zero = 1.0. + self assert: Float zero + 1.0 = 1.0. + self assert: 1.0 + Float negativeZero = 1.0. + self assert: Float negativeZero + 1.0 = 1.0. + self assert: 1.0 + Float infinity = Float infinity. + self assert: Float infinity + 1.0 = Float infinity. + self assert: 1.0 + Float negativeInfinity = Float negativeInfinity. + self assert: Float negativeInfinity + 1.0 = Float negativeInfinity. + self assert: (1.0 + Float nan) isNaN. + self assert: (Float nan + 1.0) isNaN.! ! -!BehaviorTest methodsFor: 'class hierarchy tests' stamp: 'HAW 2/10/2017 10:52:30'! -testWithAllSuperclassesUpToIncludesReceiverClass +!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 7/2/2019 11:56:44'! +testDivide - | superclasses | + self assert: 1.5 / 2.0 = 0.75. - superclasses := SmallInteger withAllSuperclassesUpTo: Number. + self assert: 2.0 / 1 = 2.0. - self assert: 3 equals: superclasses size. - self assert: SmallInteger equals: superclasses first. - self assert: Integer equals: superclasses second. - self assert: Number equals: superclasses third ! ! - -!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 6/28/2020 11:57:28'! -testAllAccessToInstVarReturnsAccessReceiversBranch - - | references | - - "Just in case the hierarchy changes... not much of a chance but... - Hernan" - self deny: (IdentitySet includesBehavior: Dictionary). - self deny: (Dictionary includesBehavior: IdentitySet). - self assert: (IdentitySet includesBehavior: Set). - self assert: (Dictionary includesBehavior: Set). - self assert: (IdentityDictionary includesBehavior: Dictionary). - - references := IdentitySet allAccessesTo: 'array'. - - self assert: (references noneSatisfy: [ :aReference | aReference methodClass = IdentityDictionary ])! ! + self should: [ 2.0 / 0 ] raise: ZeroDivide. + self assert: 2.0 / 0 isExactly: Float infinity. + self should: [ 2.0 / 0.0 ] raise: ZeroDivide. + self assert: 2.0 / 0.0 isExactly: Float infinity. + self should: [ 1.2 / Float negativeZero ] raise: ZeroDivide. + self assert: 1.2 / Float negativeZero isExactly: Float negativeInfinity. + self should: [ 1.2 / (1.3 - 1.3) ] raise: ZeroDivide. + self assert: 1.2 / (1.3 - 1.3) isExactly: Float infinity. -!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 4/9/2020 16:17:49'! -testAllAccessToIsEmptyForVariableNotDefinedInClass + self assert: 2.0 / 2.0 = 1.0. + self assert: Float fminNormalized / 2.0 * 2.0 = Float fminNormalized. + self assert: Float fminDenormalized * 2.0 / 2.0 = Float fminDenormalized. + self assertIsPositiveZero: Float zero / 1.0. + self assertIsNegativeZero: Float negativeZero / 1.0. + self assertIsPositiveZero: 1.0 / Float infinity. + self assert: Float infinity / 1.0 = Float infinity. + self assertIsNegativeZero: 1.0 / Float negativeInfinity. + self assert: Float negativeInfinity / 1.0 = Float negativeInfinity. + self assert: (1.0 / Float nan) isNaN. + self assert: (Float nan / 1.0) isNaN.! ! - self assert: (Object allAccessesTo: 'iv1') isEmpty! ! +!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 2/21/2019 17:53:58'! +testMultiply -!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 6/28/2020 11:53:39'! -testAllBroadAccessToReturnsAccessInAllHierarchy + self assert: 2.0 * 2.0 = 4.0. + self assert: Float fminNormalized * 2.0 = (Float fminNormalized + Float fminNormalized). + self assert: Float fminDenormalized * 2.0 = (Float fminDenormalized + Float fminDenormalized). + self assertIsPositiveZero: 1.0 * Float zero. + self assertIsPositiveZero: Float zero * 1.0. + self assertIsNegativeZero: 1.0 * Float negativeZero. + self assertIsNegativeZero: Float negativeZero * 1.0. + self assert: 1.0 * Float infinity = Float infinity. + self assert: Float infinity * 1.0 = Float infinity. + self assert: 1.0 * Float negativeInfinity = Float negativeInfinity. + self assert: Float negativeInfinity * 1.0 = Float negativeInfinity. + self assert: (1.0 * Float nan) isNaN. + self assert: (Float nan * 1.0) isNaN.! ! - | references | +!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 2/21/2019 17:41:52'! +testSubtract - "Just in case the hierarchy changes... not much of a chance but... - Hernan" - self deny: (IdentitySet includesBehavior: Dictionary). - self deny: (Dictionary includesBehavior: IdentitySet). - self assert: (IdentitySet includesBehavior: Set). - self assert: (Dictionary includesBehavior: Set). + self assert: 3.0 - 1.0 = 2.0. + self assert: Float fminNormalized - Float fminDenormalized < Float fminNormalized. + self assert: Float fminNormalized - Float fminDenormalized - Float fminNormalized = Float fminDenormalized negated. + self assert: 1.0 - Float zero = 1.0. + self assert: Float zero - 1.0 = -1.0. + self assert: 1.0 - Float negativeZero = 1.0. + self assert: Float negativeZero - 1.0 = -1.0. + self assert: 1.0 - Float infinity = Float negativeInfinity. + self assert: Float infinity - 1.0 = Float infinity. + self assert: 1.0 - Float negativeInfinity = Float infinity. + self assert: Float negativeInfinity - 1.0 = Float negativeInfinity. + self assert: (1.0 - Float nan) isNaN. + self assert: (Float nan - 1.0) isNaN.! ! - references := IdentitySet allBroadAccessesTo: 'array'. +!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 10/15/2019 16:32:51'! +testTimesTwoPowerGradualUnderflow + "Here is a vicious case where timesTwoPower is inexact because it underflows. + And two consecutive inexact operations lead to a different result than a single one. + Typically expressed as multiple of Float fmin in base 2, + 2r1011*Float fmin shifted by -3 with round to nearest, tie to even mode: + -> round(1.011) -> 1.0 = fmin + But if first shifted by -2 then by -1: + -> round(10.11) -> 11.0 = 3*fmin + -> round(1.1) -> 10.0 = 2*fmin + Or first shifted by -1 then by -2: + -> round(101.1) -> 110.0 = 6*fmin + -> round(1.1) -> 10.0 = 2*fmin + A naive implementation that split the shift uncarefully might fail to handle such case correctly." - self assert: (references anySatisfy: [ :aReference | aReference methodClass = Dictionary ])! ! + | f | + f := 2r1011 asFloat. + "scan the whole range of possible exponents for this significand" + Float fmin exponent + f exponent to: Float fmax exponent - f exponent + do: + [ :exp | + | g | + g := f timesTwoPower: exp. + (g timesTwoPower: Float fmin exponent - g exponent) = Float fmin ifFalse: [ exp print ]. + "self assert: (g timesTwoPower: Float fmin exponent - g exponent) = Float fmin" + ] -!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 8/2/2018 16:54:42'! -testAllUnreferencedInstanceVariablesReturnsOnlyUnreferencedVariables +" +testTimesTwoPowerGradualUnderflow +https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/383 +"! ! - | unreferencedVariables | - - unreferencedVariables := BehaviorTestSubclass allUnreferencedInstanceVariables. - - self assert: 1 equals: unreferencedVariables size. - self assert: (unreferencedVariables includes: 'unreferenced') ! ! +!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 3/26/2019 10:59:17'! +testTimesTwoPowerOverflow + self assert: (Float fminNormalized timesTwoPower: Float emax - Float emin) equals: (2.0 raisedTo: Float emax). + self assert: (Float zero timesTwoPower: SmallInteger maxVal) equals: Float zero. + self assert: (Float zero timesTwoPower: SmallInteger maxVal squared) equals: Float zero. + self assert: (1.0 timesTwoPower: SmallInteger maxVal) equals: Float infinity. + self assert: (1.0 timesTwoPower: SmallInteger maxVal squared) equals: Float infinity. + self assert: (-1.0 timesTwoPower: SmallInteger maxVal) equals: Float negativeInfinity. + self assert: (-1.0 timesTwoPower: SmallInteger maxVal squared) equals: Float negativeInfinity.! ! -!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 8/2/2018 16:54:45'! -testHasReferencesToInstanceVariableNamedLooksInClassOnly +!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 3/26/2019 10:58:50'! +testTimesTwoPowerUnderflow + self assert: ((2.0 raisedTo: Float emax) timesTwoPower: Float emin - Float emax) equals: Float fminNormalized. + self assert: (Float infinity timesTwoPower: SmallInteger minVal * SmallInteger maxVal) equals: Float infinity. + self assertIsPositiveZero: (1.0 timesTwoPower: SmallInteger maxVal negated). + self assertIsPositiveZero: (1.0 timesTwoPower: SmallInteger maxVal squared negated). + self assertIsNegativeZero: (-1.0 timesTwoPower: SmallInteger maxVal negated). + self assertIsNegativeZero: (-1.0 timesTwoPower: SmallInteger maxVal squared negated). +! ! - self deny: (self class hasReferencesToInstanceVariableNamed: 'referenced'). - self assert: (BehaviorTestSubclass hasReferencesToInstanceVariableNamed: 'referenced'). - ! ! +!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 7/2/2019 12:03:05'! +testZeroDividedByZero -!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 8/2/2018 16:54:48'! -testIsInstanceVariableNamedReferencedInHierarchyLooksReferencesInHierarchy + self assert: (0.0 / 0.0) isNaN. + self assert: (0.0 / -0.0) isNaN. + self assert: (-0.0 / 0.0) isNaN. + self assert: (-0.0 / -0.0) isNaN.! ! - self assert: (self class isInstanceVariableNamedReferencedInHierarchy: 'referenced'). - self deny: (self class isInstanceVariableNamedReferencedInHierarchy: 'unreferenced'). - ! ! +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:56:51'! +testArCosh + self assert: 1.0 arCosh = 0.0. + self deny: Float infinity arCosh isFinite. + self verify: 2.5 arCosh cosh isHyperbolicallyEqualTo: 2.5! ! -!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 6/28/2020 11:48:19'! -testProtoObjectAllRegularInstVarNamesDoesNotFail +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 3/26/2019 11:23:12'! +testArSinh + self assertIsPositiveZero: 0.0 arSinh. + self assertIsNegativeZero: Float negativeZero arSinh. + self deny: Float infinity arSinh isFinite. + self verify: 0.5 arSinh negated isHyperbolicallyEqualTo: 0.5 negated arSinh. + self verify: 0.5 arSinh sinh isHyperbolicallyEqualTo: 0.5. + self verify: -2.5 arSinh sinh isHyperbolicallyEqualTo: -2.5! ! - self - shouldnt: [ ProtoObject allRegularInstVarNames ] - raise: Error! ! +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:57:47'! +testArTanh + self assertIsPositiveZero: 0.0 arTanh. + self assertIsNegativeZero: Float negativeZero arTanh. + self deny: 1 arTanh isFinite. + self verify: 0.5 arTanh negated isHyperbolicallyEqualTo: 0.5 negated arTanh. + self verify: 0.5 arTanh tanh isHyperbolicallyEqualTo: 0.5. + self verify: -0.5 arTanh tanh isHyperbolicallyEqualTo: -0.5! ! -!BehaviorTest methodsFor: 'instance variables tests' stamp: 'HAW 8/2/2018 16:54:52'! -testUnreferencedInstanceVariablesReturnsOnlyUnreferencedVariables +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/18/2018 10:52:08'! +testArcTan - | unreferencedVariables | + self verify: (100 arcTan: 100) isTrigonometricallyEqualTo: Float pi / 4. + self verify: (-100 arcTan: 100) isTrigonometricallyEqualTo: Float pi / -4. + self verify: (100 arcTan: -100) isTrigonometricallyEqualTo: Float pi * 3 / 4. + self verify: (-100 arcTan: -100) isTrigonometricallyEqualTo: Float pi * -3 / 4. + self verify: (0 arcTan: 100) isTrigonometricallyEqualTo: 0. + self verify: (0 arcTan: -100) isTrigonometricallyEqualTo: Float pi. + self verify: (100 arcTan: 0) isTrigonometricallyEqualTo: Float pi / 2. + self verify: (-100 arcTan: 0) isTrigonometricallyEqualTo: Float pi / -2. - unreferencedVariables := self class unreferencedInstanceVariables. + self verify: (Float negativeZero arcTan: 100) isTrigonometricallyEqualTo: 0. + self verify: (Float negativeZero arcTan: -100) isTrigonometricallyEqualTo: Float pi * -1. - self assert: 1 equals: unreferencedVariables size. - self assert: (unreferencedVariables includes: 'unreferenced') ! ! - -!BehaviorTestSubclass methodsFor: 'test data' stamp: 'HAW 8/2/2018 16:54:29'! -methodReferencingReferencedVariable + self assert: (0 arcTan: 0) = 0. + self assert: (Float negativeZero arcTan: 0) = 0. + self verify: (0 arcTan: Float negativeZero) isTrigonometricallyEqualTo: Float pi. + self verify: (Float negativeZero arcTan: Float negativeZero) isTrigonometricallyEqualTo: Float pi negated.! ! - ^referenced ! ! +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 11/27/2018 13:11:53'! +testArcTanNonPrimitive -!BehaviorTestSubclass class methodsFor: 'as yet unclassified' stamp: 'HAW 2/28/2019 19:18:42'! -isAbstract + #[0.0 0.01 0.1 0.3 0.5 0.7 0.8 1.0 2.0 5.0 20.0] do: [ :x | | computed | + computed _ x arcTanNonPrimitive. + self assert: (computed tan -x ) abs <= (computed predecessor tan -x ) abs. + self assert: (computed tan -x ) abs <= (computed successor tan -x ) abs. + ]! ! - ^true! ! +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:48:21'! +testCos -!CategorizerTest methodsFor: 'assertions' stamp: 'HAW 9/24/2020 19:46:47'! -assertAddsWithoutBlanks: aCategoryWithBlanks + self verify: 0.0 cos isTrigonometricallyEqualTo: 1.0. + self verify: (Float pi / 3) cos isTrigonometricallyEqualTo: 1.0 sqrt / 2.0. + self verify: (Float pi / 4) cos isTrigonometricallyEqualTo: 2.0 sqrt / 2.0. + self verify: (Float pi / 6) cos isTrigonometricallyEqualTo: 3.0 sqrt / 2.0. + self verify: (Float pi / 2) cos isTrigonometricallyEqualTo: 0.0! ! - | categorizer | - - categorizer := self createCategorizer. - - categorizer addCategory: aCategoryWithBlanks. - - self assert: (categorizer categories includes: aCategoryWithBlanks withBlanksTrimmed). - self deny: (categorizer categories includes: aCategoryWithBlanks). - - - ! ! - -!CategorizerTest methodsFor: 'assertions' stamp: 'HAW 9/24/2020 19:46:54'! -assertClassifiesWithoutBlanks: aCategoryWithBlanks - - | categorizer | - - categorizer := self createCategorizer. - - categorizer classify: 1 under: aCategoryWithBlanks suppressIfDefault: false. - - self assert: (categorizer categoryOfElement: 1) equals: aCategoryWithBlanks withBlanksTrimmed - ! ! +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:58:14'! +testCosh + self verify: 0.0 cosh isHyperbolicallyEqualTo: 1.0. + self verify: 2.0 cosh squared - 2.0 sinh squared isHyperbolicallyEqualTo: 1.0. + self verify: 2.0 cosh isHyperbolicallyEqualTo: 2.0 negated cosh. + self deny: Float infinity cosh isFinite ! ! -!CategorizerTest methodsFor: 'assertions' stamp: 'HAW 2/1/2022 17:55:04'! -assertRenamesToWithoutBlanks: aCategoryWithBlanks +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/18/2018 16:27:57'! +testDegreeCos + "Following tests use approximate equality, because cosine are generally evaluated using inexact Floating point arithmetic" + self verify: 45 degreeCos squared isDegreeTrigonometricallyEqualTo: 0.5. + self verify: 45.0 degreeCos squared isDegreeTrigonometricallyEqualTo: 0.5. + self verify: 60 degreeCos isDegreeTrigonometricallyEqualTo: 0.5. + self verify: 60.0 degreeCos isDegreeTrigonometricallyEqualTo: 0.5. + self verify: 120 degreeCos isDegreeTrigonometricallyEqualTo: -0.5. + self verify: 120.0 degreeCos isDegreeTrigonometricallyEqualTo: -0.5. + -360 to: 360 by: 1/3 do: + [:step | + | expected actual | + expected := step degreesToRadians cos. + actual := step degreeCos. + expected = actual ifFalse: [self assert: (expected - actual) exponent <= self effectiveZeroExponentForTrigonometry]. + expected := step asFloat degreesToRadians cos. + actual := step asFloat degreeCos. + expected = actual ifFalse: [self assert: (expected - actual) exponent <= self effectiveZeroExponentForTrigonometry] + ]. - | categorizer categoryToRename | - - categorizer := self createCategorizer. - - categoryToRename := 'someCategory'. - categorizer classify: 1 under: categoryToRename suppressIfDefault: false. - categorizer renameCategory: categoryToRename to: aCategoryWithBlanks. - - self assert: (categorizer categories includes: aCategoryWithBlanks withBlanksTrimmed). - self deny: (categorizer categories includes: aCategoryWithBlanks). - self deny: (categorizer categories includes: categoryToRename). - self assert: aCategoryWithBlanks withBlanksTrimmed equals: (categorizer categoryOfElement: 1) - ! ! + "Following tests use strict equality which is a requested property of degreeCos" + -10.0 to: 10.0 do: [:k | + self assert: (k*360 + 90) degreeCos = 0. + self assert: (k*360 - 90) degreeCos = 0. + self assert: (k*360 + 180) degreeCos + 1 = 0. + self assert: (k*360) degreeCos - 1 = 0.].! ! -!CategorizerTest methodsFor: 'tests' stamp: 'HAW 9/24/2020 19:57:50'! -testClassifiesWithoutLeadingBlanks +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'nice 5/3/2014 22:30:50.872'! +testDegreeCosForExceptionalValues + self assert: Float nan degreeCos isNaN. + self assert: Float infinity degreeCos isNaN. + self assert: Float negativeInfinity degreeCos isNaN.! ! - self assertClassifiesWithoutBlanks: self categoryWithLeadingBlanks ! ! +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/18/2018 16:28:02'! +testDegreeSin + "Following tests use approximate equality, because sine are generally evaluated using inexact Floating point arithmetic" + self verify: 45 degreeSin squared isDegreeTrigonometricallyEqualTo: 0.5. + self verify: 45.0 degreeSin squared isDegreeTrigonometricallyEqualTo: 0.5. + self verify: 30 degreeSin isDegreeTrigonometricallyEqualTo: 0.5. + self verify: 30.0 degreeSin isDegreeTrigonometricallyEqualTo: 0.5. + self verify: -30 degreeSin isDegreeTrigonometricallyEqualTo: -0.5. + self verify: -30.0 degreeSin isDegreeTrigonometricallyEqualTo: -0.5. + -360 to: 360 by: 1/3 do: + [:step | + | expected actual | + expected := step degreesToRadians sin. + actual := step degreeSin. + expected = actual ifFalse: [self assert: (expected - actual) exponent <= self effectiveZeroExponentForTrigonometry]. + expected := step asFloat degreesToRadians sin. + actual := step asFloat degreeSin. + expected = actual ifFalse: [self assert: (expected - actual) exponent <= self effectiveZeroExponentForTrigonometry]. + ]. -!CategorizerTest methodsFor: 'tests' stamp: 'HAW 9/24/2020 19:57:33'! -testClassifiesWithoutTrailingBlanks + "Following tests use strict equality which is a requested property of degreeSin" + -10.0 to: 10.0 do: [:k | + self assert: (k*360 + 90) degreeSin - 1 = 0. + self assert: (k*360 - 90) degreeSin + 1= 0. + self assert: (k*360 + 180) degreeSin = 0. + self assert: (k*360) degreeSin = 0.].! ! - self assertClassifiesWithoutBlanks: self categoryWithTrailingBlanks ! ! +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'nice 5/3/2014 22:30:55.613'! +testDegreeSinForExceptionalValues + self assert: Float nan degreeSin isNaN. + self assert: Float infinity degreeSin isNaN. + self assert: Float negativeInfinity degreeSin isNaN.! ! -!CategorizerTest methodsFor: 'tests' stamp: 'HAW 9/24/2020 19:56:18'! -testRemovesLeadingBlanksWhenAddingCategory +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 11/27/2018 13:15:27'! +testExp + self assert: 0.0 exp = 1.0. + self assert: 1.0 exp = Float e. + self assert: 2.0 exp sqrt = Float e! ! - self assertAddsWithoutBlanks: self categoryWithLeadingBlanks. - - ! ! +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 11/27/2018 13:28:53'! +testExpNonPrimitive -!CategorizerTest methodsFor: 'tests' stamp: 'HAW 9/24/2020 19:55:58'! -testRemovesTrailingBlanksWhenAddingCategory + #[0.0 0.01 0.1 0.3 0.5 0.7 0.8 1.0 2.0 5.0 ] do: [ :x | | computed expected | + computed _ x expNonPrimitive. + expected _ x exp. + self assert: (computed - expected) abs <= (expected ulp*2) + ]! ! - self assertAddsWithoutBlanks: self categoryWithTrailingBlanks. +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/12/2018 14:38:16'! +testFloorLog2 + "Float internal representation of Float being in base 2, we expect (aFloat floorLog: 2) to be exact." - ! ! - -!CategorizerTest methodsFor: 'tests' stamp: 'HAW 9/24/2020 19:58:11'! -testRenamesWithoutLeadingBlanks + | aBitLess aBitMore | + aBitMore := 1.0 successor. + aBitLess := 1.0 predecessor. + Float emin + 1 to: Float emax - 1 do: [:exp | + | exactPowerOfTwo | + exactPowerOfTwo := 1.0 timesTwoPower: exp. + self assert: exp equals: (exactPowerOfTwo floorLog: 2). + self assert: exp equals: (exactPowerOfTwo * aBitMore floorLog: 2). + self assert: exp-1 equals: (exactPowerOfTwo * aBitLess floorLog: 2) ].! ! - self assertRenamesToWithoutBlanks: self categoryWithLeadingBlanks ! ! +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 11/27/2018 13:33:48'! +testLn + self assert: 0.0 exp ln = 0.0. + self assert: 1.0 exp ln = 1.0. + self assert: 2.0 exp ln = 2.0.! ! -!CategorizerTest methodsFor: 'tests' stamp: 'HAW 9/24/2020 19:58:01'! -testRenamesWithoutTrailingBlanks +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/14/2018 23:53:24'! +testLnForExceptionalValues - self assertRenamesToWithoutBlanks: self categoryWithTrailingBlanks ! ! + self assert: -1.0 ln isNaN. + self assert: Float infinity ln = Float infinity. + self assert: Float negativeInfinity ln isNaN! ! -!CategorizerTest methodsFor: 'support' stamp: 'HAW 9/24/2020 16:41:35'! -categoryWithLeadingBlanks +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/11/2018 13:39:49'! +testLnNonPrimitive - ^ ' withLeadingBlanks'! ! + #[0.0 0.01 0.1 0.3 0.5 0.7 0.8 1.01 2.01 5.0 ] do: [ :x | | computed expected | + computed _ x exp lnNonPrimitive. + expected _ x exp ln. + self assert: (computed - expected) abs <= (expected ulp*2) + ]! ! -!CategorizerTest methodsFor: 'support' stamp: 'HAW 9/24/2020 16:41:23'! -categoryWithTrailingBlanks +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 7/2/2019 11:55:02'! +testReciprocal - ^ 'withTrailingBlanks '! ! + self + assert: 1.0 reciprocal = 1.0; + assert: 2.0 reciprocal = 0.5; + assert: -1.0 reciprocal = -1.0; + assert: -2.0 reciprocal = -0.5. + + self should: [ 0.0 reciprocal ] raise: ZeroDivide. + self assert: 0.0 reciprocal isExactly: Float infinity! ! -!CategorizerTest methodsFor: 'support' stamp: 'HAW 9/24/2020 19:46:47'! -createCategorizer +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:47:34'! +testSin - ^ Categorizer defaultList: #()! ! + self verify: 0.0 sin isTrigonometricallyEqualTo: 0.0. + self verify: (Float pi / 6) sin isTrigonometricallyEqualTo: 1.0 sqrt / 2.0. + self verify: (Float pi / 4) sin isTrigonometricallyEqualTo: 2.0 sqrt / 2.0. + self verify: (Float pi / 3) sin isTrigonometricallyEqualTo: 3.0 sqrt / 2.0. + self verify: (Float pi / 2) sin isTrigonometricallyEqualTo: 1.0! ! -!ClassOrganizerTest methodsFor: 'support' stamp: 'HAW 9/24/2020 19:53:00'! -createCategorizer +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/11/2018 13:41:55'! +testSinNonPrimitive + self assert: 0.0 sinNonPrimitive = 0.0. + self assert: (45 degreesToRadians sinNonPrimitive - 0.5 sqrt) abs <= (0.5 ulp * 2). + self assert: (90 degreesToRadians sinNonPrimitive - 1.0) abs <= (1.0 ulp * 2).! ! - ^ ClassOrganizer defaultList: #()! ! +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:58:36'! +testSinh + self assertIsPositiveZero: 0.0 sinh. + self assertIsNegativeZero: Float negativeZero sinh. + self deny: Float infinity sinh isFinite. + self verify: 2.0 cosh squared - 2.0 sinh squared isHyperbolicallyEqualTo: 1.0. + self verify: 2.0 sinh negated isHyperbolicallyEqualTo: 2.0 negated sinh! ! -!ClassTest methodsFor: 'definition tests' stamp: 'HAW 10/24/2019 09:34:44'! -testDefinitionReplacingCategoryWithReplacesTheCategoryWithTheGivenOne +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 3/26/2019 16:00:43'! +testSqrt + self assert: Float nan sqrt isNaN. + self assert: Float infinity sqrt = Float infinity. + self assertIsPositiveZero: Float zero sqrt. + self assertIsNegativeZero: Float negativeZero sqrt. + self assert: Float fminNormalized sqrt squared = Float fminNormalized . + self assert: Float fminDenormalized sqrt squared = Float fminDenormalized .! ! - | classDefinition newCategory newCategoryDefinition | - - newCategory := 'NewCategory'. - newCategoryDefinition := 'category: ''', newCategory, ''''. - classDefinition := self class definitionReplacingCategoryWith: newCategory. +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 11/27/2018 11:03:49'! +testSqrtNonPrimitive + self assert: Float nan sqrtNonPrimitive isNaN. + self assert: Float infinity sqrtNonPrimitive = Float infinity. + self assertIsPositiveZero: Float zero sqrtNonPrimitive. + self assertIsNegativeZero: Float negativeZero sqrtNonPrimitive. - self assert: (classDefinition includesSubString: newCategoryDefinition). - self deny: (classDefinition includesSubString: self class category) - + self assert: 1.0 sqrt = 1.0 sqrtNonPrimitive. + self assert: 2.0 sqrt = 2.0 sqrtNonPrimitive. + self assert: 4.0 sqrt = 4.0 sqrtNonPrimitive. + self assert: 8.0 sqrt = 8.0 sqrtNonPrimitive. + self assert: 9.0 sqrt = 9.0 sqrtNonPrimitive.! ! -! ! +!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:58:54'! +testTanh + self assertIsPositiveZero: 0.0 tanh. + self assertIsNegativeZero: Float negativeZero tanh. + self assert: Float infinity tanh = 1.0. + self verify: 2.0 cosh squared - 2.0 sinh squared isHyperbolicallyEqualTo: 1.0. + self verify: 2.0 tanh negated isHyperbolicallyEqualTo: 2.0 negated tanh! ! -!ClassTest methodsFor: 'definition tests' stamp: 'HAW 10/24/2019 09:42:54'! -testDefinitionReplacingCategoryWithWorksWhenCategoryIsNil +!FloatTest methodsFor: 'tests - comparing' stamp: 'nice 7/10/2009 22:27'! +testComparisonWhenPrimitiveFails + "This is related to http://bugs.squeak.org/view.php?id=7361" - | classDefinition newCategory newCategoryDefinition currentCategory | + self deny: 0.5 < (1/4). + self deny: 0.5 < (1/2). + self assert: 0.5 < (3/4). - newCategory := 'NewCategory'. - newCategoryDefinition := 'category: ''', newCategory, ''''. - currentCategory := self class category. - [SystemOrganization removeElement: self class name. - classDefinition := self class definitionReplacingCategoryWith: newCategory. + self deny: 0.5 <= (1/4). + self assert: 0.5 <= (1/2). + self assert: 0.5 <= (3/4). - self assert: (classDefinition includesSubString: newCategoryDefinition). - self deny: (classDefinition includesSubString: self class category asString) ] - ensure: [ - SystemOrganization classify: self class name under: currentCategory ]. - - + self assert: 0.5 > (1/4). + self deny: 0.5 > (1/2). + self deny: 0.5 > (3/4). + + self assert: 0.5 >= (1/4). + self assert: 0.5 >= (1/2). + self deny: 0.5 >= (3/4). + + self deny: 0.5 = (1/4). + self assert: 0.5 = (1/2). + self deny: 0.5 = (3/4). + + self assert: 0.5 ~= (1/4). + self deny: 0.5 ~= (1/2). + self assert: 0.5 ~= (3/4).! ! -! ! +!FloatTest methodsFor: 'tests - comparing' stamp: 'jmv 10/8/2018 16:20:48'! +testComparisonWithFraction + self assert: 0.5 = (1/2). + self assert: (1/2) = 0.5. + self assert: 0.1 = (1/10). + self assert: (1/10) = 0.1! ! -!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/18/2018 16:27:22'! -effectiveZeroExponentForTrigonometry +!FloatTest methodsFor: 'tests - comparing' stamp: 'jmv 8/29/2019 16:20:39'! +testEqualityComparison + "In Cuis, it was decided to coerce operands to Float for comparison (if any of them was float), + in the classic ST-80 way" + | a b c | + + "Test equality when Float conversion exact" + self assert: 16r1FFFFFFFFFFFFF = 16r1FFFFFFFFFFFFF asFloat. + self assert: 16r1FFFFFFFFFFFFF = 16r1FFFFFFFFFFFFF asFloat asInteger. + + self assert: (((1 bitShift: 54)+1)/(1 bitShift: 54)) > 1. + self assert: (((1 bitShift: 54)+1)/(1 bitShift: 54)) = 1.0. "Coerce to Float" + + self assert: (((1 bitShift: 54)-1)/(1 bitShift: 54)) < 1. + self assert: (((1 bitShift: 54)-1)/(1 bitShift: 54)) = 1.0. "Coerce to Float" + + "Test exact vs inexact arithmetic" + (1 to: 100) do: [:i | + self assert: (1/i) = (1/i asFloat)]. + + "Test overflow (compare to infinity)" + a := (11 raisedTo: 400) / 2. + b := (13 raisedTo: 400) / 2. + c := a asFloat. + self assert: ((a = c) & (b = c)). "Coerce to Float" + self deny: (a = b). + + "every integer is smaller than infinity" + self assert: a = Float infinity. "Coerce to Float" + self assert: a > Float infinity negated. + + "Test underflow" + self deny: 1 / (11 raisedTo: 400) = 0. + self assert: 1 / (11 raisedTo: 400) = 0.0. "Coerce to Float" + + "Test hash code" + self assert: + ((Set new: 3) add: 3; add: 3.0; size) = + ((Set new: 4) add: 3; add: 3.0; size). - ^-50! ! -!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/15/2018 01:19:37'! -hyperbolicPrecision + self assert: 9007199254740996 = 9007199254740996.0. + self assert: 9007199254740996001 / 1000 = 9007199254740996.0. + self assert: 90071992547409963 / 10 = 9007199254740996.0. + self assert: 90071992547409967 / 10 = 9007199254740996.0. + self assert: 9007199254740995 = 9007199254740996.0. + self deny: 9007199254740995 = 9007199254740994.0. - ^16! ! + self assert: 9007199254740996.0 = 9007199254740996. + self assert: 9007199254740996.0 = (9007199254740996001 / 1000). + self assert: 9007199254740996.0 = (90071992547409963 / 10). + self assert: 9007199254740996.0 = (90071992547409967 / 10). + self assert: 9007199254740996.0 = 9007199254740995. + self deny: 9007199254740994.0 = 9007199254740995.! ! -!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/15/2018 01:12:19'! -trigonometricDegreePrecision +!FloatTest methodsFor: 'tests - comparing' stamp: 'jmv 12/4/2018 12:05:21'! +testEquals + self assert: 1.0 = 1.0. + self deny: 1.0 = 2.0. + self assert: 0.0 = 0.0. + self deny: 0.0 = 1.0. + self deny: 1.0 = 0.0. + self assert: 1.0 = 1. + self deny: 1.0 = 2. + self assert: Float zero = Float negativeZero. + self assert: Float negativeZero = Float zero. + self assert: Float fmax = Float fmax. + self assert: Float fminNormalized = Float fminNormalized. + self assert: Float fminDenormalized = Float fminDenormalized. + self deny: Float fmax = Float fminNormalized. + self deny: Float fminNormalized = Float fmax. + self deny: Float fminDenormalized = Float fminNormalized. + self deny: Float fminNormalized = Float fminDenormalized.! ! - ^4! ! +!FloatTest methodsFor: 'tests - comparing' stamp: 'sqr 12/14/2018 23:02:34'! +testFloatsAwayFrom -!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/15/2018 00:25:51'! -trigonometricPrecision + self verify: 1.0 is: 0 floatsAwayFrom: 1.0. + self verify: 1.0 is: -1 floatsAwayFrom: 1.0 successor. + self verify: 1.0 is: 1 floatsAwayFrom: 1.0 predecessor. + self verify: 0.0 is: 0 floatsAwayFrom: Float negativeZero. + self verify: Float infinity is: 1 floatsAwayFrom: Float fmax. + self verify: Float fmax is: -1 floatsAwayFrom: Float infinity. + self verify: Float negativeInfinity is: -1 floatsAwayFrom: Float fmax negated. + self verify: Float fmax negated is: 1 floatsAwayFrom: Float negativeInfinity. + self verify: 0.0 is: -1 floatsAwayFrom: Float fminDenormalized. + self verify: Float negativeZero is: -1 floatsAwayFrom: Float fminDenormalized. + self verify: Float fmax is: (1 bitShift: Float precision - 1) - 1 floatsAwayFrom: (1.0 timesTwoPower: Float emax)! ! - ^3! ! +!FloatTest methodsFor: 'tests - comparing' stamp: 'sqr 12/14/2018 23:02:43'! +testFloatsAwayFromWithPowersOfTwo -!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/15/2018 00:22:44'! -verify: aFloat is: anInteger floatsAwayFrom: anotherFloat + | previous current soMany | + previous := 0.0. + current := Float fminDenormalized. + soMany := 1. + [current isFinite] whileTrue: + [ + self verify: current is: soMany floatsAwayFrom: previous. + soMany < 4503599627370496 :: and: [previous > 0.0] :: ifTrue: [soMany := soMany * 2]. + previous := current. + current := current * 2.0 + ]! ! - self assert: (aFloat floatsAwayFrom: anotherFloat) = anInteger. - self assert: (anotherFloat floatsAwayFrom: aFloat) = anInteger negated. - self assert: (aFloat negated floatsAwayFrom: anotherFloat negated) = anInteger negated. - self assert: (anotherFloat negated floatsAwayFrom: aFloat negated) = anInteger! ! +!FloatTest methodsFor: 'tests - comparing' stamp: 'jmv 10/8/2018 16:18:13'! +testHugeValues -!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/18/2018 16:27:33'! -verify: aFloat isDegreeTrigonometricallyEqualTo: anotherFloat + self assert: 1e400 = Float infinity. + self deny: 1e400 < Float infinity. + self deny: 1e400 > Float infinity. - aFloat = 0.0 ifTrue: [ - anotherFloat = 0.0 ifTrue: [^self ]. - ^self assert: anotherFloat asFloat exponent <= self effectiveZeroExponentForTrigonometry]. - anotherFloat = 0.0 ifTrue: [^self assert: aFloat asFloat exponent <= self effectiveZeroExponentForTrigonometry]. - self verify: aFloat asFloat isWithin: self trigonometricDegreePrecision floatsAwayFrom: anotherFloat asFloat! ! + self assert: 1e400 = 1.0e309. + self assert: 1e400 > 1.0e308. -!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/18/2018 16:27:38'! -verify: aFloat isHyperbolicallyEqualTo: anotherFloat - aFloat = 0.0 ifTrue: [ - anotherFloat = 0.0 ifTrue: [^self ]. - ^anotherFloat asFloat exponent <= self effectiveZeroExponentForTrigonometry]. - anotherFloat = 0.0 ifTrue: [^aFloat asFloat exponent <= self effectiveZeroExponentForTrigonometry]. - self verify: aFloat asFloat isWithin: self hyperbolicPrecision floatsAwayFrom: anotherFloat asFloat! ! + self assert: -1e400 = Float negativeInfinity. + self deny: -1e400 < Float negativeInfinity. + self deny: -1e400 > Float negativeInfinity. -!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/18/2018 16:27:41'! -verify: aFloat isTrigonometricallyEqualTo: anotherFloat + self assert: -1e400 = -1.0e309. + self assert: -1e400 < -1.0e308.! ! - aFloat = 0.0 ifTrue: [ - anotherFloat = 0.0 ifTrue: [^self ]. - ^self assert: anotherFloat asFloat exponent <= self effectiveZeroExponentForTrigonometry]. - anotherFloat = 0.0 ifTrue: [^self assert: aFloat asFloat exponent <= self effectiveZeroExponentForTrigonometry]. - self verify: aFloat asFloat isWithin: self trigonometricPrecision floatsAwayFrom: anotherFloat asFloat! ! +!FloatTest methodsFor: 'tests - comparing' stamp: 'nice 10/27/2014 21:50'! +testLiteralEqualityOfNan + | nan | + nan := Float nan. + self assert: (nan literalEqual: nan) + description: 'Float nan is not equal to itself, though it is literally equal'.! ! -!AbstractNumberTest methodsFor: 'helpers' stamp: 'sqr 12/15/2018 00:22:57'! -verify: aFloat isWithin: anInteger floatsAwayFrom: anotherFloat +!FloatTest methodsFor: 'tests - comparing' stamp: 'jmv 10/3/2018 16:29:31'! +testLiteralEqualityOfZeroAndNegativeZero + self assert: Float zero = Float negativeZero. + self deny: (Float zero literalEqual: Float negativeZero). + self + assert: (Compiler evaluate: '1>2 ifTrue: [0.0] ifFalse: [-0.0]') hex = Float negativeZero hex + description: 'Float zero and negativeZero are not literally substituable'.! ! - self assert: (aFloat floatsAwayFrom: anotherFloat) abs <= anInteger. - self assert: (anotherFloat floatsAwayFrom: aFloat) abs <= anInteger. - self assert: (aFloat negated floatsAwayFrom: anotherFloat negated) abs <= anInteger. - self assert: (anotherFloat negated floatsAwayFrom: aFloat negated) abs <= anInteger! ! +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 3/27/2019 15:10:58'! +testAsTrueFraction + " + self new testAsTrueFraction + " + | x | + x _ Float pi. + self assert: x asTrueFraction asFloat = x. + x _ 1.0 / 3.0. + self assert: x asTrueFraction asFloat = x. + x _ Float fminNormalized. + self assert: x asTrueFraction asFloat = x. + x _ 0.0 - Float fminNormalized. + self assert: x asTrueFraction asFloat = x. + x _ Float fminDenormalized. + self assert: x asTrueFraction asFloat = x. + x _ 0.0 - Float fminDenormalized. + self assert: x asTrueFraction asFloat = x. + x _ 1.023399999997e-312. + self assert: x asTrueFraction asFloat = x. + x _ Float fmax. + self assert: x asTrueFraction asFloat = x. + x _ 0.0 - Float fmax. + self assert: x asTrueFraction asFloat = x. + x _ 1.0234e308. + self assert: x asTrueFraction asFloat = x.! ! -!AbstractNumberTest methodsFor: 'helpers' stamp: 'jmv 12/18/2018 10:40:29'! -verify: aFloat isWithinOneFloatAwayFrom: anotherFloat +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 12/4/2018 12:06:58'! +testCeiling + self assert: 1.0 ceiling = 1. + self assert: 1.0 successor ceiling = 2. + self assert: 1.0 predecessor ceiling = 1. + self assert: 1.1 ceiling = 2. + self assert: -2.0 ceiling = -2. + self assert: -2.1 ceiling = -2.! ! - self verify: aFloat isWithin: 1 floatsAwayFrom: anotherFloat! ! +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'nice 7/24/2008 02:04'! +testFloatRounded + "5000000000000001 asFloat has an exact representation (no round off error). + It should round to nearest integer without loosing bits. + This is a no regression test on http://bugs.squeak.org/view.php?id=7134" + + | x y int r | + + "This is a preamble asserting exactness of representation + and quality of various conversions" + int := 5000000000000001. + x := int asFloat. + y := (5 asFloat squared squared squared squared timesTwoPower: 15) + 1. + self assert: x = y. + self assert: x asTrueFraction = int. + + "this one should be true for any float + in order to conform to ISO/IEC 10967-2" + self assert: x rounded = x asTrueFraction rounded. + self assert: x negated rounded = x negated asTrueFraction rounded. -!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 2/21/2019 17:38:32'! -testAdd + "a random test" + r := Random new. + 10000 timesRepeat: [ + x := r next * 1.9999e16 + 1.0e12 . + self assert: x rounded = x asTrueFraction rounded. + self assert: x negated rounded = x negated asTrueFraction rounded]! ! - self assert: 1.0 + 1.0 = 2.0. - self assert: Float fminNormalized + Float fminDenormalized > Float fminNormalized. - self assert: Float fminNormalized + Float fminDenormalized - Float fminNormalized = Float fminDenormalized. - self assert: 1.0 + Float zero = 1.0. - self assert: Float zero + 1.0 = 1.0. - self assert: 1.0 + Float negativeZero = 1.0. - self assert: Float negativeZero + 1.0 = 1.0. - self assert: 1.0 + Float infinity = Float infinity. - self assert: Float infinity + 1.0 = Float infinity. - self assert: 1.0 + Float negativeInfinity = Float negativeInfinity. - self assert: Float negativeInfinity + 1.0 = Float negativeInfinity. - self assert: (1.0 + Float nan) isNaN. - self assert: (Float nan + 1.0) isNaN.! ! +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'nice 4/26/2006 05:21'! +testFloatTruncated + "(10 raisedTo: 16) asFloat has an exact representation (no round off error). + It should convert back to integer without loosing bits. + This is a no regression test on http://bugs.impara.de/view.php?id=3504" + + | x y int r | + int := 10 raisedTo: 16. + x := int asFloat. + y := (5 raisedTo: 16) asFloat timesTwoPower: 16. + self assert: x = y. + + self assert: x asInteger = int. + + "this one should be true for any float" + self assert: x asInteger = x asTrueFraction asInteger. -!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 7/2/2019 11:56:44'! -testDivide + "a random test" + r := Random new. + 10000 timesRepeat: [ + x := r next * 1.9999e16 + 1.0e12 . + self assert: x truncated = x asTrueFraction truncated]! ! - self assert: 1.5 / 2.0 = 0.75. +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 12/4/2018 12:07:13'! +testFloor + self assert: 1.0 floor = 1. + self assert: 1.0 successor floor = 1. + self assert: 1.0 predecessor floor = 0. + self assert: 1.1 floor = 1. + self assert: -2.0 floor = -2. + self assert: -2.1 floor = -3.! ! + +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 3/28/2016 09:48'! +testFractionAsFloat + "use a random test" - self assert: 2.0 / 1 = 2.0. + | r m frac err collec | + r := Random new seed: 1234567. + m := (2 raisedTo: 54) - 1. + 200 timesRepeat: [ + frac := ((r nextInteger: m) * (r nextInteger: m) + 1) / ((r nextInteger: m) * (r nextInteger: m) + 1). + err := (frac - frac asFloat asTrueFraction) * frac reciprocal * (1 bitShift: 52). + self assert: err < (1/2)]. - self should: [ 2.0 / 0 ] raise: ZeroDivide. - self assert: 2.0 / 0 isExactly: Float infinity. - self should: [ 2.0 / 0.0 ] raise: ZeroDivide. - self assert: 2.0 / 0.0 isExactly: Float infinity. - self should: [ 1.2 / Float negativeZero ] raise: ZeroDivide. - self assert: 1.2 / Float negativeZero isExactly: Float negativeInfinity. - self should: [ 1.2 / (1.3 - 1.3) ] raise: ZeroDivide. - self assert: 1.2 / (1.3 - 1.3) isExactly: Float infinity. + collec := #(16r10000000000000 16r1FFFFFFFFFFFFF 1 2 16r20000000000000 16r20000000000001 16r3FFFFFFFFFFFFF 16r3FFFFFFFFFFFFE 16r3FFFFFFFFFFFFD). + collec do: [:num | + collec do: [:den | + frac := Fraction numerator: num denominator: den. + err := (frac - frac asFloat asTrueFraction) * frac reciprocal * (1 bitShift: 52). + self assert: err <= (1/2)]].! ! - self assert: 2.0 / 2.0 = 1.0. - self assert: Float fminNormalized / 2.0 * 2.0 = Float fminNormalized. - self assert: Float fminDenormalized * 2.0 / 2.0 = Float fminDenormalized. - self assertIsPositiveZero: Float zero / 1.0. - self assertIsNegativeZero: Float negativeZero / 1.0. - self assertIsPositiveZero: 1.0 / Float infinity. - self assert: Float infinity / 1.0 = Float infinity. - self assertIsNegativeZero: 1.0 / Float negativeInfinity. - self assert: Float negativeInfinity / 1.0 = Float negativeInfinity. - self assert: (1.0 / Float nan) isNaN. - self assert: (Float nan / 1.0) isNaN.! ! +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'nice 1/10/2007 02:29'! +testFractionAsFloat2 + "test rounding to nearest even" + + self assert: ((1<<52)+0+(1/4)) asFloat asTrueFraction = ((1<<52)+0). + self assert: ((1<<52)+0+(1/2)) asFloat asTrueFraction = ((1<<52)+0). + self assert: ((1<<52)+0+(3/4)) asFloat asTrueFraction = ((1<<52)+1). + self assert: ((1<<52)+1+(1/4)) asFloat asTrueFraction = ((1<<52)+1). + self assert: ((1<<52)+1+(1/2)) asFloat asTrueFraction = ((1<<52)+2). + self assert: ((1<<52)+1+(3/4)) asFloat asTrueFraction = ((1<<52)+2).! ! -!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 2/21/2019 17:53:58'! -testMultiply +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 10/10/2018 16:47:20'! +testFractionAsFloatRoundsHalfToEven + "See https://en.wikipedia.org/wiki/Rounding#Round_half_to_even + Test that rounding Fraction to Float picks even mantissa if tie." - self assert: 2.0 * 2.0 = 4.0. - self assert: Float fminNormalized * 2.0 = (Float fminNormalized + Float fminNormalized). - self assert: Float fminDenormalized * 2.0 = (Float fminDenormalized + Float fminDenormalized). - self assertIsPositiveZero: 1.0 * Float zero. - self assertIsPositiveZero: Float zero * 1.0. - self assertIsNegativeZero: 1.0 * Float negativeZero. - self assertIsNegativeZero: Float negativeZero * 1.0. - self assert: 1.0 * Float infinity = Float infinity. - self assert: Float infinity * 1.0 = Float infinity. - self assert: 1.0 * Float negativeInfinity = Float negativeInfinity. - self assert: Float negativeInfinity * 1.0 = Float negativeInfinity. - self assert: (1.0 * Float nan) isNaN. - self assert: (Float nan * 1.0) isNaN.! ! + | floatWithEvenMantissa floatWithEvenMantissa2 floatWithOddMantissa | + floatWithEvenMantissa _ Float maxExactInteger * 1.23. + self assert: floatWithEvenMantissa mantissaPart even description: 'precondition'. -!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 2/21/2019 17:41:52'! -testSubtract + floatWithOddMantissa _ floatWithEvenMantissa successor. + self assert: floatWithOddMantissa mantissaPart even not description: 'precondition'. - self assert: 3.0 - 1.0 = 2.0. - self assert: Float fminNormalized - Float fminDenormalized < Float fminNormalized. - self assert: Float fminNormalized - Float fminDenormalized - Float fminNormalized = Float fminDenormalized negated. - self assert: 1.0 - Float zero = 1.0. - self assert: Float zero - 1.0 = -1.0. - self assert: 1.0 - Float negativeZero = 1.0. - self assert: Float negativeZero - 1.0 = -1.0. - self assert: 1.0 - Float infinity = Float negativeInfinity. - self assert: Float infinity - 1.0 = Float infinity. - self assert: 1.0 - Float negativeInfinity = Float infinity. - self assert: Float negativeInfinity - 1.0 = Float negativeInfinity. - self assert: (1.0 - Float nan) isNaN. - self assert: (Float nan - 1.0) isNaN.! ! + floatWithEvenMantissa2 _ floatWithOddMantissa successor. + self assert: floatWithEvenMantissa2 mantissaPart even description: 'precondition'. -!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 10/15/2019 16:32:51'! -testTimesTwoPowerGradualUnderflow - "Here is a vicious case where timesTwoPower is inexact because it underflows. - And two consecutive inexact operations lead to a different result than a single one. - Typically expressed as multiple of Float fmin in base 2, - 2r1011*Float fmin shifted by -3 with round to nearest, tie to even mode: - -> round(1.011) -> 1.0 = fmin - But if first shifted by -2 then by -1: - -> round(10.11) -> 11.0 = 3*fmin - -> round(1.1) -> 10.0 = 2*fmin - Or first shifted by -1 then by -2: - -> round(101.1) -> 110.0 = 6*fmin - -> round(1.1) -> 10.0 = 2*fmin - A naive implementation that split the shift uncarefully might fail to handle such case correctly." + self assert: ((floatWithEvenMantissa asTrueFraction *4) + (floatWithOddMantissa asTrueFraction *0) / 4) = floatWithEvenMantissa description: 'precondition'. + self assert: ((floatWithEvenMantissa asTrueFraction *3) + (floatWithOddMantissa asTrueFraction *1) / 4) = floatWithEvenMantissa description: 'precondition'. + self assert: ((floatWithEvenMantissa asTrueFraction *100) + (floatWithOddMantissa asTrueFraction *1) / 101) = floatWithEvenMantissa description: 'precondition'. + self assert: ((floatWithEvenMantissa asTrueFraction *1) + (floatWithOddMantissa asTrueFraction *100) / 101) = floatWithOddMantissa description: 'precondition'. + self assert: ((floatWithEvenMantissa asTrueFraction *1) + (floatWithOddMantissa asTrueFraction *3) / 4) = floatWithOddMantissa description: 'precondition'. + self assert: ((floatWithEvenMantissa asTrueFraction *0) + (floatWithOddMantissa asTrueFraction *4) / 4) = floatWithOddMantissa description: 'precondition'. - | f | - f := 2r1011 asFloat. - "scan the whole range of possible exponents for this significand" - Float fmin exponent + f exponent to: Float fmax exponent - f exponent - do: - [ :exp | - | g | - g := f timesTwoPower: exp. - (g timesTwoPower: Float fmin exponent - g exponent) = Float fmin ifFalse: [ exp print ]. - "self assert: (g timesTwoPower: Float fmin exponent - g exponent) = Float fmin" - ] + self assert: ((floatWithEvenMantissa asTrueFraction *2) + (floatWithOddMantissa asTrueFraction *2) / 4) = floatWithEvenMantissa description: 'Must round to closest even mantissa'. -" -testTimesTwoPowerGradualUnderflow -https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/383 -"! ! + self assert: ((floatWithOddMantissa asTrueFraction *4) + (floatWithEvenMantissa2 asTrueFraction *0)/4) = floatWithOddMantissa description: 'precondition'. + self assert: ((floatWithOddMantissa asTrueFraction *3) + (floatWithEvenMantissa2 asTrueFraction *1)/4) = floatWithOddMantissa description: 'precondition'. + self assert: ((floatWithOddMantissa asTrueFraction *100) + (floatWithEvenMantissa2 asTrueFraction *1)/101) = floatWithOddMantissa description: 'precondition'. + self assert: ((floatWithOddMantissa asTrueFraction *1) + (floatWithEvenMantissa2 asTrueFraction *100)/101) = floatWithEvenMantissa2 description: 'precondition'. + self assert: ((floatWithOddMantissa asTrueFraction *1) + (floatWithEvenMantissa2 asTrueFraction *3)/4) = floatWithEvenMantissa2 description: 'precondition'. + self assert: ((floatWithOddMantissa asTrueFraction *0) + (floatWithEvenMantissa2 asTrueFraction *4)/4) = floatWithEvenMantissa2 description: 'precondition'. -!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 3/26/2019 10:59:17'! -testTimesTwoPowerOverflow - self assert: (Float fminNormalized timesTwoPower: Float emax - Float emin) equals: (2.0 raisedTo: Float emax). - self assert: (Float zero timesTwoPower: SmallInteger maxVal) equals: Float zero. - self assert: (Float zero timesTwoPower: SmallInteger maxVal squared) equals: Float zero. - self assert: (1.0 timesTwoPower: SmallInteger maxVal) equals: Float infinity. - self assert: (1.0 timesTwoPower: SmallInteger maxVal squared) equals: Float infinity. - self assert: (-1.0 timesTwoPower: SmallInteger maxVal) equals: Float negativeInfinity. - self assert: (-1.0 timesTwoPower: SmallInteger maxVal squared) equals: Float negativeInfinity.! ! + self assert: ((floatWithOddMantissa asTrueFraction *2) + (floatWithEvenMantissa2 asTrueFraction *2)/4) = floatWithEvenMantissa2 description: 'Must round to closest even mantissa'.! ! -!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 3/26/2019 10:58:50'! -testTimesTwoPowerUnderflow - self assert: ((2.0 raisedTo: Float emax) timesTwoPower: Float emin - Float emax) equals: Float fminNormalized. - self assert: (Float infinity timesTwoPower: SmallInteger minVal * SmallInteger maxVal) equals: Float infinity. - self assertIsPositiveZero: (1.0 timesTwoPower: SmallInteger maxVal negated). - self assertIsPositiveZero: (1.0 timesTwoPower: SmallInteger maxVal squared negated). - self assertIsNegativeZero: (-1.0 timesTwoPower: SmallInteger maxVal negated). - self assertIsNegativeZero: (-1.0 timesTwoPower: SmallInteger maxVal squared negated). +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 10/3/2018 16:22:06'! +testFractionAsFloatWithUnderflow + "test rounding to nearest even" + + | underflowPower | + underflowPower := Float emin - Float precision. + self assertIsPositiveZero: (2 raisedTo: underflowPower) asFloat. + self assertIsNegativeZero: (2 raisedTo: underflowPower) negated asFloat! ! + +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'nice 5/6/2006 22:13'! +testIntegerAsFloat + "assert IEEE 754 round to nearest even mode is honoured" + + self deny: 16r1FFFFFFFFFFFF0801 asFloat = 16r1FFFFFFFFFFFF0800 asFloat. "this test is on 65 bits" + self deny: 16r1FFFFFFFFFFFF0802 asFloat = 16r1FFFFFFFFFFFF0800 asFloat. "this test is on 64 bits" + self assert: 16r1FFFFFFFFFFF1F800 asFloat = 16r1FFFFFFFFFFF20000 asFloat. "nearest even is upper" + self assert: 16r1FFFFFFFFFFFF0800 asFloat = 16r1FFFFFFFFFFFF0000 asFloat. "nearest even is lower" ! ! -!FloatTest methodsFor: 'tests - arithmetic' stamp: 'jmv 7/2/2019 12:03:05'! -testZeroDividedByZero +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 4/24/2019 11:56:51'! +testMixedTypeArithmetic - self assert: (0.0 / 0.0) isNaN. - self assert: (0.0 / -0.0) isNaN. - self assert: (-0.0 / 0.0) isNaN. - self assert: (-0.0 / -0.0) isNaN.! ! + | samples doubleOne | -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:56:51'! -testArCosh - self assert: 1.0 arCosh = 0.0. - self deny: Float infinity arCosh isFinite. - self verify: 2.5 arCosh cosh isHyperbolicallyEqualTo: 2.5! ! + samples := Array with: 1 with: 1 / 3 with: Float pi with: SmallInteger maxVal * 2 + 1 with: SmallInteger minVal * 2 - 1. + doubleOne := 1.0. + samples do: [ :sample | + self assert: sample + doubleOne isExactly: sample asFloat + doubleOne. + self assert: doubleOne + sample isExactly: doubleOne + sample asFloat. + self assert: sample - doubleOne isExactly: sample asFloat - doubleOne. + self assert: doubleOne - sample isExactly: doubleOne - sample asFloat. + self assert: sample * doubleOne isExactly: sample asFloat * doubleOne. + self assert: doubleOne * sample isExactly: doubleOne * sample asFloat. + self assert: sample / doubleOne isExactly: sample asFloat / doubleOne. + self assert: doubleOne / sample isExactly: doubleOne / sample asFloat. + self assert: sample \\ doubleOne isExactly: sample asFloat \\ doubleOne. + self assert: doubleOne \\ sample isExactly: doubleOne \\ sample asFloat. + self assert: (sample // doubleOne) = (sample asFloat // doubleOne). + self assert: (doubleOne // sample) = (doubleOne // sample asFloat). + ].! ! -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 3/26/2019 11:23:12'! -testArSinh - self assertIsPositiveZero: 0.0 arSinh. - self assertIsNegativeZero: Float negativeZero arSinh. - self deny: Float infinity arSinh isFinite. - self verify: 0.5 arSinh negated isHyperbolicallyEqualTo: 0.5 negated arSinh. - self verify: 0.5 arSinh sinh isHyperbolicallyEqualTo: 0.5. - self verify: -2.5 arSinh sinh isHyperbolicallyEqualTo: -2.5! ! +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 4/24/2019 12:01:05'! +testMixedTypeComparison -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:57:47'! -testArTanh - self assertIsPositiveZero: 0.0 arTanh. - self assertIsNegativeZero: Float negativeZero arTanh. - self deny: 1 arTanh isFinite. - self verify: 0.5 arTanh negated isHyperbolicallyEqualTo: 0.5 negated arTanh. - self verify: 0.5 arTanh tanh isHyperbolicallyEqualTo: 0.5. - self verify: -0.5 arTanh tanh isHyperbolicallyEqualTo: -0.5! ! + | samples doubleOne | -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/18/2018 10:52:08'! -testArcTan + samples := Array with: 1 with: 1 / 3 with: Float pi with: SmallInteger maxVal * 2 + 1 with: SmallInteger minVal * 2 - 1. + doubleOne := 1.0. + samples do: [ :sample | + self assert: (sample = doubleOne) = (sample asFloat = doubleOne). + self assert: (doubleOne = sample) = (doubleOne = sample asFloat). + self assert: (sample ~= doubleOne) = (sample asFloat ~= doubleOne). + self assert: (doubleOne ~= sample) = (doubleOne ~= sample asFloat). + self assert: (sample < doubleOne) = (sample asFloat < doubleOne). + self assert: (doubleOne < sample) = (doubleOne < sample asFloat). + self assert: (sample <= doubleOne) = (sample asFloat <= doubleOne). + self assert: (doubleOne <= sample) = (doubleOne <= sample asFloat). + self assert: (sample > doubleOne) = (sample asFloat > doubleOne). + self assert: (doubleOne > sample) = (doubleOne > sample asFloat). + self assert: (sample >= doubleOne) = (sample asFloat >= doubleOne). + self assert: (doubleOne >= sample) = (doubleOne >= sample asFloat). + ].! ! - self verify: (100 arcTan: 100) isTrigonometricallyEqualTo: Float pi / 4. - self verify: (-100 arcTan: 100) isTrigonometricallyEqualTo: Float pi / -4. - self verify: (100 arcTan: -100) isTrigonometricallyEqualTo: Float pi * 3 / 4. - self verify: (-100 arcTan: -100) isTrigonometricallyEqualTo: Float pi * -3 / 4. - self verify: (0 arcTan: 100) isTrigonometricallyEqualTo: 0. - self verify: (0 arcTan: -100) isTrigonometricallyEqualTo: Float pi. - self verify: (100 arcTan: 0) isTrigonometricallyEqualTo: Float pi / 2. - self verify: (-100 arcTan: 0) isTrigonometricallyEqualTo: Float pi / -2. - - self verify: (Float negativeZero arcTan: 100) isTrigonometricallyEqualTo: 0. - self verify: (Float negativeZero arcTan: -100) isTrigonometricallyEqualTo: Float pi * -1. - - self assert: (0 arcTan: 0) = 0. - self assert: (Float negativeZero arcTan: 0) = 0. - self verify: (0 arcTan: Float negativeZero) isTrigonometricallyEqualTo: Float pi. - self verify: (Float negativeZero arcTan: Float negativeZero) isTrigonometricallyEqualTo: Float pi negated.! ! +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 10/29/2021 11:12:28'! +testRoundHalfAwayFromZero + "See https://en.wikipedia.org/wiki/Rounding#Round_half_away_from_zero" + self assert: 0.5 roundedHAFZ = 1. + self assert: 1.5 roundedHAFZ = 2. + self assert: -0.5 roundedHAFZ = -1. + self assert: -1.5 roundedHAFZ = -2. + self assert: (((0.0 to: 5.0 by: 0.25) collect: [ :f | f roundedHAFZ ]) = #(0 0 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5) ). + self assert: (((-0.0 to: -5.0 by: -0.25) collect: [ :f | f roundedHAFZ ]) = #(0 0 -1 -1 -1 -1 -2 -2 -2 -2 -3 -3 -3 -3 -4 -4 -4 -4 -5 -5 -5) )! ! -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 11/27/2018 13:11:53'! -testArcTanNonPrimitive +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 10/9/2018 16:12:35'! +testRoundHalfToEven + "See https://en.wikipedia.org/wiki/Rounding#Round_half_to_even" + self assert: 0.5 rounded = 0. + self assert: 1.5 rounded = 2. + self assert: -0.5 rounded = -0. + self assert: -1.5 rounded = -2. + self assert: (((0.0 to: 5.0 by: 0.25) collect: [ :f | f rounded ]) = #(0 0 0 1 1 1 2 2 2 2 2 3 3 3 4 4 4 4 4 5 5) ). + self assert: (((-0.0 to: -5.0 by: -0.25) collect: [ :f | f rounded ]) = #(0 0 0 -1 -1 -1 -2 -2 -2 -2 -2 -3 -3 -3 -4 -4 -4 -4 -4 -5 -5) )! ! - #[0.0 0.01 0.1 0.3 0.5 0.7 0.8 1.0 2.0 5.0 20.0] do: [ :x | | computed | - computed _ x arcTanNonPrimitive. - self assert: (computed tan -x ) abs <= (computed predecessor tan -x ) abs. - self assert: (computed tan -x ) abs <= (computed successor tan -x ) abs. - ]! ! +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'nice 6/3/2011 21:37'! +testRounded + self assert: 0.9 rounded = 1. + self assert: 1.0 rounded = 1. + self assert: 1.1 rounded = 1. + self assert: -1.9 rounded = -2. + self assert: -2.0 rounded = -2. + self assert: -2.1 rounded = -2. + + "In case of tie, round to upper magnitude" + self assert: 1.5 rounded = 2. + self assert: -1.5 rounded = -2.! ! -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:48:21'! -testCos +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 10/10/2018 16:53:57'! +testStringAsFloatRoundsHalfToEven + "See https://en.wikipedia.org/wiki/Rounding#Round_half_to_even + Test that rounding Fraction to Float picks even mantissa if tie." - self verify: 0.0 cos isTrigonometricallyEqualTo: 1.0. - self verify: (Float pi / 3) cos isTrigonometricallyEqualTo: 1.0 sqrt / 2.0. - self verify: (Float pi / 4) cos isTrigonometricallyEqualTo: 2.0 sqrt / 2.0. - self verify: (Float pi / 6) cos isTrigonometricallyEqualTo: 3.0 sqrt / 2.0. - self verify: (Float pi / 2) cos isTrigonometricallyEqualTo: 0.0! ! + | floatWithEvenMantissa floatWithEvenMantissa2 floatWithOddMantissa halfway1 halfway2 | + floatWithEvenMantissa _ Float maxExactInteger * 1.23. + self assert: floatWithEvenMantissa mantissaPart even description: 'precondition'. -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:58:14'! -testCosh - self verify: 0.0 cosh isHyperbolicallyEqualTo: 1.0. - self verify: 2.0 cosh squared - 2.0 sinh squared isHyperbolicallyEqualTo: 1.0. - self verify: 2.0 cosh isHyperbolicallyEqualTo: 2.0 negated cosh. - self deny: Float infinity cosh isFinite ! ! + floatWithOddMantissa _ floatWithEvenMantissa successor. + self assert: floatWithOddMantissa mantissaPart even not description: 'precondition'. -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/18/2018 16:27:57'! -testDegreeCos - "Following tests use approximate equality, because cosine are generally evaluated using inexact Floating point arithmetic" - self verify: 45 degreeCos squared isDegreeTrigonometricallyEqualTo: 0.5. - self verify: 45.0 degreeCos squared isDegreeTrigonometricallyEqualTo: 0.5. - self verify: 60 degreeCos isDegreeTrigonometricallyEqualTo: 0.5. - self verify: 60.0 degreeCos isDegreeTrigonometricallyEqualTo: 0.5. - self verify: 120 degreeCos isDegreeTrigonometricallyEqualTo: -0.5. - self verify: 120.0 degreeCos isDegreeTrigonometricallyEqualTo: -0.5. - -360 to: 360 by: 1/3 do: - [:step | - | expected actual | - expected := step degreesToRadians cos. - actual := step degreeCos. - expected = actual ifFalse: [self assert: (expected - actual) exponent <= self effectiveZeroExponentForTrigonometry]. - expected := step asFloat degreesToRadians cos. - actual := step asFloat degreeCos. - expected = actual ifFalse: [self assert: (expected - actual) exponent <= self effectiveZeroExponentForTrigonometry] - ]. + floatWithEvenMantissa2 _ floatWithOddMantissa successor. + self assert: floatWithEvenMantissa2 mantissaPart even description: 'precondition'. - "Following tests use strict equality which is a requested property of degreeCos" - -10.0 to: 10.0 do: [:k | - self assert: (k*360 + 90) degreeCos = 0. - self assert: (k*360 - 90) degreeCos = 0. - self assert: (k*360 + 180) degreeCos + 1 = 0. - self assert: (k*360) degreeCos - 1 = 0.].! ! + halfway1 _ floatWithEvenMantissa asTrueFraction + floatWithOddMantissa asTrueFraction / 2. + self assert: halfway1 = floatWithEvenMantissa description: 'precondition-Must round to closest even mantissa'. + self assert: halfway1 printString = '11078855083331421' description: 'precondition'. + self assert: '11078855083331421.0' asNumber = floatWithEvenMantissa description: 'when converting string to Float, if tie, round to closest even mantissa'. -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'nice 5/3/2014 22:30:50.872'! -testDegreeCosForExceptionalValues - self assert: Float nan degreeCos isNaN. - self assert: Float infinity degreeCos isNaN. - self assert: Float negativeInfinity degreeCos isNaN.! ! + halfway2 _ floatWithOddMantissa asTrueFraction + floatWithEvenMantissa2 asTrueFraction / 2. + self assert: halfway2 = floatWithEvenMantissa2 description: 'precondition-Must round to closest even mantissa'. + self assert: halfway2 printString = '11078855083331423' description: 'precondition'. + self assert: '11078855083331423.0' asNumber = floatWithEvenMantissa2 description: 'when converting string to Float, if tie, round to closest even mantissa'.! ! -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/18/2018 16:28:02'! -testDegreeSin - "Following tests use approximate equality, because sine are generally evaluated using inexact Floating point arithmetic" - self verify: 45 degreeSin squared isDegreeTrigonometricallyEqualTo: 0.5. - self verify: 45.0 degreeSin squared isDegreeTrigonometricallyEqualTo: 0.5. - self verify: 30 degreeSin isDegreeTrigonometricallyEqualTo: 0.5. - self verify: 30.0 degreeSin isDegreeTrigonometricallyEqualTo: 0.5. - self verify: -30 degreeSin isDegreeTrigonometricallyEqualTo: -0.5. - self verify: -30.0 degreeSin isDegreeTrigonometricallyEqualTo: -0.5. - -360 to: 360 by: 1/3 do: - [:step | - | expected actual | - expected := step degreesToRadians sin. - actual := step degreeSin. - expected = actual ifFalse: [self assert: (expected - actual) exponent <= self effectiveZeroExponentForTrigonometry]. - expected := step asFloat degreesToRadians sin. - actual := step asFloat degreeSin. - expected = actual ifFalse: [self assert: (expected - actual) exponent <= self effectiveZeroExponentForTrigonometry]. - ]. +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 10/10/2018 17:17:33'! +testStringAsFloatRoundsHalfToEven2 + "See https://en.wikipedia.org/wiki/Rounding#Round_half_to_even + Test that rounding Fraction to Float picks even mantissa if tie." - "Following tests use strict equality which is a requested property of degreeSin" - -10.0 to: 10.0 do: [:k | - self assert: (k*360 + 90) degreeSin - 1 = 0. - self assert: (k*360 - 90) degreeSin + 1= 0. - self assert: (k*360 + 180) degreeSin = 0. - self assert: (k*360) degreeSin = 0.].! ! + | evenMantissa oddMantissa scaledEven scaledOdd evenMantissa2 scaledEven2 | + evenMantissa _ 1.0. + self assert: evenMantissa mantissaPart even description: 'precondition'. + oddMantissa _ 1.0 successor. + self assert: oddMantissa mantissaPart even not description: 'precondition'. + evenMantissa2 _ oddMantissa successor. + self assert: evenMantissa2 mantissaPart even description: 'precondition'. -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'nice 5/3/2014 22:30:55.613'! -testDegreeSinForExceptionalValues - self assert: Float nan degreeSin isNaN. - self assert: Float infinity degreeSin isNaN. - self assert: Float negativeInfinity degreeSin isNaN.! ! + scaledEven _ evenMantissa asTrueFraction * 1e53. + scaledOdd _ oddMantissa asTrueFraction * 1e53. + scaledEven2 _ evenMantissa2 asTrueFraction * 1e53. -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 11/27/2018 13:15:27'! -testExp - self assert: 0.0 exp = 1.0. - self assert: 1.0 exp = Float e. - self assert: 2.0 exp sqrt = Float e! ! + self assert: (scaledEven + scaledOdd / 2) printString = '100000000000000011102230246251565404236316680908203125' description: 'precondition'. + self assert: '1.00000000000000011102230246251565404236316680908203124999' asNumber = evenMantissa description: 'precondition'. + self assert: '1.00000000000000011102230246251565404236316680908203125001' asNumber = oddMantissa description: 'precondition'. + self assert: '1.00000000000000011102230246251565404236316680908203125' asNumber = evenMantissa description: 'when converting string to Float, if tie, round to closest even mantissa'. -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 11/27/2018 13:28:53'! -testExpNonPrimitive + self assert: (scaledEven2 + scaledOdd / 2) printString = '100000000000000033306690738754696212708950042724609375' description: 'precondition'. + self assert: '1.00000000000000033306690738754696212708950042724609374999' asNumber = oddMantissa description: 'precondition'. + self assert: '1.00000000000000033306690738754696212708950042724609375001' asNumber = evenMantissa2 description: 'precondition'. + self assert: '1.00000000000000033306690738754696212708950042724609375' asNumber = evenMantissa2 description: 'when converting string to Float, if tie, round to closest even mantissa'.! ! - #[0.0 0.01 0.1 0.3 0.5 0.7 0.8 1.0 2.0 5.0 ] do: [ :x | | computed expected | - computed _ x expNonPrimitive. - expected _ x exp. - self assert: (computed - expected) abs <= (expected ulp*2) - ]! ! +!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 12/4/2018 12:06:36'! +testTruncated + self assert: 1.0 truncated = 1. + self assert: 1.0 successor truncated = 1. + self assert: 1.0 predecessor truncated = 0. + self assert: 1.1 truncated = 1. + self assert: -2.0 truncated = -2. + self assert: -2.1 truncated = -2.! ! -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/12/2018 14:38:16'! -testFloorLog2 - "Float internal representation of Float being in base 2, we expect (aFloat floorLog: 2) to be exact." - - | aBitLess aBitMore | - aBitMore := 1.0 successor. - aBitLess := 1.0 predecessor. - Float emin + 1 to: Float emax - 1 do: [:exp | - | exactPowerOfTwo | - exactPowerOfTwo := 1.0 timesTwoPower: exp. - self assert: exp equals: (exactPowerOfTwo floorLog: 2). - self assert: exp equals: (exactPowerOfTwo * aBitMore floorLog: 2). - self assert: exp-1 equals: (exactPowerOfTwo * aBitLess floorLog: 2) ].! ! +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/21/2018 11:36:52'! +testExactAsString + "Ensures round-trip string conversion when using #asString. + Use some relevant examples." -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 11/27/2018 13:33:48'! -testLn - self assert: 0.0 exp ln = 0.0. - self assert: 1.0 exp ln = 1.0. - self assert: 2.0 exp ln = 2.0.! ! + | examples | + examples _ { + 1.0. + Float fminNormalized / 2. + Float fminNormalized / 10. + Float fminNormalized / 13. + 2.0. + 2 sqrt. + Float pi. + Float fminDenormalized. + Float fminDenormalized * 2. + Float fminDenormalized * 3. + Float fminDenormalized * 13 }, + { + Float zero. + Float negativeZero. + Float negativeInfinity. + Float infinity. + Float fmax predecessor }. -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/14/2018 23:53:24'! -testLnForExceptionalValues + examples do: [ :float | + self assert: float predecessor asString asNumber = float predecessor. + self assert: float asString asNumber = float. + self assert: float successor asString asNumber = float successor ]. - self assert: -1.0 ln isNaN. - self assert: Float infinity ln = Float infinity. - self assert: Float negativeInfinity ln isNaN! ! + "NaN are special, in that they are not even equal to themselves" + self assert: Float nan asString asNumber isNaN! ! -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/11/2018 13:39:49'! -testLnNonPrimitive +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/21/2018 14:56:27'! +testExactAsString2 + "Ensures round-trip string conversion when using #asString. + Use some relevant examples. + Note: there is no guarantee to restore the bit pattern of NaN though" - #[0.0 0.01 0.1 0.3 0.5 0.7 0.8 1.01 2.01 5.0 ] do: [ :x | | computed expected | - computed _ x exp lnNonPrimitive. - expected _ x exp ln. - self assert: (computed - expected) abs <= (expected ulp*2) - ]! ! + self assert: Float halfPi asString asNumber = Float halfPi. + self assert: Float halfPi negated asString asNumber = Float halfPi negated. + self assert: Float pi asString asNumber = Float pi. + self assert: Float pi negated asString asNumber = Float pi negated. + self assert: 2.0 sqrt asString asNumber = 2.0 sqrt. + self assert: 2.0 sqrt negated asString asNumber = 2.0 sqrt negated. + self assert: Float infinity asString asNumber = Float infinity. + self assert: Float negativeInfinity asString asNumber = Float negativeInfinity. + self assert: Float nan asString asNumber isNaN.! ! -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 7/2/2019 11:55:02'! -testReciprocal +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 9/24/2018 10:51:07'! +testExactStoreString + "Tests that conversion to / from Strings is exact (same Float is re-created) when using #storeString + (whose output is meant to be compilable smalltalk code). + Use some relevant examples." - self - assert: 1.0 reciprocal = 1.0; - assert: 2.0 reciprocal = 0.5; - assert: -1.0 reciprocal = -1.0; - assert: -2.0 reciprocal = -0.5. - - self should: [ 0.0 reciprocal ] raise: ZeroDivide. - self assert: 0.0 reciprocal isExactly: Float infinity! ! + | examples | + examples _ { + 1.0. + Float fminNormalized / 2. + Float fminNormalized / 10. + Float fminNormalized / 13. + 2.0. + 2 sqrt. + Float pi. + Float fminDenormalized. + Float fminDenormalized * 2. + Float fminDenormalized * 3. + Float fminDenormalized * 13 }, + { + Float zero. + Float negativeZero. + Float negativeInfinity. + Float infinity }. -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:47:34'! -testSin + examples do: [ :float | + self assert: (Compiler evaluate: float predecessor storeString) = float predecessor. + self assert: (Compiler evaluate: float storeString) = float. + self assert: (Compiler evaluate: float successor storeString) = float successor ]. - self verify: 0.0 sin isTrigonometricallyEqualTo: 0.0. - self verify: (Float pi / 6) sin isTrigonometricallyEqualTo: 1.0 sqrt / 2.0. - self verify: (Float pi / 4) sin isTrigonometricallyEqualTo: 2.0 sqrt / 2.0. - self verify: (Float pi / 3) sin isTrigonometricallyEqualTo: 3.0 sqrt / 2.0. - self verify: (Float pi / 2) sin isTrigonometricallyEqualTo: 1.0! ! + "NaN are special, in that they are not even equal to themselves" + self assert: (Compiler evaluate: Float nan storeString) isNaN! ! -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/11/2018 13:41:55'! -testSinNonPrimitive - self assert: 0.0 sinNonPrimitive = 0.0. - self assert: (45 degreesToRadians sinNonPrimitive - 0.5 sqrt) abs <= (0.5 ulp * 2). - self assert: (90 degreesToRadians sinNonPrimitive - 1.0) abs <= (1.0 ulp * 2).! ! +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/4/2018 12:09:53'! +testExactStoreString2 + "If storeOn: prints exactly and the parser avoids cumulating rounding errors, + then the Float should be read back exactly. + Note: there is no guarantee to restore the bit pattern of NaN though" + + self assert: (Compiler evaluate: Float halfPi storeString) = Float halfPi. + self assert: (Compiler evaluate: Float halfPi negated storeString) = Float halfPi negated. + self assert: (Compiler evaluate: Float infinity storeString) = Float infinity. + self assert: (Compiler evaluate: Float negativeInfinity storeString) = Float negativeInfinity. + self assert: (Compiler evaluate: Float nan storeString) isNaN.! ! -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:58:36'! -testSinh - self assertIsPositiveZero: 0.0 sinh. - self assertIsNegativeZero: Float negativeZero sinh. - self deny: Float infinity sinh isFinite. - self verify: 2.0 cosh squared - 2.0 sinh squared isHyperbolicallyEqualTo: 1.0. - self verify: 2.0 sinh negated isHyperbolicallyEqualTo: 2.0 negated sinh! ! +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/21/2018 11:40:15'! +testFromStringDoesNotUnderflow + self assert: '12345678901234567890.0e-330' asNumber isZero not. + self assert: (Compiler evaluate: '12345678901234567890.0e-330')isZero not.! ! -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 3/26/2019 16:00:43'! -testSqrt - self assert: Float nan sqrt isNaN. - self assert: Float infinity sqrt = Float infinity. - self assertIsPositiveZero: Float zero sqrt. - self assertIsNegativeZero: Float negativeZero sqrt. - self assert: Float fminNormalized sqrt squared = Float fminNormalized . - self assert: Float fminDenormalized sqrt squared = Float fminDenormalized .! ! +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/21/2018 11:44:33'! +testMinimalAsString + "Tests that the conversion from String / to String ends in a minimal String representation. + This means that there are no extra unneded digits at the end. + For example, 0.1 (actually the closest Float to 1/10, i.e. ((1/10) asFloat), prints as 0.1, because + it can be recovered from that String" -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 11/27/2018 11:03:49'! -testSqrtNonPrimitive - self assert: Float nan sqrtNonPrimitive isNaN. - self assert: Float infinity sqrtNonPrimitive = Float infinity. - self assertIsPositiveZero: Float zero sqrtNonPrimitive. - self assertIsNegativeZero: Float negativeZero sqrtNonPrimitive. - - self assert: 1.0 sqrt = 1.0 sqrtNonPrimitive. - self assert: 2.0 sqrt = 2.0 sqrtNonPrimitive. - self assert: 4.0 sqrt = 4.0 sqrtNonPrimitive. - self assert: 8.0 sqrt = 8.0 sqrtNonPrimitive. - self assert: 9.0 sqrt = 9.0 sqrtNonPrimitive.! ! + "These are just to start on solid ground. If these fail, what follows is meaningless." + self assert: 0.1 = ((1/10) asFloat). "0.1 really is what it should be. Compiler works ok." + self assert: '0.1' asNumber = 0.1. "#asNumber works ok. The string '0.1' is what we want." + "Now the real test." + self assert: 0.1 printString = '0.1'. "String '0.1' is what we get. No unneded extra digits." -!FloatTest methodsFor: 'tests - mathematical functions' stamp: 'sqr 12/15/2018 00:58:54'! -testTanh - self assertIsPositiveZero: 0.0 tanh. - self assertIsNegativeZero: Float negativeZero tanh. - self assert: Float infinity tanh = 1.0. - self verify: 2.0 cosh squared - 2.0 sinh squared isHyperbolicallyEqualTo: 1.0. - self verify: 2.0 tanh negated isHyperbolicallyEqualTo: 2.0 negated tanh! ! + "Whatever Float these Strings represent, print them back the same (no extra digits)" + self assert: '0.2' asNumber printString = '0.2'. + #( + '0.1' '0.2' '0.3' '0.4' '0.5' '0.6' '0.7' '0.8' '0.9' + '1.0' '1.1' '1.2' '1.3' '1.4' '1.5' '1.6' '1.7' '1.8' '1.9' '2.0' + '1.01' '1.001' '1.0001' '1.00001' '1.000001' '1.0000001' '1.00000001' '1.000000001' '1.0000000001' '1.00000000001' '1.000000000001' + '1.03' '1.003' '1.0003' '1.00003' '1.000003' '1.0000003' '1.00000003' '1.000000003' '1.0000000003' '1.00000000003' '1.000000000003' + ) do: [ :string | + self assert: string asNumber printString = string ].! ! -!FloatTest methodsFor: 'tests - comparing' stamp: 'nice 7/10/2009 22:27'! -testComparisonWhenPrimitiveFails - "This is related to http://bugs.squeak.org/view.php?id=7361" +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/21/2018 12:15:04'! +testPrintShowingDecimalPlaces4 + | requiredDigits | + requiredDigits _ Float pi printString size - 2. + self assert: (Float pi printStringFractionDigits: requiredDigits) = Float pi printString. + 0 to: 100 do: [ :extra | + self assert: (Float pi printStringFractionDigits: requiredDigits + extra) asNumber = Float pi ]! ! - self deny: 0.5 < (1/4). - self deny: 0.5 < (1/2). - self assert: 0.5 < (3/4). - - self deny: 0.5 <= (1/4). - self assert: 0.5 <= (1/2). - self assert: 0.5 <= (3/4). - - self assert: 0.5 > (1/4). - self deny: 0.5 > (1/2). - self deny: 0.5 > (3/4). - - self assert: 0.5 >= (1/4). - self assert: 0.5 >= (1/2). - self deny: 0.5 >= (3/4). - - self deny: 0.5 = (1/4). - self assert: 0.5 = (1/2). - self deny: 0.5 = (3/4). +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/27/2018 16:50:31'! +testPrintStringStress + | eWidth mWidth ePrimeScale mPrimeScale | + eWidth _ Float emax - Float emin. + "211 for a more exhaustive but slower test. 41 for a quick run." + ePrimeScale _ 211. + ePrimeScale _ 41. + mWidth _ 1 bitShift: Float precision. + "9931 for a more exhaustive but slower test. 37 for a quick run." + mPrimeScale _ 9931. + mPrimeScale _ 37. + 0 + to: mWidth - 1 * mPrimeScale + by: mWidth + do: [ :mScaled | | m eAdjustment | + m _ mScaled // mPrimeScale. + eAdjustment _ m highBit - 1. + {mScaled. m. m hex. eAdjustment } print. + Float emin * ePrimeScale + to: Float emax * ePrimeScale + by: eWidth + do: [ :eFraction | | e fp | + e _ eFraction // ePrimeScale - eAdjustment. + fp _ m asFloat timesTwoPower: e. + self assert: fp printString asNumber = fp. + self assert: fp negated printString asNumber = fp negated ]]! ! + +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'nice 3/14/2008 23:59'! +testReadFromManyDigits + "A naive algorithm may interpret these representations as Infinity or NaN. + This is http://bugs.squeak.org/view.php?id=6982" - self assert: 0.5 ~= (1/4). - self deny: 0.5 ~= (1/2). - self assert: 0.5 ~= (3/4).! ! + | s1 s2 | + s1 := '1' , (String new: 321 withAll: $0) , '.0e-321'. + s2 := '0.' , (String new: 320 withAll: $0) , '1e321'. + self assert: (Number readFrom: s1) = 1. + self assert: (Number readFrom: s2) = 1.! ! -!FloatTest methodsFor: 'tests - comparing' stamp: 'jmv 10/8/2018 16:20:48'! -testComparisonWithFraction - self assert: 0.5 = (1/2). - self assert: (1/2) = 0.5. - self assert: 0.1 = (1/10). - self assert: (1/10) = 0.1! ! +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 10/19/2018 16:33:22'! +testSomeNines + | twelveNines | + twelveNines _ Compiler evaluate: '999999 + 0.999999'. + self assert: twelveNines printString = '999999.999999'. + self assert: twelveNines printString asNumber = twelveNines. + self assert: twelveNines printString asNumber - twelveNines = 0.0. + self assert: twelveNines + 1e-6 = 1e6! ! -!FloatTest methodsFor: 'tests - comparing' stamp: 'jmv 8/29/2019 16:20:39'! -testEqualityComparison - "In Cuis, it was decided to coerce operands to Float for comparison (if any of them was float), - in the classic ST-80 way" - | a b c | - - "Test equality when Float conversion exact" - self assert: 16r1FFFFFFFFFFFFF = 16r1FFFFFFFFFFFFF asFloat. - self assert: 16r1FFFFFFFFFFFFF = 16r1FFFFFFFFFFFFF asFloat asInteger. +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'nice 10/11/2008 21:45'! +testStoreBase16 + "This bug was reported in mantis http://bugs.squeak.org/view.php?id=6695" + + self + assert: (20.0 storeStringBase: 16) = '16r14.0' + description: 'the radix prefix should not be omitted, except in base 10'! ! + +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/4/2018 12:09:57'! +testStoreOn + "If storeOn: prints exactly and the parser avoids cumulating rounding errors, + then the Float should be read back exactly. + Note: there is no guarantee to restore the bit pattern of NaN though" - self assert: (((1 bitShift: 54)+1)/(1 bitShift: 54)) > 1. - self assert: (((1 bitShift: 54)+1)/(1 bitShift: 54)) = 1.0. "Coerce to Float" - - self assert: (((1 bitShift: 54)-1)/(1 bitShift: 54)) < 1. - self assert: (((1 bitShift: 54)-1)/(1 bitShift: 54)) = 1.0. "Coerce to Float" - - "Test exact vs inexact arithmetic" - (1 to: 100) do: [:i | - self assert: (1/i) = (1/i asFloat)]. - - "Test overflow (compare to infinity)" - a := (11 raisedTo: 400) / 2. - b := (13 raisedTo: 400) / 2. - c := a asFloat. - self assert: ((a = c) & (b = c)). "Coerce to Float" - self deny: (a = b). - - "every integer is smaller than infinity" - self assert: a = Float infinity. "Coerce to Float" - self assert: a > Float infinity negated. - - "Test underflow" - self deny: 1 / (11 raisedTo: 400) = 0. - self assert: 1 / (11 raisedTo: 400) = 0.0. "Coerce to Float" - - "Test hash code" - self assert: - ((Set new: 3) add: 3; add: 3.0; size) = - ((Set new: 4) add: 3; add: 3.0; size). + self assert: (Compiler evaluate: Float halfPi storeString) = Float halfPi. + self assert: (Compiler evaluate: Float halfPi negated storeString) = Float halfPi negated. + self assert: (Compiler evaluate: Float infinity storeString) = Float infinity. + self assert: (Compiler evaluate: Float negativeInfinity storeString) = Float negativeInfinity. + self assert: (Compiler evaluate: Float nan storeString) isNaN.! ! +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'dtl 9/18/2004 12:40'! +testStringAsNumber + "This covers parsing in Number>>readFrom:" - self assert: 9007199254740996 = 9007199254740996.0. - self assert: 9007199254740996001 / 1000 = 9007199254740996.0. - self assert: 90071992547409963 / 10 = 9007199254740996.0. - self assert: 90071992547409967 / 10 = 9007199254740996.0. - self assert: 9007199254740995 = 9007199254740996.0. - self deny: 9007199254740995 = 9007199254740994.0. + | aFloat | + aFloat := '10r-12.3456' asNumber. + self assert: -12.3456 = aFloat. + aFloat := '10r-12.3456e2' asNumber. + self assert: -1234.56 = aFloat. + aFloat := '10r-12.3456d2' asNumber. + self assert: -1234.56 = aFloat. + aFloat := '10r-12.3456q2' asNumber. + self assert: -1234.56 = aFloat. + aFloat := '-12.3456q2' asNumber. + self assert: -1234.56 = aFloat. + aFloat := '12.3456q2' asNumber. + self assert: 1234.56 = aFloat. +! ! - self assert: 9007199254740996.0 = 9007199254740996. - self assert: 9007199254740996.0 = (9007199254740996001 / 1000). - self assert: 9007199254740996.0 = (90071992547409963 / 10). - self assert: 9007199254740996.0 = (90071992547409967 / 10). - self assert: 9007199254740996.0 = 9007199254740995. - self deny: 9007199254740994.0 = 9007199254740995.! ! +!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/12/2018 14:44:07'! +testStringAsNumber2 + "Check that small but normal Floats can be created from Strings" -!FloatTest methodsFor: 'tests - comparing' stamp: 'jmv 12/4/2018 12:05:21'! -testEquals - self assert: 1.0 = 1.0. - self deny: 1.0 = 2.0. - self assert: 0.0 = 0.0. - self deny: 0.0 = 1.0. - self deny: 1.0 = 0.0. - self assert: 1.0 = 1. - self deny: 1.0 = 2. - self assert: Float zero = Float negativeZero. - self assert: Float negativeZero = Float zero. - self assert: Float fmax = Float fmax. - self assert: Float fminNormalized = Float fminNormalized. - self assert: Float fminDenormalized = Float fminDenormalized. - self deny: Float fmax = Float fminNormalized. - self deny: Float fminNormalized = Float fmax. - self deny: Float fminDenormalized = Float fminNormalized. - self deny: Float fminNormalized = Float fminDenormalized.! ! + | aFloat | + aFloat _ '12345678901234567890.0e-326' asNumber. + self deny: aFloat = 0.0. + self assert: aFloat > 0.0. + self assert: aFloat - 1.2345678901234568e-307 = 0. + self assert: aFloat = 1.2345678901234568e-307.! ! -!FloatTest methodsFor: 'tests - comparing' stamp: 'sqr 12/14/2018 23:02:34'! -testFloatsAwayFrom +!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 14:02:56'! +testHashWithBigNegativeSmallInteger + "Not in the Float range" + | a float smallInteger | + smallInteger _ SmallInteger minVal+1. + self deny: smallInteger isLarge description: 'precondition'. + float _ smallInteger asFloat. + self assert: smallInteger = float description: 'precondition'. + self assert: float = smallInteger description: 'precondition'. + a _ Set new. + a add: smallInteger; add: float. + self assert: a size = 1! ! - self verify: 1.0 is: 0 floatsAwayFrom: 1.0. - self verify: 1.0 is: -1 floatsAwayFrom: 1.0 successor. - self verify: 1.0 is: 1 floatsAwayFrom: 1.0 predecessor. - self verify: 0.0 is: 0 floatsAwayFrom: Float negativeZero. - self verify: Float infinity is: 1 floatsAwayFrom: Float fmax. - self verify: Float fmax is: -1 floatsAwayFrom: Float infinity. - self verify: Float negativeInfinity is: -1 floatsAwayFrom: Float fmax negated. - self verify: Float fmax negated is: 1 floatsAwayFrom: Float negativeInfinity. - self verify: 0.0 is: -1 floatsAwayFrom: Float fminDenormalized. - self verify: Float negativeZero is: -1 floatsAwayFrom: Float fminDenormalized. - self verify: Float fmax is: (1 bitShift: Float precision - 1) - 1 floatsAwayFrom: (1.0 timesTwoPower: Float emax)! ! +!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 14:01:27'! +testHashWithBigSmallInteger + "Not in the Float range" + | a float smallInteger | + smallInteger _ SmallInteger maxVal. + self deny: smallInteger isLarge description: 'precondition'. + float _ smallInteger asFloat. + self assert: smallInteger = float description: 'precondition'. + self assert: float = smallInteger description: 'precondition'. + a _ Set new. + a add: smallInteger; add: float. + self assert: a size = 1! ! -!FloatTest methodsFor: 'tests - comparing' stamp: 'sqr 12/14/2018 23:02:43'! -testFloatsAwayFromWithPowersOfTwo +!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 10:43:35'! +testHashWithFraction - | previous current soMany | - previous := 0.0. - current := Float fminDenormalized. - soMany := 1. - [current isFinite] whileTrue: - [ - self verify: current is: soMany floatsAwayFrom: previous. - soMany < 4503599627370496 :: and: [previous > 0.0] :: ifTrue: [soMany := soMany * 2]. - previous := current. - current := current * 2.0 - ]! ! + | a float fraction | + fraction _ 1/3. + float _ (1/3) asFloat. + self assert: fraction = float description: 'precondition'. + self assert: float = fraction description: 'precondition'. + a _ Set new. + a add: fraction; add: float. + self assert: a size = 1! ! -!FloatTest methodsFor: 'tests - comparing' stamp: 'jmv 10/8/2018 16:18:13'! -testHugeValues +!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 10:51:32'! +testHashWithLargeNegativeInteger + "Not in the Float range" + | a float largeInteger | + largeInteger _ -1e400. + self assert: largeInteger isLarge description: 'precondition'. + float _ largeInteger asFloat. + self assert: largeInteger = float description: 'precondition'. + self assert: float = largeInteger description: 'precondition'. + a _ Set new. + a add: largeInteger; add: float. + self assert: a size = 1! ! - self assert: 1e400 = Float infinity. - self deny: 1e400 < Float infinity. - self deny: 1e400 > Float infinity. +!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 10:51:37'! +testHashWithLargePositiveInteger + "Not in the Float range" + | a float largeInteger | + largeInteger _ 1e400. + self assert: largeInteger isLarge description: 'precondition'. + float _ largeInteger asFloat. + self assert: largeInteger = float description: 'precondition'. + self assert: float = largeInteger description: 'precondition'. + a _ Set new. + a add: largeInteger; add: float. + self assert: a size = 1! ! - self assert: 1e400 = 1.0e309. - self assert: 1e400 > 1.0e308. +!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 10:51:40'! +testHashWithSmallishLargeNegativeInteger + "In the Float range" + | a float largeInteger | + largeInteger _ SmallInteger minVal -1. + self assert: largeInteger isLarge description: 'precondition'. + float _ largeInteger asFloat. + self assert: largeInteger = float description: 'precondition'. + self assert: float = largeInteger description: 'precondition'. + a _ Set new. + a add: largeInteger; add: float. + self assert: a size = 1! ! +!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/10/2018 15:40:00'! +testHashWithSmallishLargeNegativeInteger2 + "In the Float range" + | a float integer | + integer _ Float maxExactInteger negated -1. + float _ integer asFloat. + self assert: integer = float description: 'precondition'. + self assert: float = integer description: 'precondition'. + a _ Set new. + a add: integer; add: float. + self assert: a size = 1! ! - self assert: -1e400 = Float negativeInfinity. - self deny: -1e400 < Float negativeInfinity. - self deny: -1e400 > Float negativeInfinity. +!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 10:51:44'! +testHashWithSmallishLargePositiveInteger + "In the Float range" + | a float largeInteger | + largeInteger _ SmallInteger maxVal +1. + self assert: largeInteger isLarge description: 'precondition'. + float _ largeInteger asFloat. + self assert: largeInteger = float description: 'precondition'. + self assert: float = largeInteger description: 'precondition'. + a _ Set new. + a add: largeInteger; add: float. + self assert: a size = 1! ! - self assert: -1e400 = -1.0e309. - self assert: -1e400 < -1.0e308.! ! +!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/10/2018 15:40:11'! +testHashWithSmallishLargePositiveInteger2 + "In the Float range" + | a float integer | + integer _ Float maxExactInteger +1. + float _ integer asFloat. + self assert: integer = float description: 'precondition'. + self assert: float = integer description: 'precondition'. + a _ Set new. + a add: integer; add: float. + self assert: a size = 1! ! -!FloatTest methodsFor: 'tests - comparing' stamp: 'nice 10/27/2014 21:50'! -testLiteralEqualityOfNan - | nan | - nan := Float nan. - self assert: (nan literalEqual: nan) - description: 'Float nan is not equal to itself, though it is literally equal'.! ! +!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/10/2018 15:57:54'! +testNoIntegerHash -!FloatTest methodsFor: 'tests - comparing' stamp: 'jmv 10/3/2018 16:29:31'! -testLiteralEqualityOfZeroAndNegativeZero - self assert: Float zero = Float negativeZero. - self deny: (Float zero literalEqual: Float negativeZero). - self - assert: (Compiler evaluate: '1>2 ifTrue: [0.0] ifFalse: [-0.0]') hex = Float negativeZero hex - description: 'Float zero and negativeZero are not literally substituable'.! ! + self deny: Float pi hash = 3 hash. + self deny: Float pi hash = (Float pi *1.00000000000001) hash. + self deny: Float pi hash = (Float pi /1.00000000000001) hash.! ! -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 3/27/2019 15:10:58'! -testAsTrueFraction - " - self new testAsTrueFraction - " - | x | - x _ Float pi. - self assert: x asTrueFraction asFloat = x. - x _ 1.0 / 3.0. - self assert: x asTrueFraction asFloat = x. - x _ Float fminNormalized. - self assert: x asTrueFraction asFloat = x. - x _ 0.0 - Float fminNormalized. - self assert: x asTrueFraction asFloat = x. - x _ Float fminDenormalized. - self assert: x asTrueFraction asFloat = x. - x _ 0.0 - Float fminDenormalized. - self assert: x asTrueFraction asFloat = x. - x _ 1.023399999997e-312. - self assert: x asTrueFraction asFloat = x. - x _ Float fmax. - self assert: x asTrueFraction asFloat = x. - x _ 0.0 - Float fmax. - self assert: x asTrueFraction asFloat = x. - x _ 1.0234e308. - self assert: x asTrueFraction asFloat = x.! ! +!FloatTest methodsFor: 'tests - hash' stamp: 'nice 2/13/2010 04:15'! +testSetOfFloat + "Classical disagreement between hash and = did lead to a bug. + This is a non regression test from http://bugs.squeak.org/view.php?id=3360" -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 12/4/2018 12:06:58'! -testCeiling - self assert: 1.0 ceiling = 1. - self assert: 1.0 successor ceiling = 2. - self assert: 1.0 predecessor ceiling = 1. - self assert: 1.1 ceiling = 2. - self assert: -2.0 ceiling = -2. - self assert: -2.1 ceiling = -2.! ! + | size3 size4 | + size3 := (Set new: 3) add: 3; add: 3.0; size. + size4 := (Set new: 4) add: 3; add: 3.0; size. + self assert: size3 = size4 description: 'The size of a Set should not depend on its capacity.'! ! -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'nice 7/24/2008 02:04'! -testFloatRounded - "5000000000000001 asFloat has an exact representation (no round off error). - It should round to nearest integer without loosing bits. - This is a no regression test on http://bugs.squeak.org/view.php?id=7134" +!FloatTest methodsFor: 'tests - constants' stamp: 'jmv 12/27/2018 18:37:19'! +testE + "Just in case..." + + self assert: Float e = 2.718281828459045. + self assert: Float e ln = 1.0. + self assert: Float e = 1.0 exp. + self assert: Float e hex = '4005BF0A8B145769'.! ! + +!FloatTest methodsFor: 'tests - constants' stamp: 'jmv 10/11/2011 08:55'! +testMaxExactInteger + " + FloatTest new testMaxExactInteger + " + + self assert: Float maxExactInteger asFloat truncated = Float maxExactInteger. + 0 to: 10000 do: [ :j | + self assert: (Float maxExactInteger-j) asFloat truncated = (Float maxExactInteger-j) ]. + self deny: (Float maxExactInteger+1) asFloat truncated = (Float maxExactInteger+1) + ! ! + +!FloatTest methodsFor: 'tests - constants' stamp: 'jmv 12/27/2018 18:39:24'! +testPi + "Just in case..." + + self assert: Float pi = 3.141592653589793. + self assert: Float pi = (1.0 arcTan * 4). + self assert: Float pi hex = '400921FB54442D18' ! ! + +!FloatTest methodsFor: 'tests - precision and extreme values' stamp: 'jmv 4/5/2019 16:23:22'! +testCharacterization + + "Test the largest finite representable floating point value" + self assert: Float fmax successor = Float infinity. + self assert: Float infinity predecessor = Float fmax. + self assert: Float fmax negated predecessor = Float infinity negated. + self assert: Float infinity negated successor = Float fmax negated. - | x y int r | + "Test the smallest positive representable floating point value" + self assertIsPositiveZero: Float fmin predecessor. + self assert: 0.0 successor = Float fmin. + self assert: Float fmin negated successor hex = -0.0 hex. + self assert: -0.0 predecessor = Float fmin negated. - "This is a preamble asserting exactness of representation - and quality of various conversions" - int := 5000000000000001. - x := int asFloat. - y := (5 asFloat squared squared squared squared timesTwoPower: 15) + 1. - self assert: x = y. - self assert: x asTrueFraction = int. + "Test the relative precision" + self assert: Float one + Float epsilon > Float one. + self assert: Float one + Float epsilon = Float one successor. + self assert: Float one + (Float epsilon / Float radix) = Float one. - "this one should be true for any float - in order to conform to ISO/IEC 10967-2" - self assert: x rounded = x asTrueFraction rounded. - self assert: x negated rounded = x negated asTrueFraction rounded. - - "a random test" - r := Random new. - 10000 timesRepeat: [ - x := r next * 1.9999e16 + 1.0e12 . - self assert: x rounded = x asTrueFraction rounded. - self assert: x negated rounded = x negated asTrueFraction rounded]! ! - -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'nice 4/26/2006 05:21'! -testFloatTruncated - "(10 raisedTo: 16) asFloat has an exact representation (no round off error). - It should convert back to integer without loosing bits. - This is a no regression test on http://bugs.impara.de/view.php?id=3504" + "Test maximum and minimum exponent" + self assert: Float fmax exponent = Float emax. + self assert: Float fminNormalized exponent = Float emin. + Float denormalized ifTrue: [ + self assert: Float fminDenormalized exponent = (Float emin + 1 - Float precision)]. - | x y int r | - int := 10 raisedTo: 16. - x := int asFloat. - y := (5 raisedTo: 16) asFloat timesTwoPower: 16. - self assert: x = y. + "Alternative tests for maximum and minimum exponents and normalized and denormal values" + self assert: (Float radix raisedTo: Float emax) * (Float radix - (Float epsilon)) = Float fmax. + self assert: (Float radix raisedTo: Float emin) = Float fminNormalized. + self assert: (Float radix raisedTo: Float emin) * Float epsilon = Float fmin. - self assert: x asInteger = int. + "Test sucessors and predecessors" + self assert: Float one predecessor successor = Float one. + self assert: Float one successor predecessor = Float one. + self assert: Float one negated predecessor successor = Float one negated. + self assert: Float one negated successor predecessor = Float one negated. + self assert: Float infinity successor = Float infinity. + self assert: Float negativeInfinity predecessor = Float negativeInfinity. + self assertIsNegativeZero: Float fmin negated successor. + self assertIsPositiveZero: Float fmin predecessor. + self assert: Float nan predecessor isNaN. + self assert: Float nan successor isNaN. - "this one should be true for any float" - self assert: x asInteger = x asTrueFraction asInteger. - - "a random test" - r := Random new. - 10000 timesRepeat: [ - x := r next * 1.9999e16 + 1.0e12 . - self assert: x truncated = x asTrueFraction truncated]! ! + "SPECIFIC FOR IEEE 754 double precision - 64 bits" + self assert: Float fmax hex = '7FEFFFFFFFFFFFFF'. + self assert: Float fminDenormalized hex = '0000000000000001'. + self assert: Float fminNormalized hex = '0010000000000000'. + self assert: 0.0 hex = '0000000000000000'. + self assert: Float negativeZero hex = '8000000000000000'. + self assert: Float one hex = '3FF0000000000000'. + self assert: Float infinity hex = '7FF0000000000000'. + self assert: Float negativeInfinity hex = 'FFF0000000000000'.! ! -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 12/4/2018 12:07:13'! -testFloor - self assert: 1.0 floor = 1. - self assert: 1.0 successor floor = 1. - self assert: 1.0 predecessor floor = 0. - self assert: 1.1 floor = 1. - self assert: -2.0 floor = -2. - self assert: -2.1 floor = -3.! ! +!FloatTest methodsFor: 'tests - precision and extreme values' stamp: 'jmv 12/4/2018 15:20:59'! +testNextAwayFromZero -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 3/28/2016 09:48'! -testFractionAsFloat - "use a random test" - - | r m frac err collec | - r := Random new seed: 1234567. - m := (2 raisedTo: 54) - 1. - 200 timesRepeat: [ - frac := ((r nextInteger: m) * (r nextInteger: m) + 1) / ((r nextInteger: m) * (r nextInteger: m) + 1). - err := (frac - frac asFloat asTrueFraction) * frac reciprocal * (1 bitShift: 52). - self assert: err < (1/2)]. - - collec := #(16r10000000000000 16r1FFFFFFFFFFFFF 1 2 16r20000000000000 16r20000000000001 16r3FFFFFFFFFFFFF 16r3FFFFFFFFFFFFE 16r3FFFFFFFFFFFFD). - collec do: [:num | - collec do: [:den | - frac := Fraction numerator: num denominator: den. - err := (frac - frac asFloat asTrueFraction) * frac reciprocal * (1 bitShift: 52). - self assert: err <= (1/2)]].! ! + self assert: Float pi nextAwayFromZero = Float pi successor. + self assert: Float pi negated nextAwayFromZero = Float pi negated predecessor. + self assert: 1.0 nextAwayFromZero = 1.0 successor. + self should: [Float infinity nextAwayFromZero] raise: Error. + self assert: Float infinity predecessor nextAwayFromZero = Float infinity. + self assert: Float infinity predecessor predecessor nextAwayFromZero = Float infinity predecessor. + self should: [Float negativeInfinity nextAwayFromZero] raise: Error. + self assert: Float negativeInfinity successor nextAwayFromZero = Float negativeInfinity. + self assert: Float negativeInfinity successor successor nextAwayFromZero = Float negativeInfinity successor. + self assert: 0.0 nextAwayFromZero = Float fminDenormalized. + self assert: -0.0 nextAwayFromZero = Float fminDenormalized negated.! ! -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'nice 1/10/2007 02:29'! -testFractionAsFloat2 - "test rounding to nearest even" - - self assert: ((1<<52)+0+(1/4)) asFloat asTrueFraction = ((1<<52)+0). - self assert: ((1<<52)+0+(1/2)) asFloat asTrueFraction = ((1<<52)+0). - self assert: ((1<<52)+0+(3/4)) asFloat asTrueFraction = ((1<<52)+1). - self assert: ((1<<52)+1+(1/4)) asFloat asTrueFraction = ((1<<52)+1). - self assert: ((1<<52)+1+(1/2)) asFloat asTrueFraction = ((1<<52)+2). - self assert: ((1<<52)+1+(3/4)) asFloat asTrueFraction = ((1<<52)+2).! ! +!FloatTest methodsFor: 'tests - precision and extreme values' stamp: 'jmv 12/4/2018 15:16:45'! +testNextTowardsZero -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 10/10/2018 16:47:20'! -testFractionAsFloatRoundsHalfToEven - "See https://en.wikipedia.org/wiki/Rounding#Round_half_to_even - Test that rounding Fraction to Float picks even mantissa if tie." + self assert: Float pi nextTowardsZero = Float pi predecessor. + self assert: Float pi negated nextTowardsZero = Float pi negated successor. + self assert: 1.0 nextTowardsZero = 1.0 predecessor. + self should: [Float infinity nextTowardsZero] raise: Error. + self assert: Float infinity predecessor nextTowardsZero = Float infinity predecessor predecessor. + self should: [Float negativeInfinity nextTowardsZero] raise: Error. + self assert: Float negativeInfinity successor nextTowardsZero = Float negativeInfinity successor successor. + self should: [0.0 nextTowardsZero] raise: Error. + self assert: 0.0 successor nextTowardsZero = 0.0. + self should: [-0.0 nextTowardsZero] raise: Error. + self assert: -0.0 predecessor nextTowardsZero = -0.0! ! - | floatWithEvenMantissa floatWithEvenMantissa2 floatWithOddMantissa | - floatWithEvenMantissa _ Float maxExactInteger * 1.23. - self assert: floatWithEvenMantissa mantissaPart even description: 'precondition'. +!FloatTest methodsFor: 'tests - precision and extreme values' stamp: 'jmv 4/5/2019 16:26:34'! +testPredecessorSuccessor + self assert: 0.0 successor = Float fminDenormalized. + self assertIsNegativeZero: 0.0 predecessor. + self assertIsPositiveZero: -0.0 successor. + self assert: -0.0 predecessor = Float fminDenormalized negated. + self assert: 1.0 successor > 1.0. + self assert: 1.0 successor predecessor = 1.0. + self assert: 1.0 predecessor < 1.0. + self assert: 1.0 predecessor successor = 1.0. + self assert: -1.0 successor > -1.0. + self assert: -1.0 successor predecessor = -1.0. + self assert: -1.0 predecessor < -1.0. + self assert: -1.0 predecessor successor = -1.0.! ! - floatWithOddMantissa _ floatWithEvenMantissa successor. - self assert: floatWithOddMantissa mantissaPart even not description: 'precondition'. +!FloatTest methodsFor: 'tests - precision and extreme values' stamp: 'jmv 12/4/2018 17:10:45'! +testPredecessorSuccessor2 + | mustBeOneOfThem | + mustBeOneOfThem _ Float fminNormalized + Float fminNormalized successor / 2. + self assert: (mustBeOneOfThem = Float fminNormalized or: [ + mustBeOneOfThem = Float fminNormalized successor ]). + mustBeOneOfThem _ 1.0 + 1.0 successor / 2. + self assert: (mustBeOneOfThem = 1.0 or: [ + mustBeOneOfThem = 1.0 successor ]). + mustBeOneOfThem _ 1.0 + 1.0 predecessor / 2. + self assert: (mustBeOneOfThem = 1.0 or: [ + mustBeOneOfThem = 1.0 successor ]).! ! - floatWithEvenMantissa2 _ floatWithOddMantissa successor. - self assert: floatWithEvenMantissa2 mantissaPart even description: 'precondition'. +!FloatTest methodsFor: 'tests - precision and extreme values' stamp: 'jmv 12/12/2018 14:27:52'! +testUlp - self assert: ((floatWithEvenMantissa asTrueFraction *4) + (floatWithOddMantissa asTrueFraction *0) / 4) = floatWithEvenMantissa description: 'precondition'. - self assert: ((floatWithEvenMantissa asTrueFraction *3) + (floatWithOddMantissa asTrueFraction *1) / 4) = floatWithEvenMantissa description: 'precondition'. - self assert: ((floatWithEvenMantissa asTrueFraction *100) + (floatWithOddMantissa asTrueFraction *1) / 101) = floatWithEvenMantissa description: 'precondition'. - self assert: ((floatWithEvenMantissa asTrueFraction *1) + (floatWithOddMantissa asTrueFraction *100) / 101) = floatWithOddMantissa description: 'precondition'. - self assert: ((floatWithEvenMantissa asTrueFraction *1) + (floatWithOddMantissa asTrueFraction *3) / 4) = floatWithOddMantissa description: 'precondition'. - self assert: ((floatWithEvenMantissa asTrueFraction *0) + (floatWithOddMantissa asTrueFraction *4) / 4) = floatWithOddMantissa description: 'precondition'. - - self assert: ((floatWithEvenMantissa asTrueFraction *2) + (floatWithOddMantissa asTrueFraction *2) / 4) = floatWithEvenMantissa description: 'Must round to closest even mantissa'. + {1.0 predecessor. 1.0 successor. Float pi predecessor. Float pi. Float pi successor} do: + [:f | + self assert: (f * 2) ulp = (f ulp * 2). + self assert: (f / 2) ulp = (f ulp / 2). + self deny: f + f ulp = f. + self deny: f - f ulp = f. + "Tests below are valid as long as default rounding mode (to nearest even) is used" + self assert: f significandAsInteger odd not | (f ulp / 2.0 + f = f successor). + self assert: f significandAsInteger even not | (f ulp / 2.0 + f = f)]. + + self assert: 1.0 ulp = 0.9 ulp. + self deny: 1.0 ulp = 1.1 ulp. + + self assert: 0.0 ulp = Float fmin. + self assert: 1.01 ulp = Float epsilon. + self assert: Float nan ulp isNaN. + self assert: Float infinity ulp = Float infinity. + self assert: Float negativeInfinity ulp = Float infinity. - self assert: ((floatWithOddMantissa asTrueFraction *4) + (floatWithEvenMantissa2 asTrueFraction *0)/4) = floatWithOddMantissa description: 'precondition'. - self assert: ((floatWithOddMantissa asTrueFraction *3) + (floatWithEvenMantissa2 asTrueFraction *1)/4) = floatWithOddMantissa description: 'precondition'. - self assert: ((floatWithOddMantissa asTrueFraction *100) + (floatWithEvenMantissa2 asTrueFraction *1)/101) = floatWithOddMantissa description: 'precondition'. - self assert: ((floatWithOddMantissa asTrueFraction *1) + (floatWithEvenMantissa2 asTrueFraction *100)/101) = floatWithEvenMantissa2 description: 'precondition'. - self assert: ((floatWithOddMantissa asTrueFraction *1) + (floatWithEvenMantissa2 asTrueFraction *3)/4) = floatWithEvenMantissa2 description: 'precondition'. - self assert: ((floatWithOddMantissa asTrueFraction *0) + (floatWithEvenMantissa2 asTrueFraction *4)/4) = floatWithEvenMantissa2 description: 'precondition'. + self assert: ((0 to: Float precision - 1) allSatisfy: [:each | (Float fmin timesTwoPower: each) ulp = Float fmin]). ! ! - self assert: ((floatWithOddMantissa asTrueFraction *2) + (floatWithEvenMantissa2 asTrueFraction *2)/4) = floatWithEvenMantissa2 description: 'Must round to closest even mantissa'.! ! +!FloatTest methodsFor: 'tests - accessing parts' stamp: 'jmv 4/5/2019 16:25:12'! +testCopy + "Elementary tests" + self assert: 2.0 copy = 2.0. + self assert: -0.5 copy = -0.5. + + "Are exceptional Floats preserved by the copy ?" + self assert: Float nan copy isNaN. + self assert: Float infinity copy = Float infinity. + self assert: Float infinity negated copy = Float infinity negated. + + "Is the sign of zero preserved by the copy ?" + self assertIsPositiveZero: 0.0 copy. + self assertIsNegativeZero: Float negativeZero copy.! ! -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 10/3/2018 16:22:06'! -testFractionAsFloatWithUnderflow - "test rounding to nearest even" +!FloatTest methodsFor: 'tests - accessing parts' stamp: 'jmv 4/5/2019 19:51:34'! +testIsDenormalized + self deny: Float pi isDenormalized. + self deny: 0.0 isDenormalized. + self assert: 0.0 successor isDenormalized. + self assert: Float fmin isDenormalized. + self assert: Float fminNormalized predecessor isDenormalized. + self deny: Float fminNormalized isDenormalized. + self deny: Float pi negated isDenormalized. + self deny: -0.0 isDenormalized. + self assert: -0.0 predecessor isDenormalized. + self assert: Float fmin negated isDenormalized. + self assert: Float fminNormalized negated successor isDenormalized. + self deny: Float fminNormalized negated isDenormalized.! ! - | underflowPower | - underflowPower := Float emin - Float precision. - self assertIsPositiveZero: (2 raisedTo: underflowPower) asFloat. - self assertIsNegativeZero: (2 raisedTo: underflowPower) negated asFloat! ! +!FloatTest methodsFor: 'tests - accessing parts' stamp: 'jmv 12/4/2018 14:10:06'! +testPartBits + | denormals exceptionals normals | + + normals := {Float pi. Float pi * 100.0. Float pi/ -100.0. Float fmax. Float fminNormalized}. + denormals := {0.0. Float negativeZero. Float fminNormalized predecessor. Float fmin negated}. + exceptionals := {Float nan. Float infinity. Float negativeInfinity.}. + + normals , denormals , exceptionals do: [ :aFloat | + self assert: + (Float + signBit: aFloat signBit + mantissaBits: aFloat mantissaBits + exponentBits: aFloat exponentBits) hex + = aFloat hex ]! ! -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'nice 5/6/2006 22:13'! -testIntegerAsFloat - "assert IEEE 754 round to nearest even mode is honoured" +!FloatTest methodsFor: 'tests - accessing parts' stamp: 'nice 5/3/2014 22:31:57.837'! +testSignificandAndExponent + | denormals exceptionals normals | - self deny: 16r1FFFFFFFFFFFF0801 asFloat = 16r1FFFFFFFFFFFF0800 asFloat. "this test is on 65 bits" - self deny: 16r1FFFFFFFFFFFF0802 asFloat = 16r1FFFFFFFFFFFF0800 asFloat. "this test is on 64 bits" - self assert: 16r1FFFFFFFFFFF1F800 asFloat = 16r1FFFFFFFFFFF20000 asFloat. "nearest even is upper" - self assert: 16r1FFFFFFFFFFFF0800 asFloat = 16r1FFFFFFFFFFFF0000 asFloat. "nearest even is lower" -! ! + normals := {Float pi. Float pi * 100.0. Float pi/ -100.0. Float fmax. Float fminNormalized}. + denormals := {0.0. Float negativeZero. Float fminNormalized predecessor. Float fmin negated}. + exceptionals := {Float nan. Float infinity. Float negativeInfinity.}. + + normals, denormals, exceptionals do: [ :aFloat | + "Any Float can be decomposed into its significand and exponent, and the significand holds the sign" + aFloat isNaN + ifTrue: [self assert: (aFloat significand timesTwoPower: aFloat exponent) isNaN] + ifFalse: [self + assert: (aFloat significand timesTwoPower: aFloat exponent) + equals: aFloat]]. + + normals , denormals do: [:aFloat | + "The significand magnitude is in interval [1.0, 2.0) " + aFloat = 0.0 + ifTrue: [self assert: aFloat significand equals: 0] + ifFalse: [self + assert: aFloat significand abs >= 1.0; + assert: aFloat significand abs < 2.0]]! ! -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 4/24/2019 11:56:51'! -testMixedTypeArithmetic +!FloatTest methodsFor: 'tests - accessing parts' stamp: 'jmv 10/3/2018 17:41:49'! +testSignificandAsInteger + | mantissaBits denormalPowersOfTwo denormals exceptionals normalPowersOfTwo normals | + "There are 52 bits used for representing the mantissa (plus an eventual leading 1, see below)" + mantissaBits := Float precision - 1. + + normals := {Float pi. Float pi * 100.0. Float pi/ -100.0. Float fmax. Float fminNormalized}. + denormals := {0.0. Float negativeZero. Float fminNormalized predecessor. Float fmin negated}. + exceptionals := {Float nan. Float infinity. Float negativeInfinity.}. + normalPowersOfTwo := (-10 to: 10) collect: [:i | 1.0 timesTwoPower: i]. + denormalPowersOfTwo := (Float emin - mantissaBits to: Float emin - 1) collect: [:i | 1.0 timesTwoPower: i]. + + normals do: [:aNormalFloat | + "Assume the mantissa is written in least 52 bits of hex format, with an implied 1 on position 53" + self + assert: (((Integer readFrom: aNormalFloat hex readStream base: 16) bitAnd: 1< 0 +].! ! -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 4/24/2019 12:01:05'! -testMixedTypeComparison +!FloatTest methodsFor: 'tests - zero behavior' stamp: 'nice 1/27/2017 22:01'! +testCopySign + self assert: (0.0 copySignTo: 1) = 1. + self assert: (Float negativeZero copySignTo: 1) = -1. + self assertIsNegativeZero: (-1 copySignTo: 0.0). + self assertIsPositiveZero: (1 copySignTo: Float negativeZero).! ! - | samples doubleOne | +!FloatTest methodsFor: 'tests - zero behavior' stamp: 'jmv 4/4/2019 14:27:15'! +testIsZero + self assert: 0.0 isZero. + self assert: -0.0 isZero. + self deny: 0.1 isZero.! ! - samples := Array with: 1 with: 1 / 3 with: Float pi with: SmallInteger maxVal * 2 + 1 with: SmallInteger minVal * 2 - 1. - doubleOne := 1.0. - samples do: [ :sample | - self assert: (sample = doubleOne) = (sample asFloat = doubleOne). - self assert: (doubleOne = sample) = (doubleOne = sample asFloat). - self assert: (sample ~= doubleOne) = (sample asFloat ~= doubleOne). - self assert: (doubleOne ~= sample) = (doubleOne ~= sample asFloat). - self assert: (sample < doubleOne) = (sample asFloat < doubleOne). - self assert: (doubleOne < sample) = (doubleOne < sample asFloat). - self assert: (sample <= doubleOne) = (sample asFloat <= doubleOne). - self assert: (doubleOne <= sample) = (doubleOne <= sample asFloat). - self assert: (sample > doubleOne) = (sample asFloat > doubleOne). - self assert: (doubleOne > sample) = (doubleOne > sample asFloat). - self assert: (sample >= doubleOne) = (sample asFloat >= doubleOne). - self assert: (doubleOne >= sample) = (doubleOne >= sample asFloat). - ].! ! +!FloatTest methodsFor: 'tests - zero behavior' stamp: 'jmv 4/5/2019 08:27:21'! +testPositiveAndNegativeZero + self assert: Float negativeZero = Float zero description: 'Positive and negative zero are defined to be equal'. + self deny: -0.0 < 0.0 description: 'Positive and negative zero are defined to be equal'. + self deny: -0.0 > 0.0 description: 'Positive and negative zero are defined to be equal'. + self deny: Float negativeZero hex = Float zero hex description: 'Positive and negative zero are not the same!!'. + + self assertIsPositiveZero: 1.0 * 0.0. + self assertIsNegativeZero: 1.0 * -0.0. + self assertIsNegativeZero: -1.0 * 0.0. + self assertIsPositiveZero: -1.0 * -0.0. -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 10/29/2021 11:12:28'! -testRoundHalfAwayFromZero - "See https://en.wikipedia.org/wiki/Rounding#Round_half_away_from_zero" - self assert: 0.5 roundedHAFZ = 1. - self assert: 1.5 roundedHAFZ = 2. - self assert: -0.5 roundedHAFZ = -1. - self assert: -1.5 roundedHAFZ = -2. - self assert: (((0.0 to: 5.0 by: 0.25) collect: [ :f | f roundedHAFZ ]) = #(0 0 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5) ). - self assert: (((-0.0 to: -5.0 by: -0.25) collect: [ :f | f roundedHAFZ ]) = #(0 0 -1 -1 -1 -1 -2 -2 -2 -2 -3 -3 -3 -3 -4 -4 -4 -4 -5 -5 -5) )! ! + self assertIsPositiveZero: Float fmin / 4.0. + self assertIsNegativeZero: Float fmin / -4.0. + self assertIsNegativeZero: Float fmin negated / 4.0. + self assertIsPositiveZero: Float fmin negated / -4.0.! ! -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 10/9/2018 16:12:35'! -testRoundHalfToEven - "See https://en.wikipedia.org/wiki/Rounding#Round_half_to_even" - self assert: 0.5 rounded = 0. - self assert: 1.5 rounded = 2. - self assert: -0.5 rounded = -0. - self assert: -1.5 rounded = -2. - self assert: (((0.0 to: 5.0 by: 0.25) collect: [ :f | f rounded ]) = #(0 0 0 1 1 1 2 2 2 2 2 3 3 3 4 4 4 4 4 5 5) ). - self assert: (((-0.0 to: -5.0 by: -0.25) collect: [ :f | f rounded ]) = #(0 0 0 -1 -1 -1 -2 -2 -2 -2 -2 -3 -3 -3 -4 -4 -4 -4 -4 -5 -5) )! ! +!FloatTest methodsFor: 'tests - zero behavior' stamp: 'jmv 4/4/2019 14:32:48'! +testZeroAbs + self assertIsPositiveZero: Float zero abs. 'the absolute value of a positive zero is zero'. + self assertIsPositiveZero: Float negativeZero abs. 'the absolute value of a negative zero is zero'.! ! -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'nice 6/3/2011 21:37'! -testRounded - self assert: 0.9 rounded = 1. - self assert: 1.0 rounded = 1. - self assert: 1.1 rounded = 1. - self assert: -1.9 rounded = -2. - self assert: -2.0 rounded = -2. - self assert: -2.1 rounded = -2. - - "In case of tie, round to upper magnitude" - self assert: 1.5 rounded = 2. - self assert: -1.5 rounded = -2.! ! +!FloatTest methodsFor: 'tests - zero behavior' stamp: 'jmv 7/2/2019 11:52:32'! +testZeroRaisedToNegativePower + "this is a test related to http://bugs.squeak.org/view.php?id=6781" -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 10/10/2018 16:53:57'! -testStringAsFloatRoundsHalfToEven - "See https://en.wikipedia.org/wiki/Rounding#Round_half_to_even - Test that rounding Fraction to Float picks even mantissa if tie." + self should: [0.0 raisedToInteger: -1] raise: ZeroDivide. + self assert: (0.0 raisedToInteger: -1) isExactly: Float infinity. + self should: [0.0 raisedTo: -1] raise: ZeroDivide. + self assert: (0.0 raisedTo: -1) isExactly: Float infinity. + self should: [0.0 raisedTo: -1.0] raise: ZeroDivide. + self assert: (0.0 raisedTo: -1.0) isExactly: Float infinity. - | floatWithEvenMantissa floatWithEvenMantissa2 floatWithOddMantissa halfway1 halfway2 | - floatWithEvenMantissa _ Float maxExactInteger * 1.23. - self assert: floatWithEvenMantissa mantissaPart even description: 'precondition'. + self should: [-0.0 raisedToInteger: -1] raise: ZeroDivide. + self assert: (-0.0 raisedToInteger: -1) isExactly: Float negativeInfinity. + self should: [-0.0 raisedTo: -1] raise: ZeroDivide. + self assert: (-0.0 raisedTo: -1) isExactly: Float negativeInfinity. + self should: [-0.0 raisedTo: -1.0] raise: ZeroDivide. + self assert: (-0.0 raisedTo: -1.0) isExactly: Float negativeInfinity.! ! - floatWithOddMantissa _ floatWithEvenMantissa successor. - self assert: floatWithOddMantissa mantissaPart even not description: 'precondition'. +!FloatTest methodsFor: 'tests - zero behavior' stamp: 'jmv 4/4/2019 14:28:40'! +testZeroSign + self assert: Float zero sign = 0. + self assert: Float negativeZero sign = -1 description: 'negative zero is a zero with non zero sign!!'! ! - floatWithEvenMantissa2 _ floatWithOddMantissa successor. - self assert: floatWithEvenMantissa2 mantissaPart even description: 'precondition'. +!FloatTest methodsFor: 'tests - zero behavior' stamp: 'jmv 4/4/2019 14:33:40'! +testZeroSignificandAsInteger + "This is about http://bugs.squeak.org/view.php?id=6990" - halfway1 _ floatWithEvenMantissa asTrueFraction + floatWithOddMantissa asTrueFraction / 2. - self assert: halfway1 = floatWithEvenMantissa description: 'precondition-Must round to closest even mantissa'. - self assert: halfway1 printString = '11078855083331421' description: 'precondition'. - self assert: '11078855083331421.0' asNumber = floatWithEvenMantissa description: 'when converting string to Float, if tie, round to closest even mantissa'. + self assert: 0.0 significandAsInteger = 0. + self assert: -0.0 significandAsInteger = 0! ! - halfway2 _ floatWithOddMantissa asTrueFraction + floatWithEvenMantissa2 asTrueFraction / 2. - self assert: halfway2 = floatWithEvenMantissa2 description: 'precondition-Must round to closest even mantissa'. - self assert: halfway2 printString = '11078855083331423' description: 'precondition'. - self assert: '11078855083331423.0' asNumber = floatWithEvenMantissa2 description: 'when converting string to Float, if tie, round to closest even mantissa'.! ! +!FloatTest methodsFor: 'tests - infinity behavior' stamp: 'sd 6/5/2005 08:30'! +testInfinity1 + "FloatTest new testInfinity1" -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 10/10/2018 17:17:33'! -testStringAsFloatRoundsHalfToEven2 - "See https://en.wikipedia.org/wiki/Rounding#Round_half_to_even - Test that rounding Fraction to Float picks even mantissa if tie." + | i1 i2 | - | evenMantissa oddMantissa scaledEven scaledOdd evenMantissa2 scaledEven2 | - evenMantissa _ 1.0. - self assert: evenMantissa mantissaPart even description: 'precondition'. - oddMantissa _ 1.0 successor. - self assert: oddMantissa mantissaPart even not description: 'precondition'. - evenMantissa2 _ oddMantissa successor. - self assert: evenMantissa2 mantissaPart even description: 'precondition'. + i1 := 10000 exp. + i2 := 1000000000 exp. + self assert: i1 isInfinite & i2 isInfinite & (i1 = i2). + "All infinities are equal. (This is a very substantial difference to NaN's, which are never equal." +! ! - scaledEven _ evenMantissa asTrueFraction * 1e53. - scaledOdd _ oddMantissa asTrueFraction * 1e53. - scaledEven2 _ evenMantissa2 asTrueFraction * 1e53. +!FloatTest methodsFor: 'tests - infinity behavior' stamp: 'sd 6/5/2005 08:30'! +testInfinity2 + "FloatTest new testInfinity2" - self assert: (scaledEven + scaledOdd / 2) printString = '100000000000000011102230246251565404236316680908203125' description: 'precondition'. - self assert: '1.00000000000000011102230246251565404236316680908203124999' asNumber = evenMantissa description: 'precondition'. - self assert: '1.00000000000000011102230246251565404236316680908203125001' asNumber = oddMantissa description: 'precondition'. - self assert: '1.00000000000000011102230246251565404236316680908203125' asNumber = evenMantissa description: 'when converting string to Float, if tie, round to closest even mantissa'. + | i1 i2 | + i1 := 10000 exp. + i2 := 1000000000 exp. + i2 := 0 - i2. " this is entirely ok. You can compute with infinite values." - self assert: (scaledEven2 + scaledOdd / 2) printString = '100000000000000033306690738754696212708950042724609375' description: 'precondition'. - self assert: '1.00000000000000033306690738754696212708950042724609374999' asNumber = oddMantissa description: 'precondition'. - self assert: '1.00000000000000033306690738754696212708950042724609375001' asNumber = evenMantissa2 description: 'precondition'. - self assert: '1.00000000000000033306690738754696212708950042724609375' asNumber = evenMantissa2 description: 'when converting string to Float, if tie, round to closest even mantissa'.! ! + self assert: i1 isInfinite & i2 isInfinite & i1 positive & i2 negative. + self deny: i1 = i2. + "All infinities are signed. Negative infinity is not equal to Infinity" +! ! -!FloatTest methodsFor: 'tests - conversion and rounding' stamp: 'jmv 12/4/2018 12:06:36'! -testTruncated - self assert: 1.0 truncated = 1. - self assert: 1.0 successor truncated = 1. - self assert: 1.0 predecessor truncated = 0. - self assert: 1.1 truncated = 1. - self assert: -2.0 truncated = -2. - self assert: -2.1 truncated = -2.! ! +!FloatTest methodsFor: 'tests - infinity behavior' stamp: 'jmv 5/21/2020 22:51:06'! +testInfinityTruncated + self assert: Float infinity truncated isInfinite. + self assert: Float negativeInfinity truncated isInfinite.! ! -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/21/2018 11:36:52'! -testExactAsString - "Ensures round-trip string conversion when using #asString. - Use some relevant examples." +!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'sd 6/5/2005 08:31'! +testNaN1 + "FloatTest new testNaN1" - | examples | - examples _ { - 1.0. - Float fminNormalized / 2. - Float fminNormalized / 10. - Float fminNormalized / 13. - 2.0. - 2 sqrt. - Float pi. - Float fminDenormalized. - Float fminDenormalized * 2. - Float fminDenormalized * 3. - Float fminDenormalized * 13 }, - { - Float zero. - Float negativeZero. - Float negativeInfinity. - Float infinity. - Float fmax predecessor }. + self assert: Float nan == Float nan. + self deny: Float nan = Float nan. + "a NaN is not equal to itself." +! ! - examples do: [ :float | - self assert: float predecessor asString asNumber = float predecessor. - self assert: float asString asNumber = float. - self assert: float successor asString asNumber = float successor ]. +!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 4/4/2019 14:20:45'! +testNaN2 + "Two NaN values are always considered to be different. + On an little-endian machine (32 bit Intel), Float nan is 16rFFF80000 16r00000000. + On a big-endian machine (PowerPC), Float nan is 16r7FF80000 16r00000000. Changing + the bit pattern of the first word of a NaN produces another value that is still + considered equal to NaN. This test should work on both little endian and big + endian machines." - "NaN are special, in that they are not even equal to themselves" - self assert: Float nan asString asNumber isNaN! ! + "FloatTest new testNaN2" -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/21/2018 14:56:27'! -testExactAsString2 - "Ensures round-trip string conversion when using #asString. - Use some relevant examples. - Note: there is no guarantee to restore the bit pattern of NaN though" + | nan1 nan2 | + nan1 := Float nan copy. + nan2 := Float nan copy. - self assert: Float halfPi asString asNumber = Float halfPi. - self assert: Float halfPi negated asString asNumber = Float halfPi negated. - self assert: Float pi asString asNumber = Float pi. - self assert: Float pi negated asString asNumber = Float pi negated. - self assert: 2.0 sqrt asString asNumber = 2.0 sqrt. - self assert: 2.0 sqrt negated asString asNumber = 2.0 sqrt negated. - self assert: Float infinity asString asNumber = Float infinity. - self assert: Float negativeInfinity asString asNumber = Float negativeInfinity. - self assert: Float nan asString asNumber isNaN.! ! + "test two instances of NaN with the same bit pattern" + self deny: nan1 = nan2. + self deny: nan1 == nan2. + self deny: nan1 = nan1. + self assert: nan1 == nan1. -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 9/24/2018 10:51:07'! -testExactStoreString - "Tests that conversion to / from Strings is exact (same Float is re-created) when using #storeString - (whose output is meant to be compilable smalltalk code). - Use some relevant examples." + "change the bit pattern of nan1" + self assert: nan1 size = 2. + self assert: (nan1 at: 2) = 0. + nan1 at: 1 put: (nan1 at: 1) + 999. + self assert: nan1 isNaN. + self assert: nan2 isNaN. + self deny: (nan1 at: 1) = (nan2 at: 1). - | examples | - examples _ { - 1.0. - Float fminNormalized / 2. - Float fminNormalized / 10. - Float fminNormalized / 13. - 2.0. - 2 sqrt. - Float pi. - Float fminDenormalized. - Float fminDenormalized * 2. - Float fminDenormalized * 3. - Float fminDenormalized * 13 }, - { - Float zero. - Float negativeZero. - Float negativeInfinity. - Float infinity }. + "test two instances of NaN with different bit patterns" + self deny: nan1 = nan2. + self deny: nan1 == nan2. + self deny: nan1 = nan1. + self assert: nan1 == nan1! ! - examples do: [ :float | - self assert: (Compiler evaluate: float predecessor storeString) = float predecessor. - self assert: (Compiler evaluate: float storeString) = float. - self assert: (Compiler evaluate: float successor storeString) = float successor ]. +!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 4/4/2019 14:21:07'! +testNaN3 + "FloatTest new testNaN3" - "NaN are special, in that they are not even equal to themselves" - self assert: (Compiler evaluate: Float nan storeString) isNaN! ! + | set item identitySet | + set _ Set new. + set add: (item _ Float nan). + self deny: (set includes: item). + identitySet _ IdentitySet new. + identitySet add: (item _ Float nan). + self assert: (identitySet includes: item).! ! -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/4/2018 12:09:53'! -testExactStoreString2 - "If storeOn: prints exactly and the parser avoids cumulating rounding errors, - then the Float should be read back exactly. - Note: there is no guarantee to restore the bit pattern of NaN though" - - self assert: (Compiler evaluate: Float halfPi storeString) = Float halfPi. - self assert: (Compiler evaluate: Float halfPi negated storeString) = Float halfPi negated. - self assert: (Compiler evaluate: Float infinity storeString) = Float infinity. - self assert: (Compiler evaluate: Float negativeInfinity storeString) = Float negativeInfinity. - self assert: (Compiler evaluate: Float nan storeString) isNaN.! ! +!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 4/23/2019 18:20:18'! +testNaN4 + "FloatTest new testNaN4" -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/21/2018 11:40:15'! -testFromStringDoesNotUnderflow - self assert: '12345678901234567890.0e-330' asNumber isZero not. - self assert: (Compiler evaluate: '12345678901234567890.0e-330')isZero not.! ! + | dict | + dict _ Dictionary new. + dict + at: Float nan + put: #NaN. + self deny: (dict includesKey: Float nan).! ! -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/21/2018 11:44:33'! -testMinimalAsString - "Tests that the conversion from String / to String ends in a minimal String representation. - This means that there are no extra unneded digits at the end. - For example, 0.1 (actually the closest Float to 1/10, i.e. ((1/10) asFloat), prints as 0.1, because - it can be recovered from that String" - - "These are just to start on solid ground. If these fail, what follows is meaningless." - self assert: 0.1 = ((1/10) asFloat). "0.1 really is what it should be. Compiler works ok." - self assert: '0.1' asNumber = 0.1. "#asNumber works ok. The string '0.1' is what we want." - "Now the real test." - self assert: 0.1 printString = '0.1'. "String '0.1' is what we get. No unneded extra digits." - - "Whatever Float these Strings represent, print them back the same (no extra digits)" - self assert: '0.2' asNumber printString = '0.2'. - #( - '0.1' '0.2' '0.3' '0.4' '0.5' '0.6' '0.7' '0.8' '0.9' - '1.0' '1.1' '1.2' '1.3' '1.4' '1.5' '1.6' '1.7' '1.8' '1.9' '2.0' - '1.01' '1.001' '1.0001' '1.00001' '1.000001' '1.0000001' '1.00000001' '1.000000001' '1.0000000001' '1.00000000001' '1.000000000001' - '1.03' '1.003' '1.0003' '1.00003' '1.000003' '1.0000003' '1.00000003' '1.000000003' '1.0000000003' '1.00000000003' '1.000000000003' - ) do: [ :string | - self assert: string asNumber printString = string ].! ! +!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 3/13/2012 12:34'! +testNaNCompare + "IEEE 754 states that NaN cannot be ordered. + As a consequence, every arithmetic comparison involving a NaN SHOULD return false. + Except the is different test (~=). + This test does verify this rule" + + | compareSelectors theNaN anotherNaN comparand brokenMethods warningMessage | + compareSelectors := #(#< #<= #> #>= #=). + theNaN := Float nan. + anotherNaN := Float infinity - Float infinity. + comparand := {1. 2.3. Float infinity. 2/3. 1.25. 2 raisedTo: 50}. + comparand := comparand , (comparand collect: [:e | e negated]). + comparand := comparand , {theNaN. anotherNaN}. -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/21/2018 12:15:04'! -testPrintShowingDecimalPlaces4 - | requiredDigits | - requiredDigits _ Float pi printString size - 2. - self assert: (Float pi printStringFractionDigits: requiredDigits) = Float pi printString. - 0 to: 100 do: [ :extra | - self assert: (Float pi printStringFractionDigits: requiredDigits + extra) asNumber = Float pi ]! ! +"do a first pass to collect all broken methods" + brokenMethods := Set new. + comparand do: [:comp | + compareSelectors do: [:op | + (theNaN perform: op with: comp) ifTrue: [brokenMethods add: (theNaN class lookupSelector: op)]. + (comp perform: op with: theNaN) ifTrue: [brokenMethods add: (comp class lookupSelector: op)]]. + (theNaN ~= comp) ifFalse: [brokenMethods add: (theNaN class lookupSelector: #~=)]. + (comp ~= theNaN) ifFalse: [brokenMethods add: (comp class lookupSelector: #~=)]]. + +"build a warning message to tell about all broken methods at once" + warningMessage := String streamContents: [:s | + s nextPutAll: 'According to IEEE 754 comparing with a NaN should always return false, except ~= that should return true.'; newLine. + s nextPutAll: 'All these methods failed to do so. They are either broken or call a broken one'. + brokenMethods do: [:e | s newLine; print: e methodClass; nextPutAll: '>>'; print: e selector]]. + +"Redo the tests so as to eventually open a debugger on one of the failures" + brokenMethods := Set new. + comparand do: [:comp2 | + compareSelectors do: [:op2 | + self deny: (theNaN perform: op2 with: comp2) description: warningMessage. + self deny: (comp2 perform: op2 with: theNaN) description: warningMessage]. + self assert: (theNaN ~= comp2) description: warningMessage. + self assert: (comp2 ~= theNaN) description: warningMessage].! ! -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/27/2018 16:50:31'! -testPrintStringStress - | eWidth mWidth ePrimeScale mPrimeScale | - eWidth _ Float emax - Float emin. - "211 for a more exhaustive but slower test. 41 for a quick run." - ePrimeScale _ 211. - ePrimeScale _ 41. - mWidth _ 1 bitShift: Float precision. - "9931 for a more exhaustive but slower test. 37 for a quick run." - mPrimeScale _ 9931. - mPrimeScale _ 37. - 0 - to: mWidth - 1 * mPrimeScale - by: mWidth - do: [ :mScaled | | m eAdjustment | - m _ mScaled // mPrimeScale. - eAdjustment _ m highBit - 1. - {mScaled. m. m hex. eAdjustment } print. - Float emin * ePrimeScale - to: Float emax * ePrimeScale - by: eWidth - do: [ :eFraction | | e fp | - e _ eFraction // ePrimeScale - eAdjustment. - fp _ m asFloat timesTwoPower: e. - self assert: fp printString asNumber = fp. - self assert: fp negated printString asNumber = fp negated ]]! ! +!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 8/1/2019 18:12:56'! +testNaNPropagationBinary + "Any operation should propagate NaN" + | s a c | + s _ Set new. + s addAll: Number selectors. + s addAll: Float selectors. + s addAll: BoxedFloat64 selectors. + s addAll: SmallFloat64 selectors. + s _ s select: [ :sel | sel numArgs = 1 ]. + s removeAll: #(#at: #basicAt: #ifNotZero: smoothIsAbsBelow:). + a _ s asArray sort. + a do: [ :sel | + { 0. 0.0. 1/3. 1. 1.0. 2. 2.0. Float nan } do: [ :op1 | + { 0. 0.0. 1/3. 1. 1.0. 2. 2.0. Float nan } do: [ :op2 | + op1 isNaN | op2 isNaN ifTrue: [ + c _ [ op1 perform: sel with: op2 ] on: Error do: [ #error ]. + self assert: (c isNumber not or: [c isNaN]) ]]]].! ! -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'nice 3/14/2008 23:59'! -testReadFromManyDigits - "A naive algorithm may interpret these representations as Infinity or NaN. - This is http://bugs.squeak.org/view.php?id=6982" - - | s1 s2 | - s1 := '1' , (String new: 321 withAll: $0) , '.0e-321'. - s2 := '0.' , (String new: 320 withAll: $0) , '1e321'. - self assert: (Number readFrom: s1) = 1. - self assert: (Number readFrom: s2) = 1.! ! +!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 8/1/2019 18:39:54'! +testNaNPropagationUnary + "Any operation should propagate NaN" + | s a c | + s _ Set new. + s addAll: Number selectors. + s addAll: Float selectors. + s addAll: BoxedFloat64 selectors. + s addAll: SmallFloat64 selectors. + s _ s select: [ :sel | sel numArgs = 0 ]. + s removeAll: #(#asIEEE32BitWord #byteSize #hash #identityHash #mantissaBits #signBit #smoothStep #exponentBits #imaginary #exponent primTestExponent). + a _ s asArray sort. + a do: [ :sel | + c _ [ Float nan perform: sel ] on: Error do: [ #error ]. + self assert: (c isNumber not or: [c isNaN]) ].! ! -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 10/19/2018 16:33:22'! -testSomeNines - | twelveNines | - twelveNines _ Compiler evaluate: '999999 + 0.999999'. - self assert: twelveNines printString = '999999.999999'. - self assert: twelveNines printString asNumber = twelveNines. - self assert: twelveNines printString asNumber - twelveNines = 0.0. - self assert: twelveNines + 1e-6 = 1e6! ! +!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 5/21/2020 22:51:38'! +testNaNTruncated + self assert: Float nan truncated isNaN.! ! -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'nice 10/11/2008 21:45'! -testStoreBase16 - "This bug was reported in mantis http://bugs.squeak.org/view.php?id=6695" +!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'nice 3/14/2008 23:42'! +testNaNisLiteral + self deny: Float nan isLiteral description: 'there is no literal representation of NaN'! ! - self - assert: (20.0 storeStringBase: 16) = '16r14.0' - description: 'the radix prefix should not be omitted, except in base 10'! ! +!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'jmv 4/4/2019 14:02:34'! +test32bitConversion + "Except for NaN, we can convert a 32bits float to a 64bits float exactly. + Thus we can convert the 64bits float to the original 32bits float pattern." + + #( + 16r0 "zero" + 16r80000000 "negative zero" + 16r1 "min denormal" + 16r12345 "a denormal" + 16r801FEDCB "a negative denormal" + 16r7FFFFF "largest denormal" + 16r800000 "smallest normal" + 16r468ACDEF "a normal float" + 16rCABD1234 "a negative normal float" + 16r7F7FFFFF "largest finite float" + 16r7F800000 "positive infinity" + 16rFF800000 "negative infinity" + 16r803FFFFC + 16r803FFFFD + ) + do: [ :originalWord | self assert: (Float fromIEEE32Bit: originalWord) asIEEE32BitWord = originalWord ]! ! -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/4/2018 12:09:57'! -testStoreOn - "If storeOn: prints exactly and the parser avoids cumulating rounding errors, - then the Float should be read back exactly. - Note: there is no guarantee to restore the bit pattern of NaN though" - - self assert: (Compiler evaluate: Float halfPi storeString) = Float halfPi. - self assert: (Compiler evaluate: Float halfPi negated storeString) = Float halfPi negated. - self assert: (Compiler evaluate: Float infinity storeString) = Float infinity. - self assert: (Compiler evaluate: Float negativeInfinity storeString) = Float negativeInfinity. - self assert: (Compiler evaluate: Float nan storeString) isNaN.! ! +!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'jmv 9/3/2020 17:12:44'! +test32bitConversion2 + "This tests the rounding done when going from 64bit Float to 32bit Float + self new test32bitConversion2 + " -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'dtl 9/18/2004 12:40'! -testStringAsNumber - "This covers parsing in Number>>readFrom:" + | pi32 pi32Predecessor roundingTo32Border roundingBorderPrev roundingBorderSuc aux roundedByConversion | + "Pick two neighbors in the 32-bit Float world" + pi32 _ Float fromIEEE32Bit: Float pi asIEEE32BitWord. + pi32Predecessor _ Float fromIEEE32Bit: Float pi asIEEE32BitWord-1. + "Find the middle value in the 64-bit Float world, and both its neighbors" + roundingTo32Border _ pi32 + pi32Predecessor / 2.0. + roundingBorderPrev _ roundingTo32Border predecessor. + roundingBorderSuc _ roundingTo32Border successor. - | aFloat | - aFloat := '10r-12.3456' asNumber. - self assert: -12.3456 = aFloat. - aFloat := '10r-12.3456e2' asNumber. - self assert: -1234.56 = aFloat. - aFloat := '10r-12.3456d2' asNumber. - self assert: -1234.56 = aFloat. - aFloat := '10r-12.3456q2' asNumber. - self assert: -1234.56 = aFloat. - aFloat := '-12.3456q2' asNumber. - self assert: -1234.56 = aFloat. - aFloat := '12.3456q2' asNumber. - self assert: 1234.56 = aFloat. -! ! + "64 bit middle value is not like any of the 32 bit values. Same for neighbors." + self deny: roundingTo32Border mantissaPart hex = pi32 mantissaPart hex. + self deny: roundingTo32Border mantissaPart hex = pi32Predecessor mantissaPart hex. + self deny: roundingBorderPrev mantissaPart hex = pi32Predecessor mantissaPart hex. + self deny: roundingBorderPrev mantissaPart hex = pi32 mantissaPart hex. + self deny: roundingBorderSuc mantissaPart hex = pi32Predecessor mantissaPart hex. + self deny: roundingBorderSuc mantissaPart hex = pi32 mantissaPart hex. -!FloatTest methodsFor: 'tests - conversion from to String' stamp: 'jmv 12/12/2018 14:44:07'! -testStringAsNumber2 - "Check that small but normal Floats can be created from Strings" + "Conversion to 32 bit gives appropriate 32 bit value, done #asIEEE32BitWord or done by FloatArray." + roundedByConversion _ Float fromIEEE32Bit: roundingTo32Border asIEEE32BitWord. + self assert: roundedByConversion mantissaPart hex = pi32Predecessor mantissaPart hex. + aux _ Float32Array new: 1. aux at: 1 put: roundingTo32Border. roundedByConversion _ aux at: 1. + self assert: roundedByConversion mantissaPart hex = pi32Predecessor mantissaPart hex. - | aFloat | - aFloat _ '12345678901234567890.0e-326' asNumber. - self deny: aFloat = 0.0. - self assert: aFloat > 0.0. - self assert: aFloat - 1.2345678901234568e-307 = 0. - self assert: aFloat = 1.2345678901234568e-307.! ! + "Conversion to 32 bit gives appropriate 32 bit value, done #asIEEE32BitWord or done by FloatArray." + roundedByConversion _ Float fromIEEE32Bit: roundingBorderPrev asIEEE32BitWord. + self assert: roundedByConversion mantissaPart hex = pi32Predecessor mantissaPart hex. + aux _ Float32Array new: 1. aux at: 1 put: roundingBorderPrev. roundedByConversion _ aux at: 1. + self assert: roundedByConversion mantissaPart hex = pi32Predecessor mantissaPart hex. -!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 14:02:56'! -testHashWithBigNegativeSmallInteger - "Not in the Float range" - | a float smallInteger | - smallInteger _ SmallInteger minVal+1. - self deny: smallInteger isLarge description: 'precondition'. - float _ smallInteger asFloat. - self assert: smallInteger = float description: 'precondition'. - self assert: float = smallInteger description: 'precondition'. - a _ Set new. - a add: smallInteger; add: float. - self assert: a size = 1! ! + "Conversion to 32 bit gives appropriate 32 bit value, done #asIEEE32BitWord or done by FloatArray." + roundedByConversion _ Float fromIEEE32Bit: roundingBorderSuc asIEEE32BitWord. + self assert: roundedByConversion mantissaPart hex = pi32 mantissaPart hex. + aux _ Float32Array new: 1. aux at: 1 put: roundingBorderSuc. roundedByConversion _ aux at: 1. + self assert: roundedByConversion mantissaPart hex = pi32 mantissaPart hex! ! -!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 14:01:27'! -testHashWithBigSmallInteger - "Not in the Float range" - | a float smallInteger | - smallInteger _ SmallInteger maxVal. - self deny: smallInteger isLarge description: 'precondition'. - float _ smallInteger asFloat. - self assert: smallInteger = float description: 'precondition'. - self assert: float = smallInteger description: 'precondition'. - a _ Set new. - a add: smallInteger; add: float. - self assert: a size = 1! ! - -!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 10:43:35'! -testHashWithFraction - - | a float fraction | - fraction _ 1/3. - float _ (1/3) asFloat. - self assert: fraction = float description: 'precondition'. - self assert: float = fraction description: 'precondition'. - a _ Set new. - a add: fraction; add: float. - self assert: a size = 1! ! +!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'nice 5/30/2006 02:34'! +test32bitGradualUnderflow + "method asIEEE32BitWord did not respect IEEE gradual underflow" + + | conv expected exponentPart | + + "IEEE 32 bits Float have 1 bit sign/8 bit exponent/23 bits of mantissa after leading 1 + 2r1.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2reeeeeeee-127) * sign + except when 2reeeeeeee isZero, which is a gradual underflow: + 2r0.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2r00000000-126) * sign + and when 2reeeeeeee = 255, which is infinity if mantissa all zero or nan otherwise" + + "case 1: This example is the first gradual underflow case" + conv := 2r0.11111111111111111111111e-126 asIEEE32BitWord. + + "expected float encoded as sign/exponent/mantissa (whithout leading 1 or 0)" + exponentPart := 0. + expected := exponentPart bitOr: 2r11111111111111111111111. + self assert: expected = conv. + + "case 2: smallest number" + conv := 2r0.00000000000000000000001e-126 asIEEE32BitWord. + expected := exponentPart bitOr: 2r1. + self assert: expected = conv. + + "case 3: round to nearest even also in underflow cases... here round to upper" + conv := 2r0.000000000000000000000011e-126 asIEEE32BitWord. + expected := exponentPart bitOr: 2r10. + self assert: expected = conv. + + "case 4: round to nearest even also in underflow cases... here round to lower" + conv := 2r0.000000000000000000000101e-126 asIEEE32BitWord. + expected := exponentPart bitOr: 2r10. + self assert: expected = conv. + + "case 5: round to nearest even also in underflow cases... here round to upper" + conv := 2r0.0000000000000000000001011e-126 asIEEE32BitWord. + expected := exponentPart bitOr: 2r11. + self assert: expected = conv. + ! ! -!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 10:51:32'! -testHashWithLargeNegativeInteger - "Not in the Float range" - | a float largeInteger | - largeInteger _ -1e400. - self assert: largeInteger isLarge description: 'precondition'. - float _ largeInteger asFloat. - self assert: largeInteger = float description: 'precondition'. - self assert: float = largeInteger description: 'precondition'. - a _ Set new. - a add: largeInteger; add: float. - self assert: a size = 1! ! +!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'jmv 4/4/2019 14:15:16'! +test32bitInfinities + | infinityBits negativeInfinityBits | + infinityBits _ '01111111100000000000000000000000'. + self assert: (Float infinity asIEEE32BitWord printStringBase: 2 length: 32 padded: true) = infinityBits. + self assert: (Float fromIEEE32Bit: (Integer readFrom: infinityBits readStream base: 2)) hex = Float infinity hex. + negativeInfinityBits _ '11111111100000000000000000000000'. + self assert: (Float negativeInfinity asIEEE32BitWord printStringBase: 2 length: 32 padded: true) = negativeInfinityBits. + self assert: (Float fromIEEE32Bit: (Integer readFrom: negativeInfinityBits readStream base: 2)) hex = Float negativeInfinity hex.! ! -!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 10:51:37'! -testHashWithLargePositiveInteger - "Not in the Float range" - | a float largeInteger | - largeInteger _ 1e400. - self assert: largeInteger isLarge description: 'precondition'. - float _ largeInteger asFloat. - self assert: largeInteger = float description: 'precondition'. - self assert: float = largeInteger description: 'precondition'. - a _ Set new. - a add: largeInteger; add: float. - self assert: a size = 1! ! +!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'jmv 4/4/2019 14:16:16'! +test32bitNaN + | nanstr | + + "check the NaN string representation conforms to IEEE 754" + nanstr := Float nan asIEEE32BitWord printStringBase: 2 length: 32 padded: true. + self + assert: (#($0 $1) includes: (nanstr at: 1)); + assert: (nanstr copyFrom: 2 to: 9) = '11111111'; + assert: (#($0 $1) includes: (nanstr at: 10)); "accept both quiet and signalled NaNs" + assert: ((nanstr copyFrom: 11 to: 32) reject: [ :c | #($0 $1) includes: c ]) isEmpty. + + "check a correct quiet NaN is created from a string" + self assert: (Float fromIEEE32Bit: + (Integer readFrom: '01111111110000000000000000000000' readStream base: 2)) isNaN! ! -!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 10:51:40'! -testHashWithSmallishLargeNegativeInteger - "In the Float range" - | a float largeInteger | - largeInteger _ SmallInteger minVal -1. - self assert: largeInteger isLarge description: 'precondition'. - float _ largeInteger asFloat. - self assert: largeInteger = float description: 'precondition'. - self assert: float = largeInteger description: 'precondition'. - a _ Set new. - a add: largeInteger; add: float. - self assert: a size = 1! ! +!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'nice 5/30/2006 00:07'! +test32bitRoundingMode + "method asIEEE32BitWord did not respect IEEE default rounding mode" + + | conv expected exponentPart | + + "IEEE 32 bits Float have 1 bit sign/8 bit exponent/23 bits of mantissa after leading 1 + 2r1.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2reeeeeeee-127) * sign + except when 2reeeeeeee isZero, which is a gradual underflow: + 2r0.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2r00000000-127) * sign + and when 2reeeeeeee = 255, which is infinity if mantissa all zero or nan otherwise" + + "This example has two extra bits in mantissa for testing rounding mode + case 1: should obviously round to upper" + conv := 2r1.0000000000000000000000111e25 asIEEE32BitWord. + + "expected float encoded as sign/exponent/mantissa (whithout leading 1)" + exponentPart := 25+127 bitShift: 23. "127 is 2r01111111 or 16r7F" + expected := exponentPart bitOr: 2r10. + self assert: expected = conv. + + "case 2: exactly in the mid point of two 32 bit float: round toward nearest even (to upper)" + conv := 2r1.0000000000000000000000110e25 asIEEE32BitWord. + expected := exponentPart bitOr: 2r10. + self assert: expected = conv. + + "case 3: exactly in the mid point of two 32 bit float: round toward nearest even (to lower)" + conv := 2r1.0000000000000000000000010e25 asIEEE32BitWord. + expected := exponentPart bitOr: 2r0. + self assert: expected = conv. + + "case 4: obviously round to upper" + conv := 2r1.0000000000000000000000011e25 asIEEE32BitWord. + expected := exponentPart bitOr: 2r1. + self assert: expected = conv. +! ! -!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/10/2018 15:40:00'! -testHashWithSmallishLargeNegativeInteger2 - "In the Float range" - | a float integer | - integer _ Float maxExactInteger negated -1. - float _ integer asFloat. - self assert: integer = float description: 'precondition'. - self assert: float = integer description: 'precondition'. - a _ Set new. - a add: integer; add: float. - self assert: a size = 1! ! +!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'jmv 4/5/2019 16:24:45'! +test32bitZeros + | negativeZeroBits zeroBits | + zeroBits _ '00000000000000000000000000000000'. + self assert: (Float zero asIEEE32BitWord printStringBase: 2 length: 32 padded: true) = zeroBits. + self assertIsPositiveZero: (Float fromIEEE32Bit: (Integer readFrom: zeroBits readStream base: 2)). + negativeZeroBits _ '10000000000000000000000000000000'. + self assert: (Float negativeZero asIEEE32BitWord printStringBase: 2 length: 32 padded: true) = negativeZeroBits. + self assertIsNegativeZero: (Float fromIEEE32Bit: (Integer readFrom: negativeZeroBits readStream base: 2)).! ! -!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/9/2018 10:51:44'! -testHashWithSmallishLargePositiveInteger - "In the Float range" - | a float largeInteger | - largeInteger _ SmallInteger maxVal +1. - self assert: largeInteger isLarge description: 'precondition'. - float _ largeInteger asFloat. - self assert: largeInteger = float description: 'precondition'. - self assert: float = largeInteger description: 'precondition'. - a _ Set new. - a add: largeInteger; add: float. - self assert: a size = 1! ! +!FloatTest methodsFor: 'helpers' stamp: 'jmv 4/24/2019 11:48:04'! +assert: aFloatingPointNumber isExactly: otherFloatingPointNumber -!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/10/2018 15:40:11'! -testHashWithSmallishLargePositiveInteger2 - "In the Float range" - | a float integer | - integer _ Float maxExactInteger +1. - float _ integer asFloat. - self assert: integer = float description: 'precondition'. - self assert: float = integer description: 'precondition'. - a _ Set new. - a add: integer; add: float. - self assert: a size = 1! ! + "Both aFloatingPointNumber and otherFloatingPointNumber must be instances + of our #classTested. Check that and fail if they aren't." -!FloatTest methodsFor: 'tests - hash' stamp: 'jmv 10/10/2018 15:57:54'! -testNoIntegerHash + self assert: (aFloatingPointNumber class inheritsFrom: Float). + self assert: (otherFloatingPointNumber class inheritsFrom: Float). + self assert: aFloatingPointNumber = otherFloatingPointNumber. + self assert: otherFloatingPointNumber = aFloatingPointNumber. + self assert: aFloatingPointNumber hex = otherFloatingPointNumber hex! ! - self deny: Float pi hash = 3 hash. - self deny: Float pi hash = (Float pi *1.00000000000001) hash. - self deny: Float pi hash = (Float pi /1.00000000000001) hash.! ! +!FloatTest methodsFor: 'helpers' stamp: 'jmv 2/28/2019 16:13:30'! +assertIsNaNorFail: aFloatOrSymbol + "Assert that aFloat is NaN or #fail. + For some BoxedFloat64, primitive 55 (sqrt) faile, unless jitter, where it answers NaN. We consider both values valid." + self assert: (aFloatOrSymbol = #fail or: [ aFloatOrSymbol isNaN ])! ! -!FloatTest methodsFor: 'tests - hash' stamp: 'nice 2/13/2010 04:15'! -testSetOfFloat - "Classical disagreement between hash and = did lead to a bug. - This is a non regression test from http://bugs.squeak.org/view.php?id=3360" +!FloatTest methodsFor: 'helpers' stamp: 'jmv 10/3/2018 15:43:27'! +assertIsNegativeZero: aFloat + "Assert that aFloat is Float negativeZero" + self assert: aFloat hex = Float negativeZero hex! ! - | size3 size4 | - size3 := (Set new: 3) add: 3; add: 3.0; size. - size4 := (Set new: 4) add: 3; add: 3.0; size. - self assert: size3 = size4 description: 'The size of a Set should not depend on its capacity.'! ! +!FloatTest methodsFor: 'helpers' stamp: 'jmv 10/3/2018 15:43:47'! +assertIsPositiveZero: aFloat + "Assert that aFloat is Float zero (the positive one)" + self assert: aFloat hex = 0.0 hex! ! -!FloatTest methodsFor: 'tests - constants' stamp: 'jmv 12/27/2018 18:37:19'! -testE - "Just in case..." +!FloatTest methodsFor: 'helpers' stamp: 'jmv 10/15/2019 16:41:28'! +expectedFailures + "See https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/383" + ^ (`{'Win32'. 'Mac OS' }` includes: Smalltalk platformName) + ifTrue: [#(testTimesTwoPowerGradualUnderflow)] + ifFalse: [#()]! ! - self assert: Float e = 2.718281828459045. - self assert: Float e ln = 1.0. - self assert: Float e = 1.0 exp. - self assert: Float e hex = '4005BF0A8B145769'.! ! +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/27/2019 15:25:35'! +testPrimAdd -!FloatTest methodsFor: 'tests - constants' stamp: 'jmv 10/11/2011 08:55'! -testMaxExactInteger - " - FloatTest new testMaxExactInteger - " + self assert: (1.0 primTestAdd: 1.0) = 2.0. + self assert: (Float fminNormalized primTestAdd: Float fminDenormalized) > Float fminNormalized. + self assert: (Float fminNormalized primTestAdd: Float fminDenormalized) - Float fminNormalized = Float fminDenormalized. + self assert: (1.0 primTestAdd: Float zero) = 1.0. + self assert: (Float zero primTestAdd: 1.0) = 1.0. + self assert: (1.0 primTestAdd: Float negativeZero) = 1.0. + self assert: (Float negativeZero primTestAdd: 1.0) = 1.0. + self assert: (1.0 primTestAdd: Float infinity) = Float infinity. + self assert: (Float infinity primTestAdd: 1.0) = Float infinity. + self assert: (1.0 primTestAdd: Float negativeInfinity) = Float negativeInfinity. + self assert: (Float negativeInfinity primTestAdd: 1.0) = Float negativeInfinity. + self assert: (1.0 primTestAdd: Float nan) isNaN. + self assert: (Float nan primTestAdd: 1.0) isNaN. + self assert: (Float nan primTestAdd: Float nan) isNaN.! ! - self assert: Float maxExactInteger asFloat truncated = Float maxExactInteger. - 0 to: 10000 do: [ :j | - self assert: (Float maxExactInteger-j) asFloat truncated = (Float maxExactInteger-j) ]. - self deny: (Float maxExactInteger+1) asFloat truncated = (Float maxExactInteger+1) - ! ! +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/14/2019 14:09:00'! +testPrimArcTan -!FloatTest methodsFor: 'tests - constants' stamp: 'jmv 12/27/2018 18:39:24'! -testPi - "Just in case..." + self verify: 1.0 primTestArcTan isTrigonometricallyEqualTo: Float pi / 4. + self verify: -1.0 primTestArcTan isTrigonometricallyEqualTo: Float pi / -4. + self verify: 0.0 primTestArcTan isTrigonometricallyEqualTo: 0. + self verify: Float infinity primTestArcTan isTrigonometricallyEqualTo: Float pi / 2. + self verify: Float negativeInfinity primTestArcTan isTrigonometricallyEqualTo: Float pi / -2. + self assert: Float nan primTestArcTan isNaN! ! - self assert: Float pi = 3.141592653589793. - self assert: Float pi = (1.0 arcTan * 4). - self assert: Float pi hex = '400921FB54442D18' ! ! +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 10/11/2019 20:08:22'! +testPrimDivideBy -!FloatTest methodsFor: 'tests - precision and extreme values' stamp: 'jmv 4/5/2019 16:23:22'! -testCharacterization + self assert: (1.5 primTestDivideBy: 2.0) = 0.75. - "Test the largest finite representable floating point value" - self assert: Float fmax successor = Float infinity. - self assert: Float infinity predecessor = Float fmax. - self assert: Float fmax negated predecessor = Float infinity negated. - self assert: Float infinity negated successor = Float fmax negated. - - "Test the smallest positive representable floating point value" - self assertIsPositiveZero: Float fmin predecessor. - self assert: 0.0 successor = Float fmin. - self assert: Float fmin negated successor hex = -0.0 hex. - self assert: -0.0 predecessor = Float fmin negated. - - "Test the relative precision" - self assert: Float one + Float epsilon > Float one. - self assert: Float one + Float epsilon = Float one successor. - self assert: Float one + (Float epsilon / Float radix) = Float one. - - "Test maximum and minimum exponent" - self assert: Float fmax exponent = Float emax. - self assert: Float fminNormalized exponent = Float emin. - Float denormalized ifTrue: [ - self assert: Float fminDenormalized exponent = (Float emin + 1 - Float precision)]. - - "Alternative tests for maximum and minimum exponents and normalized and denormal values" - self assert: (Float radix raisedTo: Float emax) * (Float radix - (Float epsilon)) = Float fmax. - self assert: (Float radix raisedTo: Float emin) = Float fminNormalized. - self assert: (Float radix raisedTo: Float emin) * Float epsilon = Float fmin. - - "Test sucessors and predecessors" - self assert: Float one predecessor successor = Float one. - self assert: Float one successor predecessor = Float one. - self assert: Float one negated predecessor successor = Float one negated. - self assert: Float one negated successor predecessor = Float one negated. - self assert: Float infinity successor = Float infinity. - self assert: Float negativeInfinity predecessor = Float negativeInfinity. - self assertIsNegativeZero: Float fmin negated successor. - self assertIsPositiveZero: Float fmin predecessor. - self assert: Float nan predecessor isNaN. - self assert: Float nan successor isNaN. - - "SPECIFIC FOR IEEE 754 double precision - 64 bits" - self assert: Float fmax hex = '7FEFFFFFFFFFFFFF'. - self assert: Float fminDenormalized hex = '0000000000000001'. - self assert: Float fminNormalized hex = '0010000000000000'. - self assert: 0.0 hex = '0000000000000000'. - self assert: Float negativeZero hex = '8000000000000000'. - self assert: Float one hex = '3FF0000000000000'. - self assert: Float infinity hex = '7FF0000000000000'. - self assert: Float negativeInfinity hex = 'FFF0000000000000'.! ! + Smalltalk doMixedArithmetic + ifTrue: [ self assert: (2.0 primTestDivideBy: 1) = 2.0 ] + ifFalse: [ self assert: (2.0 primTestDivideBy: 1) = #fail ]. -!FloatTest methodsFor: 'tests - precision and extreme values' stamp: 'jmv 12/4/2018 15:20:59'! -testNextAwayFromZero + self assert: (2.0 primTestDivideBy: 0) = #fail. + self assert: (2.0 primTestDivideBy: 0.0) = #fail. + self assert: (1.2 primTestDivideBy: Float negativeZero) = #fail. + self assert: (1.2 primTestDivideBy: (1.3 - 1.3)) = #fail. + self assert: (0.0 primTestDivideBy: 0.0) = #fail. + self assert: (0.0 primTestDivideBy: Float negativeZero) = #fail. + self assert: (Float negativeZero primTestDivideBy: 0.0) = #fail. + self assert: (Float negativeZero primTestDivideBy: Float negativeZero) = #fail. + self assert: (Float nan primTestDivideBy: 0.0) = #fail. + self assert: (Float nan primTestDivideBy: Float negativeZero) = #fail. + self assert: (Float infinity primTestDivideBy: 0.0) = #fail. + self assert: (Float negativeInfinity primTestDivideBy: Float negativeZero) = #fail. - self assert: Float pi nextAwayFromZero = Float pi successor. - self assert: Float pi negated nextAwayFromZero = Float pi negated predecessor. - self assert: 1.0 nextAwayFromZero = 1.0 successor. - self should: [Float infinity nextAwayFromZero] raise: Error. - self assert: Float infinity predecessor nextAwayFromZero = Float infinity. - self assert: Float infinity predecessor predecessor nextAwayFromZero = Float infinity predecessor. - self should: [Float negativeInfinity nextAwayFromZero] raise: Error. - self assert: Float negativeInfinity successor nextAwayFromZero = Float negativeInfinity. - self assert: Float negativeInfinity successor successor nextAwayFromZero = Float negativeInfinity successor. - self assert: 0.0 nextAwayFromZero = Float fminDenormalized. - self assert: -0.0 nextAwayFromZero = Float fminDenormalized negated.! ! + self assert: (2.0 primTestDivideBy: 2.0) = 1.0. + self assert: (Float fminNormalized primTestDivideBy: 2.0) * 2.0 = Float fminNormalized. + self assert: (Float fminDenormalized * 2.0 primTestDivideBy: 2.0) = Float fminDenormalized. -!FloatTest methodsFor: 'tests - precision and extreme values' stamp: 'jmv 12/4/2018 15:16:45'! -testNextTowardsZero + self assertIsPositiveZero: (Float zero primTestDivideBy: 1.0). + self assertIsNegativeZero: (Float negativeZero primTestDivideBy: 1.0). - self assert: Float pi nextTowardsZero = Float pi predecessor. - self assert: Float pi negated nextTowardsZero = Float pi negated successor. - self assert: 1.0 nextTowardsZero = 1.0 predecessor. - self should: [Float infinity nextTowardsZero] raise: Error. - self assert: Float infinity predecessor nextTowardsZero = Float infinity predecessor predecessor. - self should: [Float negativeInfinity nextTowardsZero] raise: Error. - self assert: Float negativeInfinity successor nextTowardsZero = Float negativeInfinity successor successor. - self should: [0.0 nextTowardsZero] raise: Error. - self assert: 0.0 successor nextTowardsZero = 0.0. - self should: [-0.0 nextTowardsZero] raise: Error. - self assert: -0.0 predecessor nextTowardsZero = -0.0! ! + self assertIsPositiveZero: (1.0 primTestDivideBy: Float infinity). + self assert: (Float infinity primTestDivideBy: 1.0) = Float infinity. + self assertIsNegativeZero: (-1.0 primTestDivideBy: Float infinity). + self assert: (Float infinity primTestDivideBy: -1.0) = Float negativeInfinity. -!FloatTest methodsFor: 'tests - precision and extreme values' stamp: 'jmv 4/5/2019 16:26:34'! -testPredecessorSuccessor - self assert: 0.0 successor = Float fminDenormalized. - self assertIsNegativeZero: 0.0 predecessor. - self assertIsPositiveZero: -0.0 successor. - self assert: -0.0 predecessor = Float fminDenormalized negated. - self assert: 1.0 successor > 1.0. - self assert: 1.0 successor predecessor = 1.0. - self assert: 1.0 predecessor < 1.0. - self assert: 1.0 predecessor successor = 1.0. - self assert: -1.0 successor > -1.0. - self assert: -1.0 successor predecessor = -1.0. - self assert: -1.0 predecessor < -1.0. - self assert: -1.0 predecessor successor = -1.0.! ! + self assertIsNegativeZero: (1.0 primTestDivideBy: Float negativeInfinity). + self assert: (Float negativeInfinity primTestDivideBy: 1.0) = Float negativeInfinity. + self assertIsPositiveZero: (-1.0 primTestDivideBy: Float negativeInfinity). + self assert: (Float negativeInfinity primTestDivideBy: -1.0) = Float infinity. -!FloatTest methodsFor: 'tests - precision and extreme values' stamp: 'jmv 12/4/2018 17:10:45'! -testPredecessorSuccessor2 - | mustBeOneOfThem | - mustBeOneOfThem _ Float fminNormalized + Float fminNormalized successor / 2. - self assert: (mustBeOneOfThem = Float fminNormalized or: [ - mustBeOneOfThem = Float fminNormalized successor ]). - mustBeOneOfThem _ 1.0 + 1.0 successor / 2. - self assert: (mustBeOneOfThem = 1.0 or: [ - mustBeOneOfThem = 1.0 successor ]). - mustBeOneOfThem _ 1.0 + 1.0 predecessor / 2. - self assert: (mustBeOneOfThem = 1.0 or: [ - mustBeOneOfThem = 1.0 successor ]).! ! + self assert: (1.0 primTestDivideBy: Float nan) isNaN. + self assert: (Float nan primTestDivideBy: 1.0) isNaN. + self assert: (Float nan primTestDivideBy: Float nan) isNaN.! ! -!FloatTest methodsFor: 'tests - precision and extreme values' stamp: 'jmv 12/12/2018 14:27:52'! -testUlp +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/25/2019 18:00:27'! +testPrimEqual - {1.0 predecessor. 1.0 successor. Float pi predecessor. Float pi. Float pi successor} do: - [:f | - self assert: (f * 2) ulp = (f ulp * 2). - self assert: (f / 2) ulp = (f ulp / 2). - self deny: f + f ulp = f. - self deny: f - f ulp = f. - "Tests below are valid as long as default rounding mode (to nearest even) is used" - self assert: f significandAsInteger odd not | (f ulp / 2.0 + f = f successor). - self assert: f significandAsInteger even not | (f ulp / 2.0 + f = f)]. - - self assert: 1.0 ulp = 0.9 ulp. - self deny: 1.0 ulp = 1.1 ulp. - - self assert: 0.0 ulp = Float fmin. - self assert: 1.01 ulp = Float epsilon. - self assert: Float nan ulp isNaN. - self assert: Float infinity ulp = Float infinity. - self assert: Float negativeInfinity ulp = Float infinity. + | samples | + samples _ { Float negativeInfinity. -1.0. Float fminNormalized negated. Float fminDenormalized negated. Float fminDenormalized. Float fminNormalized. 1.0. Float infinity }. - self assert: ((0 to: Float precision - 1) allSatisfy: [:each | (Float fmin timesTwoPower: each) ulp = Float fmin]). ! ! + 1 to: samples size do: [ :i | + 1 to: samples size do: [ :j | + self assert: ((samples at: i) primTestEqual: (samples at: j)) = (i = j ) ]]. -!FloatTest methodsFor: 'tests - accessing parts' stamp: 'jmv 4/5/2019 16:25:12'! -testCopy - "Elementary tests" - self assert: 2.0 copy = 2.0. - self assert: -0.5 copy = -0.5. - - "Are exceptional Floats preserved by the copy ?" - self assert: Float nan copy isNaN. - self assert: Float infinity copy = Float infinity. - self assert: Float infinity negated copy = Float infinity negated. - - "Is the sign of zero preserved by the copy ?" - self assertIsPositiveZero: 0.0 copy. - self assertIsNegativeZero: Float negativeZero copy.! ! + self assert: (Float zero primTestEqual: Float negativeZero). + self assert: (Float negativeZero primTestEqual: Float zero). + self deny: (Float zero primTestEqual: Float nan). + self deny: (Float nan primTestEqual: Float zero). + self deny: (Float negativeZero primTestEqual: Float nan). + self deny: (Float nan primTestEqual: Float negativeZero). + self deny: (Float nan primTestEqual: Float nan). -!FloatTest methodsFor: 'tests - accessing parts' stamp: 'jmv 4/5/2019 19:51:34'! -testIsDenormalized - self deny: Float pi isDenormalized. - self deny: 0.0 isDenormalized. - self assert: 0.0 successor isDenormalized. - self assert: Float fmin isDenormalized. - self assert: Float fminNormalized predecessor isDenormalized. - self deny: Float fminNormalized isDenormalized. - self deny: Float pi negated isDenormalized. - self deny: -0.0 isDenormalized. - self assert: -0.0 predecessor isDenormalized. - self assert: Float fmin negated isDenormalized. - self assert: Float fminNormalized negated successor isDenormalized. - self deny: Float fminNormalized negated isDenormalized.! ! + 1 to: samples size do: [ :i | + self deny: ((samples at: i) primTestEqual: Float zero). + self deny: ((samples at: i) primTestEqual: Float negativeZero). + self deny: ((samples at: i) primTestEqual: Float nan). + self deny: (Float zero primTestEqual: (samples at: i)). + self deny: (Float negativeZero primTestEqual: (samples at: i)). + self deny: (Float nan primTestEqual: (samples at: i)) ].! ! -!FloatTest methodsFor: 'tests - accessing parts' stamp: 'jmv 12/4/2018 14:10:06'! -testPartBits - | denormals exceptionals normals | - - normals := {Float pi. Float pi * 100.0. Float pi/ -100.0. Float fmax. Float fminNormalized}. - denormals := {0.0. Float negativeZero. Float fminNormalized predecessor. Float fmin negated}. - exceptionals := {Float nan. Float infinity. Float negativeInfinity.}. - - normals , denormals , exceptionals do: [ :aFloat | - self assert: - (Float - signBit: aFloat signBit - mantissaBits: aFloat mantissaBits - exponentBits: aFloat exponentBits) hex - = aFloat hex ]! ! +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/14/2019 13:51:33'! +testPrimExpAndLn + | e | + e := Float e. + self assert: 1.0 primTestExp = e. + self assert: e primTestLn = 1.0. + self verify: 2.0 primTestExp isWithin: 1 floatsAwayFrom: e squared. + self assert: 2.0 primTestExp sqrt = e. + self assert: 2.0 primTestExp primTestLn = 2.0. + self assert: 0.0 primTestExp = 1.0. + self assert: 0.0 primTestLn = Float negativeInfinity. + self assert: 0.0 primTestLn primTestExp = 0.0. + self assert: 0.0 successor primTestLn ~= Float negativeInfinity. + self assert: 0.0 successor primTestLn primTestExp = 0.0 successor. + self assert: 0.0 successor primTestLn ceiling asFloat primTestExp > 0.0 successor. + self assertIsNaNorFail: -1.0 primTestLn. + self assert: Float nan primTestLn isNaN. + self assert: Float nan primTestExp isNaN! ! -!FloatTest methodsFor: 'tests - accessing parts' stamp: 'nice 5/3/2014 22:31:57.837'! -testSignificandAndExponent - | denormals exceptionals normals | - - normals := {Float pi. Float pi * 100.0. Float pi/ -100.0. Float fmax. Float fminNormalized}. - denormals := {0.0. Float negativeZero. Float fminNormalized predecessor. Float fmin negated}. - exceptionals := {Float nan. Float infinity. Float negativeInfinity.}. - - normals, denormals, exceptionals do: [ :aFloat | - "Any Float can be decomposed into its significand and exponent, and the significand holds the sign" - aFloat isNaN - ifTrue: [self assert: (aFloat significand timesTwoPower: aFloat exponent) isNaN] - ifFalse: [self - assert: (aFloat significand timesTwoPower: aFloat exponent) - equals: aFloat]]. - - normals , denormals do: [:aFloat | - "The significand magnitude is in interval [1.0, 2.0) " - aFloat = 0.0 - ifTrue: [self assert: aFloat significand equals: 0] - ifFalse: [self - assert: aFloat significand abs >= 1.0; - assert: aFloat significand abs < 2.0]]! ! +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/14/2019 13:44:44'! +testPrimExponent + self assert: 1.0 primTestExponent = 0. + self assert: 2.0 predecessor primTestExponent = 0. + self assert: 2.0 primTestExponent = 1. + self assert: 4.0 predecessor primTestExponent = 1. + self assert: 4.0 primTestExponent = 2. + self assert: Float fminNormalized primTestExponent = -1022. + self assert: Float fminDenormalized primTestExponent = (-1022-52).! ! -!FloatTest methodsFor: 'tests - accessing parts' stamp: 'jmv 10/3/2018 17:41:49'! -testSignificandAsInteger - | mantissaBits denormalPowersOfTwo denormals exceptionals normalPowersOfTwo normals | - "There are 52 bits used for representing the mantissa (plus an eventual leading 1, see below)" - mantissaBits := Float precision - 1. - - normals := {Float pi. Float pi * 100.0. Float pi/ -100.0. Float fmax. Float fminNormalized}. - denormals := {0.0. Float negativeZero. Float fminNormalized predecessor. Float fmin negated}. - exceptionals := {Float nan. Float infinity. Float negativeInfinity.}. - normalPowersOfTwo := (-10 to: 10) collect: [:i | 1.0 timesTwoPower: i]. - denormalPowersOfTwo := (Float emin - mantissaBits to: Float emin - 1) collect: [:i | 1.0 timesTwoPower: i]. - - normals do: [:aNormalFloat | - "Assume the mantissa is written in least 52 bits of hex format, with an implied 1 on position 53" - self - assert: (((Integer readFrom: aNormalFloat hex readStream base: 16) bitAnd: 1< 0 -].! ! +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/25/2019 17:46:13'! +testPrimLess + self assert: (1.0 primTestLess: 1.0 successor). + self deny: (1.0 primTestLess: 1.0). + self deny: (1.0 primTestLess: 1.0 predecessor). + self assert: (0.0 primTestLess: Float fminNormalized). + self assert: (0.0 primTestLess: Float fminDenormalized). + self assert: (0.0 primTestLess: 1.0). + self assert: (Float fminNormalized negated primTestLess: 0.0). + self assert: (Float fminDenormalized negated primTestLess: 0.0). + self assert: (-1.0 primTestLess: 0.0). + self assert: (1.0 primTestLess: Float infinity). + self deny: (Float infinity primTestLess: Float infinity). + self assert: (Float negativeInfinity primTestLess: Float infinity). + self assert: (Float negativeInfinity primTestLess: -1.0). + self assert: (Float negativeInfinity primTestLess: Float negativeZero). + self deny: (Float negativeZero primTestLess: Float zero). + self assert: (Float zero primTestLess: Float fminDenormalized). + self assert: (Float fminDenormalized primTestLess: Float fminNormalized). + self assert: (Float fminNormalized primTestLess: 1.0). + self deny: (Float nan primTestLess: Float negativeInfinity). + self deny: (Float nan primTestLess: Float negativeZero). + self deny: (Float nan primTestLess: Float zero). + self deny: (Float nan primTestLess: 1.0). + self deny: (Float nan primTestLess: Float infinity). + self deny: (Float nan primTestLess: Float nan).! ! -!FloatTest methodsFor: 'tests - zero behavior' stamp: 'nice 1/27/2017 22:01'! -testCopySign - self assert: (0.0 copySignTo: 1) = 1. - self assert: (Float negativeZero copySignTo: 1) = -1. - self assertIsNegativeZero: (-1 copySignTo: 0.0). - self assertIsPositiveZero: (1 copySignTo: Float negativeZero).! ! +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/25/2019 17:47:25'! +testPrimLessEqual + self assert: (1.0 primTestLessEqual: 1.0 successor). + self assert: (1.0 primTestLessEqual: 1.0). + self deny: (1.0 primTestLessEqual: 1.0 predecessor). + self assert: (0.0 primTestLessEqual: Float fminNormalized). + self assert: (0.0 primTestLessEqual: Float fminDenormalized). + self assert: (0.0 primTestLessEqual: 1.0). + self assert: (Float fminNormalized negated primTestLessEqual: 0.0). + self assert: (Float fminDenormalized negated primTestLessEqual: 0.0). + self assert: (-1.0 primTestLessEqual: 0.0). + self assert: (1.0 primTestLessEqual: Float infinity). + self assert: (Float infinity primTestLessEqual: Float infinity). + self assert: (Float negativeInfinity primTestLessEqual: Float infinity). + self assert: (Float negativeInfinity primTestLessEqual: -1.0). + self assert: (Float negativeInfinity primTestLessEqual: Float negativeZero). + self assert: (Float negativeZero primTestLessEqual: Float zero). + self assert: (Float zero primTestLessEqual: Float fminDenormalized). + self assert: (Float fminDenormalized primTestLessEqual: Float fminNormalized). + self assert: (Float fminNormalized primTestLessEqual: 1.0). + self deny: (Float nan primTestLessEqual: Float negativeInfinity). + self deny: (Float nan primTestLessEqual: Float negativeZero). + self deny: (Float nan primTestLessEqual: Float zero). + self deny: (Float nan primTestLessEqual: 1.0). + self deny: (Float nan primTestLessEqual: Float infinity). + self deny: (Float nan primTestLessEqual: Float nan).! ! -!FloatTest methodsFor: 'tests - zero behavior' stamp: 'jmv 4/4/2019 14:27:15'! -testIsZero - self assert: 0.0 isZero. - self assert: -0.0 isZero. - self deny: 0.1 isZero.! ! +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/27/2019 15:26:33'! +testPrimMultiplyBy -!FloatTest methodsFor: 'tests - zero behavior' stamp: 'jmv 4/5/2019 08:27:21'! -testPositiveAndNegativeZero - self assert: Float negativeZero = Float zero description: 'Positive and negative zero are defined to be equal'. - self deny: -0.0 < 0.0 description: 'Positive and negative zero are defined to be equal'. - self deny: -0.0 > 0.0 description: 'Positive and negative zero are defined to be equal'. - self deny: Float negativeZero hex = Float zero hex description: 'Positive and negative zero are not the same!!'. - - self assertIsPositiveZero: 1.0 * 0.0. - self assertIsNegativeZero: 1.0 * -0.0. - self assertIsNegativeZero: -1.0 * 0.0. - self assertIsPositiveZero: -1.0 * -0.0. + self assert: (2.0 primTestMultiplyBy: 2.0) = 4.0. + self assert: (Float fminNormalized primTestMultiplyBy: 2.0) = (Float fminNormalized + Float fminNormalized). + self assert: (Float fminDenormalized primTestMultiplyBy: 2.0) = (Float fminDenormalized + Float fminDenormalized). + self assertIsPositiveZero: (1.0 primTestMultiplyBy: Float zero). + self assertIsPositiveZero: (Float zero primTestMultiplyBy: 1.0). + self assertIsNegativeZero: (1.0 primTestMultiplyBy: Float negativeZero). + self assertIsNegativeZero: (Float negativeZero primTestMultiplyBy: 1.0). + self assert: (1.0 primTestMultiplyBy: Float infinity) = Float infinity. + self assert: (Float infinity primTestMultiplyBy: 1.0) = Float infinity. + self assert: (1.0 primTestMultiplyBy: Float negativeInfinity) = Float negativeInfinity. + self assert: (Float negativeInfinity primTestMultiplyBy: 1.0) = Float negativeInfinity. + self assert: (1.0 primTestMultiplyBy: Float nan) isNaN. + self assert: (Float nan primTestMultiplyBy: 1.0) isNaN. + self assert: (Float nan primTestMultiplyBy: Float nan) isNaN.! ! - self assertIsPositiveZero: Float fmin / 4.0. - self assertIsNegativeZero: Float fmin / -4.0. - self assertIsNegativeZero: Float fmin negated / 4.0. - self assertIsPositiveZero: Float fmin negated / -4.0.! ! +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/25/2019 18:02:13'! +testPrimNotEqual -!FloatTest methodsFor: 'tests - zero behavior' stamp: 'jmv 4/4/2019 14:32:48'! -testZeroAbs - self assertIsPositiveZero: Float zero abs. 'the absolute value of a positive zero is zero'. - self assertIsPositiveZero: Float negativeZero abs. 'the absolute value of a negative zero is zero'.! ! - -!FloatTest methodsFor: 'tests - zero behavior' stamp: 'jmv 7/2/2019 11:52:32'! -testZeroRaisedToNegativePower - "this is a test related to http://bugs.squeak.org/view.php?id=6781" + | samples | + samples _ { Float negativeInfinity. -1.0. Float fminNormalized negated. Float fminDenormalized negated. Float fminDenormalized. Float fminNormalized. 1.0. Float infinity }. - self should: [0.0 raisedToInteger: -1] raise: ZeroDivide. - self assert: (0.0 raisedToInteger: -1) isExactly: Float infinity. - self should: [0.0 raisedTo: -1] raise: ZeroDivide. - self assert: (0.0 raisedTo: -1) isExactly: Float infinity. - self should: [0.0 raisedTo: -1.0] raise: ZeroDivide. - self assert: (0.0 raisedTo: -1.0) isExactly: Float infinity. + 1 to: samples size do: [ :i | + 1 to: samples size do: [ :j | + self assert: ((samples at: i) primTestNotEqual: (samples at: j)) ~= (i = j ) ]]. - self should: [-0.0 raisedToInteger: -1] raise: ZeroDivide. - self assert: (-0.0 raisedToInteger: -1) isExactly: Float negativeInfinity. - self should: [-0.0 raisedTo: -1] raise: ZeroDivide. - self assert: (-0.0 raisedTo: -1) isExactly: Float negativeInfinity. - self should: [-0.0 raisedTo: -1.0] raise: ZeroDivide. - self assert: (-0.0 raisedTo: -1.0) isExactly: Float negativeInfinity.! ! + self deny: (Float zero primTestNotEqual: Float negativeZero). + self deny: (Float negativeZero primTestNotEqual: Float zero). + self assert: (Float zero primTestNotEqual: Float nan). + self assert: (Float nan primTestNotEqual: Float zero). + self assert: (Float negativeZero primTestNotEqual: Float nan). + self assert: (Float nan primTestNotEqual: Float negativeZero). + self assert: (Float nan primTestNotEqual: Float nan). -!FloatTest methodsFor: 'tests - zero behavior' stamp: 'jmv 4/4/2019 14:28:40'! -testZeroSign - self assert: Float zero sign = 0. - self assert: Float negativeZero sign = -1 description: 'negative zero is a zero with non zero sign!!'! ! + 1 to: samples size do: [ :i | + self assert: ((samples at: i) primTestNotEqual: Float zero). + self assert: ((samples at: i) primTestNotEqual: Float negativeZero). + self assert: ((samples at: i) primTestNotEqual: Float nan). + self assert: (Float zero primTestNotEqual: (samples at: i)). + self assert: (Float negativeZero primTestNotEqual: (samples at: i)). + self assert: (Float nan primTestNotEqual: (samples at: i)) ].! ! -!FloatTest methodsFor: 'tests - zero behavior' stamp: 'jmv 4/4/2019 14:33:40'! -testZeroSignificandAsInteger - "This is about http://bugs.squeak.org/view.php?id=6990" +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/14/2019 13:57:07'! +testPrimSin - self assert: 0.0 significandAsInteger = 0. - self assert: -0.0 significandAsInteger = 0! ! + self verify: 0.0 primTestSin isTrigonometricallyEqualTo: 0.0. + self verify: (Float pi / 6) primTestSin isTrigonometricallyEqualTo: 1.0 sqrt / 2.0. + self verify: (Float pi / 4) primTestSin isTrigonometricallyEqualTo: 2.0 sqrt / 2.0. + self verify: (Float pi / 3) primTestSin isTrigonometricallyEqualTo: 3.0 sqrt / 2.0. + self verify: (Float pi / 2) primTestSin isTrigonometricallyEqualTo: 1.0! ! -!FloatTest methodsFor: 'tests - infinity behavior' stamp: 'sd 6/5/2005 08:30'! -testInfinity1 - "FloatTest new testInfinity1" +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/12/2019 14:31:19'! +testPrimSmallIntegerAsFloat + self assert: 7 asFloat = 7.0. + self assert: 0 asFloat = 0.0. + self assert: 1 asFloat = 1.0. + self assert: -1 asFloat = -1.0. + self assert: Float maxExactInteger asFloat = (Float maxExactInteger printString, '.0') asNumber. + self assert: Float maxExactInteger negated asFloat = (Float maxExactInteger negated printString, '.0') asNumber. + self assert: SmallInteger maxVal asFloat = (SmallInteger maxVal printString, '.0') asNumber. + self assert: SmallInteger minVal asFloat = (SmallInteger minVal printString, '.0') asNumber.! ! - | i1 i2 | +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/12/2019 14:27:58'! +testPrimSqrt - i1 := 10000 exp. - i2 := 1000000000 exp. - self assert: i1 isInfinite & i2 isInfinite & (i1 = i2). - "All infinities are equal. (This is a very substantial difference to NaN's, which are never equal." -! ! + self assert: 4.0 primTestSqrt = 2.0. + self assert: 0.0 primTestSqrt = 0.0. + self assert: Float negativeZero primTestSqrt = 0.0. + self assert: Float fminNormalized primTestSqrt squared = Float fminNormalized. + self assert: Float fminDenormalized primTestSqrt squared = Float fminDenormalized. + self assert: Float infinity primTestSqrt = Float infinity. + + "Seems to be #fail in workspaces, but for some BoxedFloat64, Cog seems to answer NaN. + Never mind. Both are valid. #primSqrt answers NaN in case of primitive failure." + self assertIsNaNorFail: -4.0 primTestSqrt. + self assertIsNaNorFail: Float fminNormalized negated primTestSqrt. + self assertIsNaNorFail: Float fminDenormalized negated primTestSqrt. + self assertIsNaNorFail: Float negativeInfinity primTestSqrt. + self assertIsNaNorFail: Float nan primTestSqrt.! ! -!FloatTest methodsFor: 'tests - infinity behavior' stamp: 'sd 6/5/2005 08:30'! -testInfinity2 - "FloatTest new testInfinity2" +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/27/2019 15:25:52'! +testPrimSubtract - | i1 i2 | - i1 := 10000 exp. - i2 := 1000000000 exp. - i2 := 0 - i2. " this is entirely ok. You can compute with infinite values." + self assert: (3.0 primTestSubtract: 1.0) = 2.0. + self assert: (Float fminNormalized primTestSubtract: Float fminDenormalized) < Float fminNormalized. + self assert: (Float fminNormalized primTestSubtract: Float fminDenormalized) - Float fminNormalized = Float fminDenormalized negated. + self assert: (1.0 primTestSubtract: Float zero) = 1.0. + self assert: (Float zero primTestSubtract: 1.0) = -1.0. + self assert: (1.0 primTestSubtract: Float negativeZero) = 1.0. + self assert: (Float negativeZero primTestSubtract: 1.0) = -1.0. + self assert: (1.0 primTestSubtract: Float infinity) = Float negativeInfinity. + self assert: (Float infinity primTestSubtract: 1.0) = Float infinity. + self assert: (1.0 primTestSubtract: Float negativeInfinity) = Float infinity. + self assert: (Float negativeInfinity primTestSubtract: 1.0) = Float negativeInfinity. + self assert: (1.0 primTestSubtract: Float nan) isNaN. + self assert: (Float nan primTestSubtract: 1.0) isNaN. + self assert: (Float nan primTestSubtract: Float nan) isNaN.! ! - self assert: i1 isInfinite & i2 isInfinite & i1 positive & i2 negative. - self deny: i1 = i2. - "All infinities are signed. Negative infinity is not equal to Infinity" -! ! +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/14/2019 13:53:28'! +testPrimTimesTwoPower -!FloatTest methodsFor: 'tests - infinity behavior' stamp: 'jmv 5/21/2020 22:51:06'! -testInfinityTruncated - self assert: Float infinity truncated isInfinite. - self assert: Float negativeInfinity truncated isInfinite.! ! + self assert: (Float fminNormalized timesTwoPower: -52) = Float fminDenormalized. + self assert: (Float fminDenormalized timesTwoPower: 52) = Float fminNormalized. + self assert: (Float fminNormalized timesTwoPower: -53) = 0.0. + self assert: (0.0 timesTwoPower: 53) = 0.0. -!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'sd 6/5/2005 08:31'! -testNaN1 - "FloatTest new testNaN1" + self assert: (Float fminNormalized timesTwoPower: 1022) = 1.0. + self assert: (Float fminDenormalized timesTwoPower: 1022+52) = 1.0 . + self assert: (1.0 timesTwoPower: -1022) = Float fminNormalized. + self assert: (2.0 predecessor timesTwoPower: 1023) = Float fmax. - self assert: Float nan == Float nan. - self deny: Float nan = Float nan. - "a NaN is not equal to itself." -! ! + self assert: (Float pi timesTwoPower: 13) mantissaPart = Float pi mantissaPart. + + self assert: (Float infinity timesTwoPower: -1023) = Float infinity. + self assert: (Float infinity timesTwoPower: -1024) = Float infinity. + self assert: (Float negativeInfinity timesTwoPower: -1023) = Float negativeInfinity. + self assert: (Float negativeInfinity timesTwoPower: -1024) = Float negativeInfinity. + self assert: (Float nan timesTwoPower: 2) isNaN.! ! -!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 4/4/2019 14:20:45'! -testNaN2 - "Two NaN values are always considered to be different. - On an little-endian machine (32 bit Intel), Float nan is 16rFFF80000 16r00000000. - On a big-endian machine (PowerPC), Float nan is 16r7FF80000 16r00000000. Changing - the bit pattern of the first word of a NaN produces another value that is still - considered equal to NaN. This test should work on both little endian and big - endian machines." +!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/12/2019 14:39:27'! +testPrimTruncated - "FloatTest new testNaN2" + self assert: 1.0 primTestTruncated == 1. + self assert: 1.1 primTestTruncated == 1. + self assert: 1.9 primTestTruncated == 1. + self assert: Float pi primTestTruncated == 3. + self assert: Float zero primTestTruncated = 0. + self assert: Float fminNormalized primTestTruncated = 0. + self assert: Float fminDenormalized primTestTruncated = 0. + self assert: Float infinity primTestTruncated = #fail. - | nan1 nan2 | - nan1 := Float nan copy. - nan2 := Float nan copy. + self assert: -1.0 primTestTruncated == -1. + self assert: -1.1 primTestTruncated == -1. + self assert: -1.9 primTestTruncated == -1. + self assert: Float pi negated primTestTruncated == -3. + self assert: Float negativeZero primTestTruncated = 0. + self assert: Float fminNormalized negated primTestTruncated = 0. + self assert: Float fminDenormalized negated primTestTruncated = 0. + self assert: Float negativeInfinity primTestTruncated = #fail. - "test two instances of NaN with the same bit pattern" - self deny: nan1 = nan2. - self deny: nan1 == nan2. - self deny: nan1 = nan1. - self assert: nan1 == nan1. + self assert: Float nan primTestTruncated = #fail. - "change the bit pattern of nan1" - self assert: nan1 size = 2. - self assert: (nan1 at: 2) = 0. - nan1 at: 1 put: (nan1 at: 1) + 999. - self assert: nan1 isNaN. - self assert: nan2 isNaN. - self deny: (nan1 at: 1) = (nan2 at: 1). + "Only if SmallInteger primitive result is enough to hold the result" + SmallInteger maxVal >= Float maxExactInteger ifTrue: [ + self assert: (Float maxExactInteger + 0.0) primTestTruncated == Float maxExactInteger. + self assert: (Float maxExactInteger + 0.9) primTestTruncated == Float maxExactInteger. + self assert: (Float maxExactInteger - 0.1) primTestTruncated == Float maxExactInteger. + self assert: (Float maxExactInteger negated + 0.0) primTestTruncated == Float maxExactInteger negated. + self assert: (Float maxExactInteger negated - 0.9) primTestTruncated == Float maxExactInteger negated. + self assert: (Float maxExactInteger negated + 0.1) primTestTruncated == Float maxExactInteger negated ]. - "test two instances of NaN with different bit patterns" - self deny: nan1 = nan2. - self deny: nan1 == nan2. - self deny: nan1 = nan1. - self assert: nan1 == nan1! ! + self assert: SmallInteger maxVal asFloat predecessor asTrueFraction truncated class = SmallInteger. + self assert: SmallInteger maxVal asFloat predecessor primTestTruncated = SmallInteger maxVal asFloat predecessor asTrueFraction truncated. + self assert: (SmallInteger maxVal+1) asFloat successor asTrueFraction truncated class = LargePositiveInteger. + self assert: (SmallInteger maxVal+1) asFloat successor primTestTruncated = # fail. + "Depends on rounding to nearest Float. This could change depending on SmallInteger maxVal. Currently false in 64 bits Spur image, but true in 32 bits Spur and V3 images." + SmallInteger maxVal asFloat asTrueFraction truncated class = SmallInteger + ifTrue: [ self assert: SmallInteger maxVal asFloat primTestTruncated = SmallInteger maxVal asFloat asTrueFraction truncated ] + ifFalse: [ self assert: SmallInteger maxVal asFloat primTestTruncated = #fail ]. -!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 4/4/2019 14:21:07'! -testNaN3 - "FloatTest new testNaN3" + self assert: SmallInteger minVal asFloat successor asTrueFraction truncated class = SmallInteger. + self assert: SmallInteger minVal asFloat successor primTestTruncated = SmallInteger minVal asFloat successor asTrueFraction truncated. + self assert: (SmallInteger minVal-1) asFloat predecessor asTrueFraction truncated class = LargeNegativeInteger. + self assert: (SmallInteger minVal-1) asFloat predecessor primTestTruncated = # fail. + "Depends on rounding to nearestFloat. This could change depending on SmallInteger maxVal. Currently true in 64 bits Spur image, and in 32 bits Spur and V3 images." + SmallInteger minVal asFloat asTrueFraction truncated class = SmallInteger + ifTrue: [ self assert: SmallInteger minVal asFloat primTestTruncated = SmallInteger minVal asFloat asTrueFraction truncated ] + ifFalse: [ self assert: SmallInteger minVal asFloat primTestTruncated = #fail ]. +! ! - | set item identitySet | - set _ Set new. - set add: (item _ Float nan). - self deny: (set includes: item). - identitySet _ IdentitySet new. - identitySet add: (item _ Float nan). - self assert: (identitySet includes: item).! ! +!FractionTest methodsFor: 'private' stamp: 'jmv 10/11/2011 22:12'! +assert: a classAndValueEquals: b + self assert: a class = b class. + self assert: a = b! ! -!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 4/23/2019 18:20:18'! -testNaN4 - "FloatTest new testNaN4" +!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/3/2018 15:19:28'! +testDegreeCos2 + "self run: #testDegreeCos" + + self shouldnt: [ (4/3) degreeCos] raise: Error. + self assert: (1/3) degreeCos printString = '0.9999830768577442'! ! - | dict | - dict _ Dictionary new. - dict - at: Float nan - put: #NaN. - self deny: (dict includesKey: Float nan).! ! +!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/3/2018 15:19:31'! +testDegreeSin2 + "self run: #testDegreeSin" + + self shouldnt: [ (4/3) degreeSin] raise: Error. + self assert: (1/3) degreeSin printString = '0.005817731354993834'.! ! -!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 3/13/2012 12:34'! -testNaNCompare - "IEEE 754 states that NaN cannot be ordered. - As a consequence, every arithmetic comparison involving a NaN SHOULD return false. - Except the is different test (~=). - This test does verify this rule" - - | compareSelectors theNaN anotherNaN comparand brokenMethods warningMessage | - compareSelectors := #(#< #<= #> #>= #=). - theNaN := Float nan. - anotherNaN := Float infinity - Float infinity. - comparand := {1. 2.3. Float infinity. 2/3. 1.25. 2 raisedTo: 50}. - comparand := comparand , (comparand collect: [:e | e negated]). - comparand := comparand , {theNaN. anotherNaN}. +!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/11/2011 22:27'! +testExactRaisedTo + " + FractionTest new testExactRaisedTo + " + | f | + self assert: (4/9 raisedTo: 1/2) classAndValueEquals: 2/3. + self assert: (9/4 raisedTo: 1/2) classAndValueEquals: 3/2. + #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :a :b | + f _ a / b. + self assert: (f squared raisedTo: 1/2) classAndValueEquals: f. + self assert: (f negated squared raisedTo: 1/2) classAndValueEquals: f. + f _ b / a. + self assert: (f squared raisedTo: 1/2) classAndValueEquals: f. + self assert: (f negated squared raisedTo: 1/2) classAndValueEquals: f ]. -"do a first pass to collect all broken methods" - brokenMethods := Set new. - comparand do: [:comp | - compareSelectors do: [:op | - (theNaN perform: op with: comp) ifTrue: [brokenMethods add: (theNaN class lookupSelector: op)]. - (comp perform: op with: theNaN) ifTrue: [brokenMethods add: (comp class lookupSelector: op)]]. - (theNaN ~= comp) ifFalse: [brokenMethods add: (theNaN class lookupSelector: #~=)]. - (comp ~= theNaN) ifFalse: [brokenMethods add: (comp class lookupSelector: #~=)]]. - -"build a warning message to tell about all broken methods at once" - warningMessage := String streamContents: [:s | - s nextPutAll: 'According to IEEE 754 comparing with a NaN should always return false, except ~= that should return true.'; newLine. - s nextPutAll: 'All these methods failed to do so. They are either broken or call a broken one'. - brokenMethods do: [:e | s newLine; print: e methodClass; nextPutAll: '>>'; print: e selector]]. - -"Redo the tests so as to eventually open a debugger on one of the failures" - brokenMethods := Set new. - comparand do: [:comp2 | - compareSelectors do: [:op2 | - self deny: (theNaN perform: op2 with: comp2) description: warningMessage. - self deny: (comp2 perform: op2 with: theNaN) description: warningMessage]. - self assert: (theNaN ~= comp2) description: warningMessage. - self assert: (comp2 ~= theNaN) description: warningMessage].! ! + self assert: (8/27 raisedTo: 1/3) classAndValueEquals: 2/3. + self assert: (27/8 raisedTo: 1/3) classAndValueEquals: 3/2. + #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :a :b | + f _ a / b. + self assert: ((f raisedTo: 3) raisedTo: 1/3) classAndValueEquals: f. + self assert: ((f negated raisedTo: 3) raisedTo: 1/3) classAndValueEquals: f negated. + f _ b / a. + self assert: ((f raisedTo: 3) raisedTo: 1/3) classAndValueEquals: f. + self assert: ((f negated raisedTo: 3) raisedTo: 1/3) classAndValueEquals: f negated ]. -!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 8/1/2019 18:12:56'! -testNaNPropagationBinary - "Any operation should propagate NaN" - | s a c | - s _ Set new. - s addAll: Number selectors. - s addAll: Float selectors. - s addAll: BoxedFloat64 selectors. - s addAll: SmallFloat64 selectors. - s _ s select: [ :sel | sel numArgs = 1 ]. - s removeAll: #(#at: #basicAt: #ifNotZero: smoothIsAbsBelow:). - a _ s asArray sort. - a do: [ :sel | - { 0. 0.0. 1/3. 1. 1.0. 2. 2.0. Float nan } do: [ :op1 | - { 0. 0.0. 1/3. 1. 1.0. 2. 2.0. Float nan } do: [ :op2 | - op1 isNaN | op2 isNaN ifTrue: [ - c _ [ op1 perform: sel with: op2 ] on: Error do: [ #error ]. - self assert: (c isNumber not or: [c isNaN]) ]]]].! ! + self assert: (4/9 raisedTo: 3/2) classAndValueEquals: 8/27. + self assert: (8/27 raisedTo: 2/3) classAndValueEquals: 4/9. + #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :a :b | + f _ a / b. + self assert: ((f raisedTo: 3) raisedTo: 2/3) classAndValueEquals: f*f. + self assert: ((f raisedTo: 2) raisedTo: 3/2) classAndValueEquals: f*f*f. + self assert: ((f negated raisedTo: 3) raisedTo: 2/3) classAndValueEquals: f*f. + self assert: ((f negated raisedTo: 2) raisedTo: 3/2) classAndValueEquals: f*f*f. + f _ b / a. + self assert: ((f raisedTo: 3) raisedTo: 2/3) classAndValueEquals: f*f. + self assert: ((f raisedTo: 2) raisedTo: 3/2) classAndValueEquals: f*f*f. + self assert: ((f negated raisedTo: 3) raisedTo: 2/3) classAndValueEquals: f*f. + self assert: ((f negated raisedTo: 2) raisedTo: 3/2) classAndValueEquals: f*f*f ]. -!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 8/1/2019 18:39:54'! -testNaNPropagationUnary - "Any operation should propagate NaN" - | s a c | - s _ Set new. - s addAll: Number selectors. - s addAll: Float selectors. - s addAll: BoxedFloat64 selectors. - s addAll: SmallFloat64 selectors. - s _ s select: [ :sel | sel numArgs = 0 ]. - s removeAll: #(#asIEEE32BitWord #byteSize #hash #identityHash #mantissaBits #signBit #smoothStep #exponentBits #imaginary #exponent primTestExponent). - a _ s asArray sort. - a do: [ :sel | - c _ [ Float nan perform: sel ] on: Error do: [ #error ]. - self assert: (c isNumber not or: [c isNaN]) ].! ! + self assert: (32/243 raisedTo: 3/5) classAndValueEquals: 8/27. + self assert: (8/27 raisedTo: 5/3) classAndValueEquals: 32/243. + #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :a :b | + f _ a / b. + self assert: ((f raisedTo: 5) raisedTo: 3/5) classAndValueEquals: f*f*f. + self assert: ((f raisedTo: 3) raisedTo: 5/3) classAndValueEquals: f*f*f*f*f. + self assert: ((f negated raisedTo: 5) raisedTo: 3/5) classAndValueEquals: (f*f*f) negated. + self assert: ((f negated raisedTo: 3) raisedTo: 5/3) classAndValueEquals: (f*f*f*f*f) negated. -!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'jmv 5/21/2020 22:51:38'! -testNaNTruncated - self assert: Float nan truncated isNaN.! ! + self assert: ((f raisedTo: -5) raisedTo: 3/5) classAndValueEquals: 1/(f*f*f). + self assert: ((f raisedTo: -3) raisedTo: 5/3) classAndValueEquals: 1/(f*f*f*f*f). + self assert: ((f negated raisedTo: -5) raisedTo: 3/5) classAndValueEquals: -1/(f*f*f). + self assert: ((f negated raisedTo: -3) raisedTo: 5/3) classAndValueEquals: -1/(f*f*f*f*f). + self assert: ((f raisedTo: 5) raisedTo: -3/5) classAndValueEquals: 1/(f*f*f). + self assert: ((f raisedTo: 3) raisedTo: -5/3) classAndValueEquals: 1/(f*f*f*f*f). + self assert: ((f negated raisedTo: 5) raisedTo: -3/5) classAndValueEquals: -1/(f*f*f). + self assert: ((f negated raisedTo: 3) raisedTo: -5/3) classAndValueEquals: -1/(f*f*f*f*f). -!FloatTest methodsFor: 'tests - NaN behavior' stamp: 'nice 3/14/2008 23:42'! -testNaNisLiteral - self deny: Float nan isLiteral description: 'there is no literal representation of NaN'! ! + "No exact result => Float result" + self assert: ((f raisedTo: 3) +1 raisedTo: 5/3) isFloat. + self assert: ((f negated raisedTo: 3) -1 raisedTo: 5/3) isFloat. -!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'jmv 4/4/2019 14:02:34'! -test32bitConversion - "Except for NaN, we can convert a 32bits float to a 64bits float exactly. - Thus we can convert the 64bits float to the original 32bits float pattern." - - #( - 16r0 "zero" - 16r80000000 "negative zero" - 16r1 "min denormal" - 16r12345 "a denormal" - 16r801FEDCB "a negative denormal" - 16r7FFFFF "largest denormal" - 16r800000 "smallest normal" - 16r468ACDEF "a normal float" - 16rCABD1234 "a negative normal float" - 16r7F7FFFFF "largest finite float" - 16r7F800000 "positive infinity" - 16rFF800000 "negative infinity" - 16r803FFFFC - 16r803FFFFD - ) - do: [ :originalWord | self assert: (Float fromIEEE32Bit: originalWord) asIEEE32BitWord = originalWord ]! ! + f _ b / a. + self assert: ((f raisedTo: 5) raisedTo: 3/5) classAndValueEquals: f*f*f. + self assert: ((f raisedTo: 3) raisedTo: 5/3) classAndValueEquals: f*f*f*f*f. + self assert: ((f negated raisedTo: 5) raisedTo: 3/5) classAndValueEquals: (f*f*f) negated. + self assert: ((f negated raisedTo: 3) raisedTo: 5/3) classAndValueEquals: (f*f*f*f*f) negated. -!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'jmv 9/3/2020 17:12:44'! -test32bitConversion2 - "This tests the rounding done when going from 64bit Float to 32bit Float - self new test32bitConversion2 + "No exact result => Float result" + self assert: ((f raisedTo: 3) +1 raisedTo: 5/3) isFloat. + self assert: ((f negated raisedTo: 3) -1 raisedTo: 5/3) isFloat ].! ! + +!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/11/2011 22:12'! +testExactSqrt + " + FractionTest new testExactSqrt " + | f | + self assert: (4/9) sqrt classAndValueEquals: 2/3. + #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :i :j | + f _ i / j. + self assert: f squared sqrt classAndValueEquals: f. + f _ j / i. + self assert: f squared sqrt classAndValueEquals: f ]! ! - | pi32 pi32Predecessor roundingTo32Border roundingBorderPrev roundingBorderSuc aux roundedByConversion | - "Pick two neighbors in the 32-bit Float world" - pi32 _ Float fromIEEE32Bit: Float pi asIEEE32BitWord. - pi32Predecessor _ Float fromIEEE32Bit: Float pi asIEEE32BitWord-1. - "Find the middle value in the 64-bit Float world, and both its neighbors" - roundingTo32Border _ pi32 + pi32Predecessor / 2.0. - roundingBorderPrev _ roundingTo32Border predecessor. - roundingBorderSuc _ roundingTo32Border successor. +!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'nice 12/11/2012 19:56'! +testFloorLog + self assert: (1/100 floorLog: 10) = -2. + self assert: (((2 raisedTo: Float emax + 11)/3) floorLog: 10) + = ((Float emax + 11)*2 log - 3 log) floor description: 'Fraction>>log should not overflow'. + self assert: ((3/(2 raisedTo: Float precision - Float emin)) floorLog: 10) + = ((Float emin - Float precision)*2 log + 3 log) floor description: 'Fraction>>log should not underflow'! ! - "64 bit middle value is not like any of the 32 bit values. Same for neighbors." - self deny: roundingTo32Border mantissaPart hex = pi32 mantissaPart hex. - self deny: roundingTo32Border mantissaPart hex = pi32Predecessor mantissaPart hex. - self deny: roundingBorderPrev mantissaPart hex = pi32Predecessor mantissaPart hex. - self deny: roundingBorderPrev mantissaPart hex = pi32 mantissaPart hex. - self deny: roundingBorderSuc mantissaPart hex = pi32Predecessor mantissaPart hex. - self deny: roundingBorderSuc mantissaPart hex = pi32 mantissaPart hex. +!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'nice 12/11/2012 22:27'! +testFloorLogExactness - "Conversion to 32 bit gives appropriate 32 bit value, done #asIEEE32BitWord or done by FloatArray." - roundedByConversion _ Float fromIEEE32Bit: roundingTo32Border asIEEE32BitWord. - self assert: roundedByConversion mantissaPart hex = pi32Predecessor mantissaPart hex. - aux _ Float32Array new: 1. aux at: 1 put: roundingTo32Border. roundedByConversion _ aux at: 1. - self assert: roundedByConversion mantissaPart hex = pi32Predecessor mantissaPart hex. + 1 + (Float fminDenormalized floorLog: 10) to: -1 do: [:n | + self assert: ((10 raisedTo: n) floorLog: 10) = n]. - "Conversion to 32 bit gives appropriate 32 bit value, done #asIEEE32BitWord or done by FloatArray." - roundedByConversion _ Float fromIEEE32Bit: roundingBorderPrev asIEEE32BitWord. - self assert: roundedByConversion mantissaPart hex = pi32Predecessor mantissaPart hex. - aux _ Float32Array new: 1. aux at: 1 put: roundingBorderPrev. roundedByConversion _ aux at: 1. - self assert: roundedByConversion mantissaPart hex = pi32Predecessor mantissaPart hex. + "Float version is not exact for at least 2 reasons: + 1/(10 raisedTo: n) asFloat is not exact + (aFloat log: radix) is not exact - "Conversion to 32 bit gives appropriate 32 bit value, done #asIEEE32BitWord or done by FloatArray." - roundedByConversion _ Float fromIEEE32Bit: roundingBorderSuc asIEEE32BitWord. - self assert: roundedByConversion mantissaPart hex = pi32 mantissaPart hex. - aux _ Float32Array new: 1. aux at: 1 put: roundingBorderSuc. roundedByConversion _ aux at: 1. - self assert: roundedByConversion mantissaPart hex = pi32 mantissaPart hex! ! + (1 + (Float fminDenormalized floorLog: 10) to: -1) count: [:n | + ((10 raisedTo: n) asFloat floorLog: 10) ~= n]." + ! ! -!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'nice 5/30/2006 02:34'! -test32bitGradualUnderflow - "method asIEEE32BitWord did not respect IEEE gradual underflow" - - | conv expected exponentPart | - - "IEEE 32 bits Float have 1 bit sign/8 bit exponent/23 bits of mantissa after leading 1 - 2r1.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2reeeeeeee-127) * sign - except when 2reeeeeeee isZero, which is a gradual underflow: - 2r0.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2r00000000-126) * sign - and when 2reeeeeeee = 255, which is infinity if mantissa all zero or nan otherwise" - - "case 1: This example is the first gradual underflow case" - conv := 2r0.11111111111111111111111e-126 asIEEE32BitWord. - - "expected float encoded as sign/exponent/mantissa (whithout leading 1 or 0)" - exponentPart := 0. - expected := exponentPart bitOr: 2r11111111111111111111111. - self assert: expected = conv. - - "case 2: smallest number" - conv := 2r0.00000000000000000000001e-126 asIEEE32BitWord. - expected := exponentPart bitOr: 2r1. - self assert: expected = conv. - - "case 3: round to nearest even also in underflow cases... here round to upper" - conv := 2r0.000000000000000000000011e-126 asIEEE32BitWord. - expected := exponentPart bitOr: 2r10. - self assert: expected = conv. - - "case 4: round to nearest even also in underflow cases... here round to lower" - conv := 2r0.000000000000000000000101e-126 asIEEE32BitWord. - expected := exponentPart bitOr: 2r10. - self assert: expected = conv. - - "case 5: round to nearest even also in underflow cases... here round to upper" - conv := 2r0.0000000000000000000001011e-126 asIEEE32BitWord. - expected := exponentPart bitOr: 2r11. - self assert: expected = conv. - ! ! +!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:38'! +testInexactRaisedTo + " + FractionTest new testInexactRaisedTo + " + self assert: (((1 << 1024 + 1) / (1 << 1024 + 3)) raisedTo: 1/3) = 1.0. + self assert: (((1 << 1024 + 1) / (1 << 1024 + 3)) negated raisedTo: 1/3) = -1.0! ! -!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'jmv 4/4/2019 14:15:16'! -test32bitInfinities - | infinityBits negativeInfinityBits | - infinityBits _ '01111111100000000000000000000000'. - self assert: (Float infinity asIEEE32BitWord printStringBase: 2 length: 32 padded: true) = infinityBits. - self assert: (Float fromIEEE32Bit: (Integer readFrom: infinityBits readStream base: 2)) hex = Float infinity hex. - negativeInfinityBits _ '11111111100000000000000000000000'. - self assert: (Float negativeInfinity asIEEE32BitWord printStringBase: 2 length: 32 padded: true) = negativeInfinityBits. - self assert: (Float fromIEEE32Bit: (Integer readFrom: negativeInfinityBits readStream base: 2)) hex = Float negativeInfinity hex.! ! +!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:27'! +testInexactSqrt + " + FractionTest new testInexactSqrt + " + self assert: ((1 << 1024 + 1) / (1 << 1024 + 3)) sqrt = 1.0! ! -!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'jmv 4/4/2019 14:16:16'! -test32bitNaN - | nanstr | - - "check the NaN string representation conforms to IEEE 754" - nanstr := Float nan asIEEE32BitWord printStringBase: 2 length: 32 padded: true. - self - assert: (#($0 $1) includes: (nanstr at: 1)); - assert: (nanstr copyFrom: 2 to: 9) = '11111111'; - assert: (#($0 $1) includes: (nanstr at: 10)); "accept both quiet and signalled NaNs" - assert: ((nanstr copyFrom: 11 to: 32) reject: [ :c | #($0 $1) includes: c ]) isEmpty. - - "check a correct quiet NaN is created from a string" - self assert: (Float fromIEEE32Bit: - (Integer readFrom: '01111111110000000000000000000000' readStream base: 2)) isNaN! ! +!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/18/2018 10:42:49'! +testLn + self verify: (1/100) ln isWithinOneFloatAwayFrom: -2 * 10 ln. + self verify: ((2 raisedTo: Float emax + 11) / 3) ln isWithinOneFloatAwayFrom: (Float emax + 11) * 2 ln - 3 ln. + self verify: (3 / (2 raisedTo: Float precision - Float emin)) ln isWithinOneFloatAwayFrom: (Float emin - Float precision) * 2 ln + 3 ln! ! -!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'nice 5/30/2006 00:07'! -test32bitRoundingMode - "method asIEEE32BitWord did not respect IEEE default rounding mode" +!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/18/2018 10:45:24'! +testLog + self assert: (1/100) log = -2. + self verify: ((2 raisedTo: Float emax + 11) / 3) log isWithinOneFloatAwayFrom: (Float emax + 11) * 2 log - 3 log. + self verify: (3 / (2 raisedTo: Float precision - Float emin)) log isWithinOneFloatAwayFrom: (Float emin - Float precision) * 2 log + 3 log.! ! + +!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'nice 10/19/2011 20:48'! +testNthRoot + self assert: ((-2 raisedTo: 35) / (3 raisedTo: 20) raisedTo: 1/5) equals: (-2 raisedTo: 7) / (3 raisedTo: 4). + self assert: (1 / (1 << 2000) raisedTo: 1/100) equals: 1 / (1 << 20)! ! + +!FractionTest methodsFor: 'tests - printing' stamp: 'nice 7/24/2010 18:43'! +testFractionPrinting + + self assert: (353/359) printString = '(353/359)'. + self assert: ((2/3) printStringBase: 2) = '(10/11)'. + self assert: ((2/3) storeStringBase: 2) = '(2r10/2r11)'. + self assert: ((5/7) printStringBase: 3) = '(12/21)'. + self assert: ((5/7) storeStringBase: 3) = '(3r12/3r21)'. + self assert: ((11/13) printStringBase: 4) = '(23/31)'. + self assert: ((11/13) storeStringBase: 4) = '(4r23/4r31)'. + self assert: ((17/19) printStringBase: 5) = '(32/34)'. + self assert: ((17/19) storeStringBase: 5) = '(5r32/5r34)'. + self assert: ((23/29) printStringBase: 6) = '(35/45)'. + self assert: ((23/29) storeStringBase: 6) = '(6r35/6r45)'. + self assert: ((31/37) printStringBase: 7) = '(43/52)'. + self assert: ((31/37) storeStringBase: 7) = '(7r43/7r52)'. + self assert: ((41/43) printStringBase: 8) = '(51/53)'. + self assert: ((41/43) storeStringBase: 8) = '(8r51/8r53)'. + self assert: ((47/53) printStringBase: 9) = '(52/58)'. + self assert: ((47/53) storeStringBase: 9) = '(9r52/9r58)'. + self assert: ((59/61) printStringBase: 10) = '(59/61)'. + self assert: ((59/61) storeStringBase: 10) = '(59/61)'. + self assert: ((67/71) printStringBase: 11) = '(61/65)'. + self assert: ((67/71) storeStringBase: 11) = '(11r61/11r65)'. + self assert: ((73/79) printStringBase: 12) = '(61/67)'. + self assert: ((73/79) storeStringBase: 12) = '(12r61/12r67)'. + self assert: ((83/89) printStringBase: 13) = '(65/6B)'. + self assert: ((83/89) storeStringBase: 13) = '(13r65/13r6B)'. + self assert: ((97/101) printStringBase: 14) = '(6D/73)'. + self assert: ((97/101) storeStringBase: 14) = '(14r6D/14r73)'. + self assert: ((103/107) printStringBase: 15) = '(6D/72)'. + self assert: ((103/107) storeStringBase: 15) = '(15r6D/15r72)'. + self assert: ((109/113) printStringBase: 16) = '(6D/71)'. + self assert: ((109/113) storeStringBase: 16) = '(16r6D/16r71)'. + self assert: ((127/131) printStringBase: 17) = '(78/7C)'. + self assert: ((127/131) storeStringBase: 17) = '(17r78/17r7C)'. + self assert: ((137/139) printStringBase: 18) = '(7B/7D)'. + self assert: ((137/139) storeStringBase: 18) = '(18r7B/18r7D)'. + self assert: ((149/151) printStringBase: 19) = '(7G/7I)'. + self assert: ((149/151) storeStringBase: 19) = '(19r7G/19r7I)'. + self assert: ((157/163) printStringBase: 20) = '(7H/83)'. + self assert: ((157/163) storeStringBase: 20) = '(20r7H/20r83)'. + self assert: ((167/173) printStringBase: 21) = '(7K/85)'. + self assert: ((167/173) storeStringBase: 21) = '(21r7K/21r85)'. + self assert: ((179/181) printStringBase: 22) = '(83/85)'. + self assert: ((179/181) storeStringBase: 22) = '(22r83/22r85)'. + self assert: ((191/193) printStringBase: 23) = '(87/89)'. + self assert: ((191/193) storeStringBase: 23) = '(23r87/23r89)'. + self assert: ((197/199) printStringBase: 24) = '(85/87)'. + self assert: ((197/199) storeStringBase: 24) = '(24r85/24r87)'. + self assert: ((211/223) printStringBase: 25) = '(8B/8N)'. + self assert: ((211/223) storeStringBase: 25) = '(25r8B/25r8N)'. + self assert: ((227/229) printStringBase: 26) = '(8J/8L)'. + self assert: ((227/229) storeStringBase: 26) = '(26r8J/26r8L)'. + self assert: ((233/239) printStringBase: 27) = '(8H/8N)'. + self assert: ((233/239) storeStringBase: 27) = '(27r8H/27r8N)'. + self assert: ((241/251) printStringBase: 28) = '(8H/8R)'. + self assert: ((241/251) storeStringBase: 28) = '(28r8H/28r8R)'. + self assert: ((257/263) printStringBase: 29) = '(8P/92)'. + self assert: ((257/263) storeStringBase: 29) = '(29r8P/29r92)'. + self assert: ((269/271) printStringBase: 30) = '(8T/91)'. + self assert: ((269/271) storeStringBase: 30) = '(30r8T/30r91)'. + self assert: ((277/281) printStringBase: 31) = '(8T/92)'. + self assert: ((277/281) storeStringBase: 31) = '(31r8T/31r92)'. + self assert: ((283/293) printStringBase: 32) = '(8R/95)'. + self assert: ((283/293) storeStringBase: 32) = '(32r8R/32r95)'. + self assert: ((307/311) printStringBase: 33) = '(9A/9E)'. + self assert: ((307/311) storeStringBase: 33) = '(33r9A/33r9E)'. + self assert: ((313/317) printStringBase: 34) = '(97/9B)'. + self assert: ((313/317) storeStringBase: 34) = '(34r97/34r9B)'. + self assert: ((331/337) printStringBase: 35) = '(9G/9M)'. + self assert: ((331/337) storeStringBase: 35) = '(35r9G/35r9M)'. + self assert: ((347/349) printStringBase: 36) = '(9N/9P)'. + self assert: ((347/349) storeStringBase: 36) = '(36r9N/36r9P)'. + + self assert: ((-2/3) printStringBase: 2) = '(-10/11)'. + self assert: ((-2/3) storeStringBase: 2) = '(-2r10/2r11)'. + self assert: ((5 / -7) printStringBase: 3) = '(-12/21)'. + self assert: ((5 / -7) storeStringBase: 3) = '(-3r12/3r21)'. +! ! + +!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:56'! +testIntegerWholeDivision - | conv expected exponentPart | + self assert: 4 / (2/3) classAndValueEquals: 6. - "IEEE 32 bits Float have 1 bit sign/8 bit exponent/23 bits of mantissa after leading 1 - 2r1.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2reeeeeeee-127) * sign - except when 2reeeeeeee isZero, which is a gradual underflow: - 2r0.mmmmmmmmmmmmmmmmmmmmmmm * (2 raisedTo: 2r00000000-127) * sign - and when 2reeeeeeee = 255, which is infinity if mantissa all zero or nan otherwise" + self assert: 4 / (-2/3) classAndValueEquals: -6. - "This example has two extra bits in mantissa for testing rounding mode - case 1: should obviously round to upper" - conv := 2r1.0000000000000000000000111e25 asIEEE32BitWord. + self assert: -4 / (-2/3) classAndValueEquals: 6. - "expected float encoded as sign/exponent/mantissa (whithout leading 1)" - exponentPart := 25+127 bitShift: 23. "127 is 2r01111111 or 16r7F" - expected := exponentPart bitOr: 2r10. - self assert: expected = conv. + self assert: -4 / (2/3) classAndValueEquals: -6.! ! + +!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:56'! +testIntegerWholeMultiplication - "case 2: exactly in the mid point of two 32 bit float: round toward nearest even (to upper)" - conv := 2r1.0000000000000000000000110e25 asIEEE32BitWord. - expected := exponentPart bitOr: 2r10. - self assert: expected = conv. + self assert: 4 * (3/2) classAndValueEquals: 6. - "case 3: exactly in the mid point of two 32 bit float: round toward nearest even (to lower)" - conv := 2r1.0000000000000000000000010e25 asIEEE32BitWord. - expected := exponentPart bitOr: 2r0. - self assert: expected = conv. + self assert: 4 * (-3/2) classAndValueEquals: -6. - "case 4: obviously round to upper" - conv := 2r1.0000000000000000000000011e25 asIEEE32BitWord. - expected := exponentPart bitOr: 2r1. - self assert: expected = conv. -! ! + self assert: -4 * (-3/2) classAndValueEquals: 6. + + self assert: -4 * (3/2) classAndValueEquals: -6.! ! -!FloatTest methodsFor: 'tests - 32 bit Single Precision' stamp: 'jmv 4/5/2019 16:24:45'! -test32bitZeros - | negativeZeroBits zeroBits | - zeroBits _ '00000000000000000000000000000000'. - self assert: (Float zero asIEEE32BitWord printStringBase: 2 length: 32 padded: true) = zeroBits. - self assertIsPositiveZero: (Float fromIEEE32Bit: (Integer readFrom: zeroBits readStream base: 2)). - negativeZeroBits _ '10000000000000000000000000000000'. - self assert: (Float negativeZero asIEEE32BitWord printStringBase: 2 length: 32 padded: true) = negativeZeroBits. - self assertIsNegativeZero: (Float fromIEEE32Bit: (Integer readFrom: negativeZeroBits readStream base: 2)).! ! +!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:56'! +testReciprocal -!FloatTest methodsFor: 'helpers' stamp: 'jmv 4/24/2019 11:48:04'! -assert: aFloatingPointNumber isExactly: otherFloatingPointNumber + self + assert: (1/2) reciprocal classAndValueEquals: 2; + assert: (3/4) reciprocal equals: (4/3); + assert: (-1/3) reciprocal classAndValueEquals: -3; + assert: (-3/5) reciprocal equals: (-5/3)! ! - "Both aFloatingPointNumber and otherFloatingPointNumber must be instances - of our #classTested. Check that and fail if they aren't." +!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:56'! +testWholeDifference + + self assert: (2/3) - (5/3) classAndValueEquals: -1.! ! - self assert: (aFloatingPointNumber class inheritsFrom: Float). - self assert: (otherFloatingPointNumber class inheritsFrom: Float). - self assert: aFloatingPointNumber = otherFloatingPointNumber. - self assert: otherFloatingPointNumber = aFloatingPointNumber. - self assert: aFloatingPointNumber hex = otherFloatingPointNumber hex! ! +!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:56'! +testWholeDivision + + self assert: (3/2) / (3/4) classAndValueEquals: 2. + + self assert: (3/2) / (-3/4) classAndValueEquals: -2. + + self assert: (-3/2) / (-3/4) classAndValueEquals: 2. + + self assert: (-3/2) / (3/4) classAndValueEquals: -2.! ! -!FloatTest methodsFor: 'helpers' stamp: 'jmv 2/28/2019 16:13:30'! -assertIsNaNorFail: aFloatOrSymbol - "Assert that aFloat is NaN or #fail. - For some BoxedFloat64, primitive 55 (sqrt) faile, unless jitter, where it answers NaN. We consider both values valid." - self assert: (aFloatOrSymbol = #fail or: [ aFloatOrSymbol isNaN ])! ! +!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:57'! +testWholeMultiplication + + self assert: (3/2) * (4/3) classAndValueEquals: 2. + + self assert: (3/2) * (-4/3) classAndValueEquals: -2. + + self assert: (-3/2) * (-4/3) classAndValueEquals: 2. + + self assert: (-3/2) * (4/3) classAndValueEquals: -2.! ! -!FloatTest methodsFor: 'helpers' stamp: 'jmv 10/3/2018 15:43:27'! -assertIsNegativeZero: aFloat - "Assert that aFloat is Float negativeZero" - self assert: aFloat hex = Float negativeZero hex! ! +!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:57'! +testWholeSum + + self assert: (5/3) + (1/3) classAndValueEquals: 2.! ! -!FloatTest methodsFor: 'helpers' stamp: 'jmv 10/3/2018 15:43:47'! -assertIsPositiveZero: aFloat - "Assert that aFloat is Float zero (the positive one)" - self assert: aFloat hex = 0.0 hex! ! +!FractionTest methodsFor: 'tests - conversions' stamp: 'nice 6/3/2011 21:32'! +testCeiling + self assert: (3 / 2) ceiling = 2. + self assert: (-3 / 2) ceiling = -1.! ! -!FloatTest methodsFor: 'helpers' stamp: 'jmv 10/15/2019 16:41:28'! -expectedFailures - "See https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/383" - ^ (`{'Win32'. 'Mac OS' }` includes: Smalltalk platformName) - ifTrue: [#(testTimesTwoPowerGradualUnderflow)] - ifFalse: [#()]! ! +!FractionTest methodsFor: 'tests - conversions' stamp: 'nice 6/3/2011 21:32'! +testFloor + self assert: (3 / 2) floor = 1. + self assert: (-3 / 2) floor = -2.! ! -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/27/2019 15:25:35'! -testPrimAdd +!FractionTest methodsFor: 'tests - conversions' stamp: 'nice 6/3/2011 21:39'! +testRounded + self assert: (4 / 5) rounded = 1. + self assert: (6 / 5) rounded = 1. + self assert: (-4 / 5) rounded = -1. + self assert: (-6 / 5) rounded = -1. + + "In case of tie, round to upper magnitude" + self assert: (3 / 2) rounded = 2. + self assert: (-3 / 2) rounded = -2.! ! - self assert: (1.0 primTestAdd: 1.0) = 2.0. - self assert: (Float fminNormalized primTestAdd: Float fminDenormalized) > Float fminNormalized. - self assert: (Float fminNormalized primTestAdd: Float fminDenormalized) - Float fminNormalized = Float fminDenormalized. - self assert: (1.0 primTestAdd: Float zero) = 1.0. - self assert: (Float zero primTestAdd: 1.0) = 1.0. - self assert: (1.0 primTestAdd: Float negativeZero) = 1.0. - self assert: (Float negativeZero primTestAdd: 1.0) = 1.0. - self assert: (1.0 primTestAdd: Float infinity) = Float infinity. - self assert: (Float infinity primTestAdd: 1.0) = Float infinity. - self assert: (1.0 primTestAdd: Float negativeInfinity) = Float negativeInfinity. - self assert: (Float negativeInfinity primTestAdd: 1.0) = Float negativeInfinity. - self assert: (1.0 primTestAdd: Float nan) isNaN. - self assert: (Float nan primTestAdd: 1.0) isNaN. - self assert: (Float nan primTestAdd: Float nan) isNaN.! ! +!FractionTest methodsFor: 'tests - conversions' stamp: 'nice 6/3/2011 21:35'! +testTruncated + self assert: (3 / 2) truncated = 1. + self assert: (-3 / 2) truncated = -1.! ! -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/14/2019 14:09:00'! -testPrimArcTan +!FractionTest methodsFor: 'tests - invariants' stamp: 'nice 1/22/2012 19:07'! +testThatFractionDenominatorIsPositive + self assert: (-3 / 2) numerator negative description: 'a Fraction sign is allways carried by its numerator'. + self assert: (-3 / 2) denominator positive description: 'a Fraction denominator is allways positive'. + + self assert: (3 / -2) numerator negative description: 'a Fraction sign is allways carried by its numerator'. + self assert: (3 / -2) denominator positive description: 'a Fraction denominator is allways positive'. + + self assert: (-3 / -2) numerator positive description: 'two negative signs are simplified'. + self assert: (-3 / -2) denominator positive description: 'a Fraction denominator is allways positive'.! ! - self verify: 1.0 primTestArcTan isTrigonometricallyEqualTo: Float pi / 4. - self verify: -1.0 primTestArcTan isTrigonometricallyEqualTo: Float pi / -4. - self verify: 0.0 primTestArcTan isTrigonometricallyEqualTo: 0. - self verify: Float infinity primTestArcTan isTrigonometricallyEqualTo: Float pi / 2. - self verify: Float negativeInfinity primTestArcTan isTrigonometricallyEqualTo: Float pi / -2. - self assert: Float nan primTestArcTan isNaN! ! +!FractionTest methodsFor: 'tests - invariants' stamp: 'nice 1/22/2012 19:12'! +testThatFractionIsReduced + self assert: (4 / 6) numerator equals: 2. + self assert: (4 / 6) denominator equals: 3. + + self assert: (4 / 2) classAndValueEquals: 2. + + "Fraction class>>#numerator:denominator: does not automatically reduce the Fraction. + Since it does not guaranty above invariant, it must be used with care." + self assert: (Fraction numerator: 4 denominator: 6) numerator equals: 4. + self assert: (Fraction numerator: 4 denominator: 6) denominator equals: 6. + self assert: (Fraction numerator: 4 denominator: 6) reduced numerator equals: 2. + self assert: (Fraction numerator: 4 denominator: 6) reduced denominator equals: 3.! ! -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 10/11/2019 20:08:22'! -testPrimDivideBy +!FractionTest methodsFor: 'testing' stamp: 'jmv 10/9/2018 09:37:12'! +testHash - self assert: (1.5 primTestDivideBy: 2.0) = 0.75. + | a fraction1 fraction2 | + fraction1 _ 1/3. + fraction2 _ (1/3) + (1e-1000). + self deny: fraction1 = fraction2 description: 'precondition'. + self assert: fraction1 asFloat = fraction2 asFloat description: 'precondition'. + a _ Set new. + a add: fraction1; add: fraction2. + self assert: a size = 2! ! - Smalltalk doMixedArithmetic - ifTrue: [ self assert: (2.0 primTestDivideBy: 1) = 2.0 ] - ifFalse: [ self assert: (2.0 primTestDivideBy: 1) = #fail ]. +!FractionTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:20:34'! +testIsType + self assert: ((1 / 2100) is: #Fraction). + self assert: ((1 / 2100) is: #Number).! ! - self assert: (2.0 primTestDivideBy: 0) = #fail. - self assert: (2.0 primTestDivideBy: 0.0) = #fail. - self assert: (1.2 primTestDivideBy: Float negativeZero) = #fail. - self assert: (1.2 primTestDivideBy: (1.3 - 1.3)) = #fail. - self assert: (0.0 primTestDivideBy: 0.0) = #fail. - self assert: (0.0 primTestDivideBy: Float negativeZero) = #fail. - self assert: (Float negativeZero primTestDivideBy: 0.0) = #fail. - self assert: (Float negativeZero primTestDivideBy: Float negativeZero) = #fail. - self assert: (Float nan primTestDivideBy: 0.0) = #fail. - self assert: (Float nan primTestDivideBy: Float negativeZero) = #fail. - self assert: (Float infinity primTestDivideBy: 0.0) = #fail. - self assert: (Float negativeInfinity primTestDivideBy: Float negativeZero) = #fail. +!FractionTest methodsFor: 'tests - rounding' stamp: 'jmv 10/29/2021 11:13:20'! +testRoundHalfAwayFromZero + "See https://en.wikipedia.org/wiki/Rounding#Round_half_away_from_zero" + self assert: (1/2) roundedHAFZ = 1. + self assert: (3/2) roundedHAFZ = 2. + self assert: (-1/2) roundedHAFZ = -1. + self assert: (-3/2) roundedHAFZ = -2. + self assert: (((0 to: 5 by: 1/4) collect: [ :f | f roundedHAFZ ]) = #(0 0 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5) ). + self assert: (((0 to: -5 by: -1/4) collect: [ :f | f roundedHAFZ ]) = #(0 0 -1 -1 -1 -1 -2 -2 -2 -2 -3 -3 -3 -3 -4 -4 -4 -4 -5 -5 -5) ).! ! - self assert: (2.0 primTestDivideBy: 2.0) = 1.0. - self assert: (Float fminNormalized primTestDivideBy: 2.0) * 2.0 = Float fminNormalized. - self assert: (Float fminDenormalized * 2.0 primTestDivideBy: 2.0) = Float fminDenormalized. +!FractionTest methodsFor: 'tests - rounding' stamp: 'jmv 10/9/2018 16:12:18'! +testRoundHalfToEven + "See https://en.wikipedia.org/wiki/Rounding#Round_half_to_even" + self assert: (1/2) rounded = 0. + self assert: (3/2) rounded = 2. + self assert: (-1/2) rounded = 0. + self assert: (-3/2) rounded = -2. + self assert: (((0 to: 5 by: 1/4) collect: [ :f | f rounded ]) = #(0 0 0 1 1 1 2 2 2 2 2 3 3 3 4 4 4 4 4 5 5) ). + self assert: (((0 to: -5 by: -1/4) collect: [ :f | f rounded ]) = #(0 0 0 -1 -1 -1 -2 -2 -2 -2 -2 -3 -3 -3 -4 -4 -4 -4 -4 -5 -5) ).! ! - self assertIsPositiveZero: (Float zero primTestDivideBy: 1.0). - self assertIsNegativeZero: (Float negativeZero primTestDivideBy: 1.0). +!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:12'! +testAndSingleBitWithMinusOne + "And a single bit with -1 and test for same value" + 1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitAnd: -1) = (1 bitShift: i)].! ! - self assertIsPositiveZero: (1.0 primTestDivideBy: Float infinity). - self assert: (Float infinity primTestDivideBy: 1.0) = Float infinity. - self assertIsNegativeZero: (-1.0 primTestDivideBy: Float infinity). - self assert: (Float infinity primTestDivideBy: -1.0) = Float negativeInfinity. +!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'nice 1/10/2010 17:46'! +testLargeShift + "A sanity check for LargeInteger bitShifts" + + | suite | + suite := #( "some numbers on 64 bits or less" + '101101011101001100110111110110011101101101000001110110011' + '1101101001100010011001101110100000111011011010100011101100' + '101101101011110011001100110011011101011001111000100011101000' + '10101101101000101001111111111100101101011001011000100011100000' + '1000101010101001111011101010111001011111110011110001000110000000' + '1100101010101000010011101000110010111110110011110000000000000001' ). + "65 bits or less" + suite := suite , (suite collect: [:e | '1' , e reversed ]). + "129 bits or less" + suite := suite , (suite collect: [:e | e ,e ]). + suite do: [:bits | | num ls rs | + num := Integer readFrom: bits readStream base: 2. + 0 to: bits size-1 do: [:shift | + ls := (num bitShift: shift) printStringBase: 2. + rs := (num bitShift: 0-shift) printStringBase: 2. + self assert: ls = (bits , (String new: shift withAll: $0)). + self assert: rs = (bits copyFrom: 1 to: bits size - shift). + ]].! ! - self assertIsNegativeZero: (1.0 primTestDivideBy: Float negativeInfinity). - self assert: (Float negativeInfinity primTestDivideBy: 1.0) = Float negativeInfinity. - self assertIsPositiveZero: (-1.0 primTestDivideBy: Float negativeInfinity). - self assert: (Float negativeInfinity primTestDivideBy: -1.0) = Float infinity. +!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:13'! +testMixedSignDigitLogic + "Verify that mixed sign logic with large integers works." + self assert: (-2 bitAnd: 16rFFFFFFFF) = 16rFFFFFFFE! ! - self assert: (1.0 primTestDivideBy: Float nan) isNaN. - self assert: (Float nan primTestDivideBy: 1.0) isNaN. - self assert: (Float nan primTestDivideBy: Float nan) isNaN.! ! +!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:12'! +testNBitAndNNegatedEqualsN + "Verify that (n bitAnd: n negated) = n for single bits" + | n | + 1 to: 100 do: [:i | n := 1 bitShift: i. + self assert: (n bitAnd: n negated) = n]! ! -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/25/2019 18:00:27'! -testPrimEqual +!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:12'! +testNNegatedEqualsNComplementedPlusOne + "Verify that n negated = (n complemented + 1) for single bits" + | n | + 1 to: 100 do: [:i | n := 1 bitShift: i. + self assert: n negated = ((n bitXor: -1) + 1)]! ! - | samples | - samples _ { Float negativeInfinity. -1.0. Float fminNormalized negated. Float fminDenormalized negated. Float fminDenormalized. Float fminNormalized. 1.0. Float infinity }. +!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:13'! +testShiftMinusOne1LeftThenRight + "Shift -1 left then right and test for 1" + 1 to: 100 do: [:i | self assert: ((-1 bitShift: i) bitShift: i negated) = -1]. +! ! - 1 to: samples size do: [ :i | - 1 to: samples size do: [ :j | - self assert: ((samples at: i) primTestEqual: (samples at: j)) = (i = j ) ]]. +!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:12'! +testShiftOneLeftThenRight + "Shift 1 bit left then right and test for 1" + 1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitShift: i negated) = 1]. +! ! - self assert: (Float zero primTestEqual: Float negativeZero). - self assert: (Float negativeZero primTestEqual: Float zero). - self deny: (Float zero primTestEqual: Float nan). - self deny: (Float nan primTestEqual: Float zero). - self deny: (Float negativeZero primTestEqual: Float nan). - self deny: (Float nan primTestEqual: Float negativeZero). - self deny: (Float nan primTestEqual: Float nan). +!IntegerTest methodsFor: 'private' stamp: 'jmv 10/11/2011 08:14'! +assert: a classAndValueEquals: b + self assert: a class = b class. + self assert: a = b! ! - 1 to: samples size do: [ :i | - self deny: ((samples at: i) primTestEqual: Float zero). - self deny: ((samples at: i) primTestEqual: Float negativeZero). - self deny: ((samples at: i) primTestEqual: Float nan). - self deny: (Float zero primTestEqual: (samples at: i)). - self deny: (Float negativeZero primTestEqual: (samples at: i)). - self deny: (Float nan primTestEqual: (samples at: i)) ].! ! +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:01'! +testBackslashBackslashLnLn -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/14/2019 13:51:33'! -testPrimExpAndLn - | e | - e := Float e. - self assert: 1.0 primTestExp = e. - self assert: e primTestLn = 1.0. - self verify: 2.0 primTestExp isWithin: 1 floatsAwayFrom: e squared. - self assert: 2.0 primTestExp sqrt = e. - self assert: 2.0 primTestExp primTestLn = 2.0. - self assert: 0.0 primTestExp = 1.0. - self assert: 0.0 primTestLn = Float negativeInfinity. - self assert: 0.0 primTestLn primTestExp = 0.0. - self assert: 0.0 successor primTestLn ~= Float negativeInfinity. - self assert: 0.0 successor primTestLn primTestExp = 0.0 successor. - self assert: 0.0 successor primTestLn ceiling asFloat primTestExp > 0.0 successor. - self assertIsNaNorFail: -1.0 primTestLn. - self assert: Float nan primTestLn isNaN. - self assert: Float nan primTestExp isNaN! ! + self assert: -42391158275216203514294433200 \\ -14130386091738734504764811067 = -14130386091738734504764811066. + self assert: -42391158275216203514294433201 \\ -14130386091738734504764811067 = 0. + self assert: -42391158275216203514294433202 \\ -14130386091738734504764811067 = -1. + self assert: -8727963568087712425891397479476727340041448 \\ -79766443076872509863361 = -79766443076872509863360. + self assert: -8727963568087712425891397479476727340041449 \\ -79766443076872509863361 = 0. + self assert: -8727963568087712425891397479476727340041450 \\ -79766443076872509863361 = -1! ! -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/14/2019 13:44:44'! -testPrimExponent - self assert: 1.0 primTestExponent = 0. - self assert: 2.0 predecessor primTestExponent = 0. - self assert: 2.0 primTestExponent = 1. - self assert: 4.0 predecessor primTestExponent = 1. - self assert: 4.0 primTestExponent = 2. - self assert: Float fminNormalized primTestExponent = -1022. - self assert: Float fminDenormalized primTestExponent = (-1022-52).! ! +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:00'! +testBackslashBackslashLnLp -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/25/2019 17:50:52'! -testPrimGreater - self deny: (1.0 primTestGreater: 1.0 successor). - self deny: (1.0 primTestGreater: 1.0). - self assert: (1.0 primTestGreater: 1.0 predecessor). - self assert: (0.0 primTestGreater: Float fminNormalized negated). - self assert: (0.0 primTestGreater: Float fminDenormalized negated). - self assert: (0.0 primTestGreater: -1.0). - self assert: (Float fminNormalized primTestGreater: 0.0). - self assert: (Float fminDenormalized primTestGreater: 0.0). - self deny: (-1.0 primTestGreater: 0.0). - self deny: (1.0 primTestGreater: Float infinity). - self deny: (Float infinity primTestGreater: Float infinity). - self deny: (Float negativeInfinity primTestGreater: Float infinity). - self deny: (Float negativeInfinity primTestGreater: -1.0). - self deny: (Float negativeInfinity primTestGreater: Float negativeZero). - self deny: (Float negativeZero primTestGreater: Float zero). - self deny: (Float zero primTestGreater: Float fminDenormalized). - self deny: (Float fminDenormalized primTestGreater: Float fminNormalized). - self deny: (Float fminNormalized primTestGreater: 1.0). - self deny: (Float nan primTestGreater: Float negativeInfinity). - self deny: (Float nan primTestGreater: Float negativeZero). - self deny: (Float nan primTestGreater: Float zero). - self deny: (Float nan primTestGreater: 1.0). - self deny: (Float nan primTestGreater: Float infinity). - self deny: (Float nan primTestGreater: Float nan).! ! - -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/25/2019 17:53:17'! -testPrimGreaterEqual - self deny: (1.0 primTestGreaterEqual: 1.0 successor). - self assert: (1.0 primTestGreaterEqual: 1.0). - self assert: (1.0 primTestGreaterEqual: 1.0 predecessor). - self assert: (0.0 primTestGreaterEqual: Float fminNormalized negated). - self assert: (0.0 primTestGreaterEqual: Float fminDenormalized negated). - self assert: (0.0 primTestGreaterEqual: -1.0). - self assert: (Float fminNormalized primTestGreaterEqual: 0.0). - self assert: (Float fminDenormalized primTestGreaterEqual: 0.0). - self deny: (-1.0 primTestGreaterEqual: 0.0). - self deny: (1.0 primTestGreaterEqual: Float infinity). - self assert: (Float infinity primTestGreaterEqual: Float infinity). - self deny: (Float negativeInfinity primTestGreaterEqual: Float infinity). - self deny: (Float negativeInfinity primTestGreaterEqual: -1.0). - self deny: (Float negativeInfinity primTestGreaterEqual: Float negativeZero). - self assert: (Float negativeZero primTestGreaterEqual: Float zero). - self deny: (Float zero primTestGreaterEqual: Float fminDenormalized). - self deny: (Float fminDenormalized primTestGreaterEqual: Float fminNormalized). - self deny: (Float fminNormalized primTestGreaterEqual: 1.0). - self deny: (Float nan primTestGreaterEqual: Float negativeInfinity). - self deny: (Float nan primTestGreaterEqual: Float negativeZero). - self deny: (Float nan primTestGreaterEqual: Float zero). - self deny: (Float nan primTestGreaterEqual: 1.0). - self deny: (Float nan primTestGreaterEqual: Float infinity). - self deny: (Float nan primTestGreaterEqual: Float nan).! ! + self assert: -42391158275216203514294433200 \\ 14130386091738734504764811067 = 1. + self assert: -42391158275216203514294433201 \\ 14130386091738734504764811067 = 0. + self assert: -42391158275216203514294433202 \\ 14130386091738734504764811067 = 14130386091738734504764811066. + self assert: -8727963568087712425891397479476727340041448 \\ 79766443076872509863361 = 1. + self assert: -8727963568087712425891397479476727340041449 \\ 79766443076872509863361 = 0. + self assert: -8727963568087712425891397479476727340041450 \\ 79766443076872509863361 = 79766443076872509863360! ! -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/25/2019 17:46:13'! -testPrimLess - self assert: (1.0 primTestLess: 1.0 successor). - self deny: (1.0 primTestLess: 1.0). - self deny: (1.0 primTestLess: 1.0 predecessor). - self assert: (0.0 primTestLess: Float fminNormalized). - self assert: (0.0 primTestLess: Float fminDenormalized). - self assert: (0.0 primTestLess: 1.0). - self assert: (Float fminNormalized negated primTestLess: 0.0). - self assert: (Float fminDenormalized negated primTestLess: 0.0). - self assert: (-1.0 primTestLess: 0.0). - self assert: (1.0 primTestLess: Float infinity). - self deny: (Float infinity primTestLess: Float infinity). - self assert: (Float negativeInfinity primTestLess: Float infinity). - self assert: (Float negativeInfinity primTestLess: -1.0). - self assert: (Float negativeInfinity primTestLess: Float negativeZero). - self deny: (Float negativeZero primTestLess: Float zero). - self assert: (Float zero primTestLess: Float fminDenormalized). - self assert: (Float fminDenormalized primTestLess: Float fminNormalized). - self assert: (Float fminNormalized primTestLess: 1.0). - self deny: (Float nan primTestLess: Float negativeInfinity). - self deny: (Float nan primTestLess: Float negativeZero). - self deny: (Float nan primTestLess: Float zero). - self deny: (Float nan primTestLess: 1.0). - self deny: (Float nan primTestLess: Float infinity). - self deny: (Float nan primTestLess: Float nan).! ! +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:01'! +testBackslashBackslashLnSn -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/25/2019 17:47:25'! -testPrimLessEqual - self assert: (1.0 primTestLessEqual: 1.0 successor). - self assert: (1.0 primTestLessEqual: 1.0). - self deny: (1.0 primTestLessEqual: 1.0 predecessor). - self assert: (0.0 primTestLessEqual: Float fminNormalized). - self assert: (0.0 primTestLessEqual: Float fminDenormalized). - self assert: (0.0 primTestLessEqual: 1.0). - self assert: (Float fminNormalized negated primTestLessEqual: 0.0). - self assert: (Float fminDenormalized negated primTestLessEqual: 0.0). - self assert: (-1.0 primTestLessEqual: 0.0). - self assert: (1.0 primTestLessEqual: Float infinity). - self assert: (Float infinity primTestLessEqual: Float infinity). - self assert: (Float negativeInfinity primTestLessEqual: Float infinity). - self assert: (Float negativeInfinity primTestLessEqual: -1.0). - self assert: (Float negativeInfinity primTestLessEqual: Float negativeZero). - self assert: (Float negativeZero primTestLessEqual: Float zero). - self assert: (Float zero primTestLessEqual: Float fminDenormalized). - self assert: (Float fminDenormalized primTestLessEqual: Float fminNormalized). - self assert: (Float fminNormalized primTestLessEqual: 1.0). - self deny: (Float nan primTestLessEqual: Float negativeInfinity). - self deny: (Float nan primTestLessEqual: Float negativeZero). - self deny: (Float nan primTestLessEqual: Float zero). - self deny: (Float nan primTestLessEqual: 1.0). - self deny: (Float nan primTestLessEqual: Float infinity). - self deny: (Float nan primTestLessEqual: Float nan).! ! + self assert: -42391158275216203514294433201 \\ -3 = 0. + self assert: -42391158275216203514294433202 \\ -3 = -1. + self assert: -42391158275216203514294433203 \\ -3 = -2. + self assert: -42391158275216203514294433204 \\ -3 = 0! ! -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/27/2019 15:26:33'! -testPrimMultiplyBy +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:02'! +testBackslashBackslashLnSp - self assert: (2.0 primTestMultiplyBy: 2.0) = 4.0. - self assert: (Float fminNormalized primTestMultiplyBy: 2.0) = (Float fminNormalized + Float fminNormalized). - self assert: (Float fminDenormalized primTestMultiplyBy: 2.0) = (Float fminDenormalized + Float fminDenormalized). - self assertIsPositiveZero: (1.0 primTestMultiplyBy: Float zero). - self assertIsPositiveZero: (Float zero primTestMultiplyBy: 1.0). - self assertIsNegativeZero: (1.0 primTestMultiplyBy: Float negativeZero). - self assertIsNegativeZero: (Float negativeZero primTestMultiplyBy: 1.0). - self assert: (1.0 primTestMultiplyBy: Float infinity) = Float infinity. - self assert: (Float infinity primTestMultiplyBy: 1.0) = Float infinity. - self assert: (1.0 primTestMultiplyBy: Float negativeInfinity) = Float negativeInfinity. - self assert: (Float negativeInfinity primTestMultiplyBy: 1.0) = Float negativeInfinity. - self assert: (1.0 primTestMultiplyBy: Float nan) isNaN. - self assert: (Float nan primTestMultiplyBy: 1.0) isNaN. - self assert: (Float nan primTestMultiplyBy: Float nan) isNaN.! ! + self assert: -42391158275216203514294433201 \\ 3 = 0. + self assert: -42391158275216203514294433202 \\ 3 = 2. + self assert: -42391158275216203514294433203 \\ 3 = 1. + self assert: -42391158275216203514294433204 \\ 3 = 0! ! -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/25/2019 18:02:13'! -testPrimNotEqual +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:04'! +testBackslashBackslashLpLn - | samples | - samples _ { Float negativeInfinity. -1.0. Float fminNormalized negated. Float fminDenormalized negated. Float fminDenormalized. Float fminNormalized. 1.0. Float infinity }. + self assert: 42391158275216203514294433200 \\ -14130386091738734504764811067 = -1. + self assert: 42391158275216203514294433201 \\ -14130386091738734504764811067 = 0. + self assert: 42391158275216203514294433202 \\ -14130386091738734504764811067 = -14130386091738734504764811066. + self assert: 8727963568087712425891397479476727340041448 \\ -79766443076872509863361 = -1. + self assert: 8727963568087712425891397479476727340041449 \\ -79766443076872509863361 = 0. + self assert: 8727963568087712425891397479476727340041450 \\ -79766443076872509863361 = -79766443076872509863360! ! - 1 to: samples size do: [ :i | - 1 to: samples size do: [ :j | - self assert: ((samples at: i) primTestNotEqual: (samples at: j)) ~= (i = j ) ]]. +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:05'! +testBackslashBackslashLpLp - self deny: (Float zero primTestNotEqual: Float negativeZero). - self deny: (Float negativeZero primTestNotEqual: Float zero). - self assert: (Float zero primTestNotEqual: Float nan). - self assert: (Float nan primTestNotEqual: Float zero). - self assert: (Float negativeZero primTestNotEqual: Float nan). - self assert: (Float nan primTestNotEqual: Float negativeZero). - self assert: (Float nan primTestNotEqual: Float nan). + self assert: 42391158275216203514294433200 \\ 14130386091738734504764811067 = 14130386091738734504764811066. + self assert: 42391158275216203514294433201 \\ 14130386091738734504764811067 = 0. + self assert: 42391158275216203514294433202 \\ 14130386091738734504764811067 = 1. + self assert: 8727963568087712425891397479476727340041448 \\ 79766443076872509863361 = 79766443076872509863360. + self assert: 8727963568087712425891397479476727340041449 \\ 79766443076872509863361 = 0. + self assert: 8727963568087712425891397479476727340041450 \\ 79766443076872509863361 = 1! ! - 1 to: samples size do: [ :i | - self assert: ((samples at: i) primTestNotEqual: Float zero). - self assert: ((samples at: i) primTestNotEqual: Float negativeZero). - self assert: ((samples at: i) primTestNotEqual: Float nan). - self assert: (Float zero primTestNotEqual: (samples at: i)). - self assert: (Float negativeZero primTestNotEqual: (samples at: i)). - self assert: (Float nan primTestNotEqual: (samples at: i)) ].! ! +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:06'! +testBackslashBackslashLpSn -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/14/2019 13:57:07'! -testPrimSin + self assert: 42391158275216203514294433201 \\ -3 = 0. + self assert: 42391158275216203514294433202 \\ -3 = -2. + self assert: 42391158275216203514294433203 \\ -3 = -1. + self assert: 42391158275216203514294433204 \\ -3 = 0! ! - self verify: 0.0 primTestSin isTrigonometricallyEqualTo: 0.0. - self verify: (Float pi / 6) primTestSin isTrigonometricallyEqualTo: 1.0 sqrt / 2.0. - self verify: (Float pi / 4) primTestSin isTrigonometricallyEqualTo: 2.0 sqrt / 2.0. - self verify: (Float pi / 3) primTestSin isTrigonometricallyEqualTo: 3.0 sqrt / 2.0. - self verify: (Float pi / 2) primTestSin isTrigonometricallyEqualTo: 1.0! ! +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:07'! +testBackslashBackslashLpSp -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/12/2019 14:31:19'! -testPrimSmallIntegerAsFloat - self assert: 7 asFloat = 7.0. - self assert: 0 asFloat = 0.0. - self assert: 1 asFloat = 1.0. - self assert: -1 asFloat = -1.0. - self assert: Float maxExactInteger asFloat = (Float maxExactInteger printString, '.0') asNumber. - self assert: Float maxExactInteger negated asFloat = (Float maxExactInteger negated printString, '.0') asNumber. - self assert: SmallInteger maxVal asFloat = (SmallInteger maxVal printString, '.0') asNumber. - self assert: SmallInteger minVal asFloat = (SmallInteger minVal printString, '.0') asNumber.! ! + self assert: 42391158275216203514294433201 \\ 3 = 0. + self assert: 42391158275216203514294433202 \\ 3 = 1. + self assert: 42391158275216203514294433203 \\ 3 = 2. + self assert: 42391158275216203514294433204 \\ 3 = 0! ! -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/12/2019 14:27:58'! -testPrimSqrt +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:08'! +testBackslashBackslashSnLn - self assert: 4.0 primTestSqrt = 2.0. - self assert: 0.0 primTestSqrt = 0.0. - self assert: Float negativeZero primTestSqrt = 0.0. - self assert: Float fminNormalized primTestSqrt squared = Float fminNormalized. - self assert: Float fminDenormalized primTestSqrt squared = Float fminDenormalized. - self assert: Float infinity primTestSqrt = Float infinity. - - "Seems to be #fail in workspaces, but for some BoxedFloat64, Cog seems to answer NaN. - Never mind. Both are valid. #primSqrt answers NaN in case of primitive failure." - self assertIsNaNorFail: -4.0 primTestSqrt. - self assertIsNaNorFail: Float fminNormalized negated primTestSqrt. - self assertIsNaNorFail: Float fminDenormalized negated primTestSqrt. - self assertIsNaNorFail: Float negativeInfinity primTestSqrt. - self assertIsNaNorFail: Float nan primTestSqrt.! ! + self assert: 0 \\ -42391158275216203514294433201 = 0. + self assert: -1 \\ -42391158275216203514294433201 = -1. + self assert: -14348907 \\ -42391158275216203514294433201 = -14348907! ! -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 2/27/2019 15:25:52'! -testPrimSubtract +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:09'! +testBackslashBackslashSnLp - self assert: (3.0 primTestSubtract: 1.0) = 2.0. - self assert: (Float fminNormalized primTestSubtract: Float fminDenormalized) < Float fminNormalized. - self assert: (Float fminNormalized primTestSubtract: Float fminDenormalized) - Float fminNormalized = Float fminDenormalized negated. - self assert: (1.0 primTestSubtract: Float zero) = 1.0. - self assert: (Float zero primTestSubtract: 1.0) = -1.0. - self assert: (1.0 primTestSubtract: Float negativeZero) = 1.0. - self assert: (Float negativeZero primTestSubtract: 1.0) = -1.0. - self assert: (1.0 primTestSubtract: Float infinity) = Float negativeInfinity. - self assert: (Float infinity primTestSubtract: 1.0) = Float infinity. - self assert: (1.0 primTestSubtract: Float negativeInfinity) = Float infinity. - self assert: (Float negativeInfinity primTestSubtract: 1.0) = Float negativeInfinity. - self assert: (1.0 primTestSubtract: Float nan) isNaN. - self assert: (Float nan primTestSubtract: 1.0) isNaN. - self assert: (Float nan primTestSubtract: Float nan) isNaN.! ! + self assert: 0 \\ 42391158275216203514294433201 = 0. + self assert: -1 \\ 42391158275216203514294433201 = 42391158275216203514294433200. + self assert: -14348907 \\ 42391158275216203514294433201 = 42391158275216203514280084294! ! -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/14/2019 13:53:28'! -testPrimTimesTwoPower +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:09'! +testBackslashBackslashSnSn - self assert: (Float fminNormalized timesTwoPower: -52) = Float fminDenormalized. - self assert: (Float fminDenormalized timesTwoPower: 52) = Float fminNormalized. - self assert: (Float fminNormalized timesTwoPower: -53) = 0.0. - self assert: (0.0 timesTwoPower: 53) = 0.0. + self assert: 0 \\ -3 = 0. + self assert: -1 \\ -3 = -1. + self assert: -9 \\ -3 = 0. + self assert: -10 \\ -3 = -1. + self assert: -11 \\ -3 = -2. + self assert: -12 \\ -3 = 0. + self assert: -13 \\ -3 = -1! ! - self assert: (Float fminNormalized timesTwoPower: 1022) = 1.0. - self assert: (Float fminDenormalized timesTwoPower: 1022+52) = 1.0 . - self assert: (1.0 timesTwoPower: -1022) = Float fminNormalized. - self assert: (2.0 predecessor timesTwoPower: 1023) = Float fmax. +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:10'! +testBackslashBackslashSnSp - self assert: (Float pi timesTwoPower: 13) mantissaPart = Float pi mantissaPart. - - self assert: (Float infinity timesTwoPower: -1023) = Float infinity. - self assert: (Float infinity timesTwoPower: -1024) = Float infinity. - self assert: (Float negativeInfinity timesTwoPower: -1023) = Float negativeInfinity. - self assert: (Float negativeInfinity timesTwoPower: -1024) = Float negativeInfinity. - self assert: (Float nan timesTwoPower: 2) isNaN.! ! + self assert: 0 \\ 3 = 0. + self assert: -1 \\ 3 = 2. + self assert: -9 \\ 3 = 0. + self assert: -10 \\ 3 = 2. + self assert: -11 \\ 3 = 1. + self assert: -12 \\ 3 = 0. + self assert: -13 \\ 3 = 2! ! -!FloatTest methodsFor: 'tests - primitives' stamp: 'jmv 3/12/2019 14:39:27'! -testPrimTruncated +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:11'! +testBackslashBackslashSpLn - self assert: 1.0 primTestTruncated == 1. - self assert: 1.1 primTestTruncated == 1. - self assert: 1.9 primTestTruncated == 1. - self assert: Float pi primTestTruncated == 3. - self assert: Float zero primTestTruncated = 0. - self assert: Float fminNormalized primTestTruncated = 0. - self assert: Float fminDenormalized primTestTruncated = 0. - self assert: Float infinity primTestTruncated = #fail. + self assert: 0 \\ -42391158275216203514294433201 = 0. + self assert: 1 \\ -42391158275216203514294433201 = -42391158275216203514294433200. + self assert: 14348907 \\ -42391158275216203514294433201 = -42391158275216203514280084294! ! - self assert: -1.0 primTestTruncated == -1. - self assert: -1.1 primTestTruncated == -1. - self assert: -1.9 primTestTruncated == -1. - self assert: Float pi negated primTestTruncated == -3. - self assert: Float negativeZero primTestTruncated = 0. - self assert: Float fminNormalized negated primTestTruncated = 0. - self assert: Float fminDenormalized negated primTestTruncated = 0. - self assert: Float negativeInfinity primTestTruncated = #fail. +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:12'! +testBackslashBackslashSpLp - self assert: Float nan primTestTruncated = #fail. + self assert: 0 \\ 42391158275216203514294433201 = 0. + self assert: 1 \\ 42391158275216203514294433201 = 1. + self assert: 14348907 \\ 42391158275216203514294433201 = 14348907! ! - "Only if SmallInteger primitive result is enough to hold the result" - SmallInteger maxVal >= Float maxExactInteger ifTrue: [ - self assert: (Float maxExactInteger + 0.0) primTestTruncated == Float maxExactInteger. - self assert: (Float maxExactInteger + 0.9) primTestTruncated == Float maxExactInteger. - self assert: (Float maxExactInteger - 0.1) primTestTruncated == Float maxExactInteger. - self assert: (Float maxExactInteger negated + 0.0) primTestTruncated == Float maxExactInteger negated. - self assert: (Float maxExactInteger negated - 0.9) primTestTruncated == Float maxExactInteger negated. - self assert: (Float maxExactInteger negated + 0.1) primTestTruncated == Float maxExactInteger negated ]. +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:13'! +testBackslashBackslashSpSn - self assert: SmallInteger maxVal asFloat predecessor asTrueFraction truncated class = SmallInteger. - self assert: SmallInteger maxVal asFloat predecessor primTestTruncated = SmallInteger maxVal asFloat predecessor asTrueFraction truncated. - self assert: (SmallInteger maxVal+1) asFloat successor asTrueFraction truncated class = LargePositiveInteger. - self assert: (SmallInteger maxVal+1) asFloat successor primTestTruncated = # fail. - "Depends on rounding to nearest Float. This could change depending on SmallInteger maxVal. Currently false in 64 bits Spur image, but true in 32 bits Spur and V3 images." - SmallInteger maxVal asFloat asTrueFraction truncated class = SmallInteger - ifTrue: [ self assert: SmallInteger maxVal asFloat primTestTruncated = SmallInteger maxVal asFloat asTrueFraction truncated ] - ifFalse: [ self assert: SmallInteger maxVal asFloat primTestTruncated = #fail ]. + self assert: 0 \\ -3 = 0. + self assert: 1 \\ -3 = -2. + self assert: 9 \\ -3 = 0. + self assert: 10 \\ -3 = -2. + self assert: 11 \\ -3 = -1. + self assert: 12 \\ -3 = 0. + self assert: 13 \\ -3 = -2! ! - self assert: SmallInteger minVal asFloat successor asTrueFraction truncated class = SmallInteger. - self assert: SmallInteger minVal asFloat successor primTestTruncated = SmallInteger minVal asFloat successor asTrueFraction truncated. - self assert: (SmallInteger minVal-1) asFloat predecessor asTrueFraction truncated class = LargeNegativeInteger. - self assert: (SmallInteger minVal-1) asFloat predecessor primTestTruncated = # fail. - "Depends on rounding to nearestFloat. This could change depending on SmallInteger maxVal. Currently true in 64 bits Spur image, and in 32 bits Spur and V3 images." - SmallInteger minVal asFloat asTrueFraction truncated class = SmallInteger - ifTrue: [ self assert: SmallInteger minVal asFloat primTestTruncated = SmallInteger minVal asFloat asTrueFraction truncated ] - ifFalse: [ self assert: SmallInteger minVal asFloat primTestTruncated = #fail ]. -! ! +!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:13'! +testBackslashBackslashSpSp -!FractionTest methodsFor: 'private' stamp: 'jmv 10/11/2011 22:12'! -assert: a classAndValueEquals: b - self assert: a class = b class. - self assert: a = b! ! + self assert: 0 \\ 3 = 0. + self assert: 1 \\ 3 = 1. + self assert: 9 \\ 3 = 0. + self assert: 10 \\ 3 = 1. + self assert: 11 \\ 3 = 2. + self assert: 12 \\ 3 = 0. + self assert: 13 \\ 3 = 1! ! -!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/3/2018 15:19:28'! -testDegreeCos2 - "self run: #testDegreeCos" - - self shouldnt: [ (4/3) degreeCos] raise: Error. - self assert: (1/3) degreeCos printString = '0.9999830768577442'! ! +!IntegerTest methodsFor: 'tests - benchmarks' stamp: 'sd 6/5/2005 08:37'! +testBenchFib -!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/3/2018 15:19:31'! -testDegreeSin2 - "self run: #testDegreeSin" - - self shouldnt: [ (4/3) degreeSin] raise: Error. - self assert: (1/3) degreeSin printString = '0.005817731354993834'.! ! + self assert: (0 benchFib = 1). + self assert: (1 benchFib = 1). + self assert: (2 benchFib = 3). + ! ! -!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/11/2011 22:27'! -testExactRaisedTo +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 8/21/2016 20:02:52'! +testBigReceiverInexactNthRoot " - FractionTest new testExactRaisedTo + IntegerTest new testBigReceiverInexactNthRoot " - | f | - self assert: (4/9 raisedTo: 1/2) classAndValueEquals: 2/3. - self assert: (9/4 raisedTo: 1/2) classAndValueEquals: 3/2. - #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :a :b | - f _ a / b. - self assert: (f squared raisedTo: 1/2) classAndValueEquals: f. - self assert: (f negated squared raisedTo: 1/2) classAndValueEquals: f. - f _ b / a. - self assert: (f squared raisedTo: 1/2) classAndValueEquals: f. - self assert: (f negated squared raisedTo: 1/2) classAndValueEquals: f ]. - self assert: (8/27 raisedTo: 1/3) classAndValueEquals: 2/3. - self assert: (27/8 raisedTo: 1/3) classAndValueEquals: 3/2. - #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :a :b | - f _ a / b. - self assert: ((f raisedTo: 3) raisedTo: 1/3) classAndValueEquals: f. - self assert: ((f negated raisedTo: 3) raisedTo: 1/3) classAndValueEquals: f negated. - f _ b / a. - self assert: ((f raisedTo: 3) raisedTo: 1/3) classAndValueEquals: f. - self assert: ((f negated raisedTo: 3) raisedTo: 1/3) classAndValueEquals: f negated ]. + "Inexact 3rd root (not a whole cube number), so a Float must be answered. + However, receiver is too big for Float arithmethic." + | bigNum result | + bigNum _ (100 factorial raisedTo: 3) + 1. "Add 1 so it is not a whole cube" + self assert: bigNum asFloat isInfinite. "Otherwise, we chose a bad sample" + result _ bigNum nthRoot: 3. + self assert: result isFloat. + self deny: result isInfinite. + self assert: result = 100 factorial asFloat. "No other float is closer. See following line" + self assert: 100 factorial asFloat = (100 factorial+1) asFloat! ! - self assert: (4/9 raisedTo: 3/2) classAndValueEquals: 8/27. - self assert: (8/27 raisedTo: 2/3) classAndValueEquals: 4/9. - #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :a :b | - f _ a / b. - self assert: ((f raisedTo: 3) raisedTo: 2/3) classAndValueEquals: f*f. - self assert: ((f raisedTo: 2) raisedTo: 3/2) classAndValueEquals: f*f*f. - self assert: ((f negated raisedTo: 3) raisedTo: 2/3) classAndValueEquals: f*f. - self assert: ((f negated raisedTo: 2) raisedTo: 3/2) classAndValueEquals: f*f*f. - f _ b / a. - self assert: ((f raisedTo: 3) raisedTo: 2/3) classAndValueEquals: f*f. - self assert: ((f raisedTo: 2) raisedTo: 3/2) classAndValueEquals: f*f*f. - self assert: ((f negated raisedTo: 3) raisedTo: 2/3) classAndValueEquals: f*f. - self assert: ((f negated raisedTo: 2) raisedTo: 3/2) classAndValueEquals: f*f*f ]. +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 8/21/2016 20:03:04'! +testBigReceiverInexactSqrt + " + IntegerTest new testBigReceiverInexactSqrt + " - self assert: (32/243 raisedTo: 3/5) classAndValueEquals: 8/27. - self assert: (8/27 raisedTo: 5/3) classAndValueEquals: 32/243. - #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :a :b | - f _ a / b. - self assert: ((f raisedTo: 5) raisedTo: 3/5) classAndValueEquals: f*f*f. - self assert: ((f raisedTo: 3) raisedTo: 5/3) classAndValueEquals: f*f*f*f*f. - self assert: ((f negated raisedTo: 5) raisedTo: 3/5) classAndValueEquals: (f*f*f) negated. - self assert: ((f negated raisedTo: 3) raisedTo: 5/3) classAndValueEquals: (f*f*f*f*f) negated. + "Inexact 3rd root (not a whole cube number), so a Float must be answered. + However, receiver is too big for Float arithmethic." + | bigNum result | + bigNum _ 100 factorial squared + 1. "Add 1 so it is not a whole square" + self assert: bigNum asFloat isInfinite. "Otherwise, we chose a bad sample" + result _ bigNum sqrt. + self assert: result isFloat. + self deny: result isInfinite. + self assert: result = 100 factorial asFloat. "No other float is closer. See following lines" + self assert: (result successor asFraction squared - bigNum) abs >= (result asFraction squared - bigNum) abs. + self assert: (result predecessor asFraction squared - bigNum) abs >= (result asFraction squared - bigNum) abs.! ! - self assert: ((f raisedTo: -5) raisedTo: 3/5) classAndValueEquals: 1/(f*f*f). - self assert: ((f raisedTo: -3) raisedTo: 5/3) classAndValueEquals: 1/(f*f*f*f*f). - self assert: ((f negated raisedTo: -5) raisedTo: 3/5) classAndValueEquals: -1/(f*f*f). - self assert: ((f negated raisedTo: -3) raisedTo: 5/3) classAndValueEquals: -1/(f*f*f*f*f). - self assert: ((f raisedTo: 5) raisedTo: -3/5) classAndValueEquals: 1/(f*f*f). - self assert: ((f raisedTo: 3) raisedTo: -5/3) classAndValueEquals: 1/(f*f*f*f*f). - self assert: ((f negated raisedTo: 5) raisedTo: -3/5) classAndValueEquals: -1/(f*f*f). - self assert: ((f negated raisedTo: 3) raisedTo: -5/3) classAndValueEquals: -1/(f*f*f*f*f). +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:46'! +testExactRaisedTo + " + IntegerTest new testExactRaisedTo + " + self assert: (4 raisedTo: 1/2) classAndValueEquals: 2. + self assert: (9 raisedTo: 1/2) classAndValueEquals: 3. + self assert: (9 raisedTo: -1/2) classAndValueEquals: 1/3. + self assert: (-1 raisedTo: 1/3) classAndValueEquals: -1. + #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i | + self assert: (i squared raisedTo: 1/2) classAndValueEquals: i. + self assert: (i negated squared raisedTo: 1/2) classAndValueEquals: i ]. - "No exact result => Float result" - self assert: ((f raisedTo: 3) +1 raisedTo: 5/3) isFloat. - self assert: ((f negated raisedTo: 3) -1 raisedTo: 5/3) isFloat. + self assert: (8 raisedTo: 1/3) classAndValueEquals: 2. + self assert: (27 raisedTo: 1/3) classAndValueEquals: 3. + #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i | + self assert: ((i raisedTo: 3) raisedTo: 1/3) classAndValueEquals: i. + self assert: ((i negated raisedTo: 3) raisedTo: 1/3) classAndValueEquals: i negated ]. - f _ b / a. - self assert: ((f raisedTo: 5) raisedTo: 3/5) classAndValueEquals: f*f*f. - self assert: ((f raisedTo: 3) raisedTo: 5/3) classAndValueEquals: f*f*f*f*f. - self assert: ((f negated raisedTo: 5) raisedTo: 3/5) classAndValueEquals: (f*f*f) negated. - self assert: ((f negated raisedTo: 3) raisedTo: 5/3) classAndValueEquals: (f*f*f*f*f) negated. + self assert: (4 raisedTo: 3/2) classAndValueEquals: 8. + self assert: (8 raisedTo: 2/3) classAndValueEquals: 4. + self assert: (8 raisedTo: -2/3) classAndValueEquals: 1/4. + #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i | + self assert: ((i raisedTo: 3) raisedTo: 2/3) classAndValueEquals: i*i. + self assert: ((i raisedTo: 2) raisedTo: 3/2) classAndValueEquals: i*i*i. + self assert: ((i negated raisedTo: 3) raisedTo: 2/3) classAndValueEquals: i*i. + self assert: ((i negated raisedTo: 2) raisedTo: 3/2) classAndValueEquals: i*i*i ]. + + self assert: (32 raisedTo: 3/5) classAndValueEquals: 8. + self assert: (8 raisedTo: 5/3) classAndValueEquals: 32. + #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i | + self assert: ((i raisedTo: 5) raisedTo: 3/5) classAndValueEquals: i*i*i. + self assert: ((i raisedTo: 3) raisedTo: 5/3) classAndValueEquals: i*i*i*i*i. + self assert: ((i negated raisedTo: 5) raisedTo: 3/5) classAndValueEquals: (i*i*i) negated. + self assert: ((i negated raisedTo: 3) raisedTo: 5/3) classAndValueEquals: (i*i*i*i*i) negated. + + self assert: ((i raisedTo: -5) raisedTo: 3/5) classAndValueEquals: 1/(i*i*i). + self assert: ((i raisedTo: -3) raisedTo: 5/3) classAndValueEquals: 1/(i*i*i*i*i). + self assert: ((i negated raisedTo: -5) raisedTo: 3/5) classAndValueEquals: -1/(i*i*i). + self assert: ((i negated raisedTo: -3) raisedTo: 5/3) classAndValueEquals: -1/(i*i*i*i*i). + + self assert: ((i raisedTo: 5) raisedTo: -3/5) classAndValueEquals: 1/(i*i*i). + self assert: ((i raisedTo: 3) raisedTo: -5/3) classAndValueEquals: 1/(i*i*i*i*i). + self assert: ((i negated raisedTo: 5) raisedTo: -3/5) classAndValueEquals: -1/(i*i*i). + self assert: ((i negated raisedTo: 3) raisedTo: -5/3) classAndValueEquals: -1/(i*i*i*i*i). "No exact result => Float result" - self assert: ((f raisedTo: 3) +1 raisedTo: 5/3) isFloat. - self assert: ((f negated raisedTo: 3) -1 raisedTo: 5/3) isFloat ].! ! + self assert: ((i raisedTo: 3) +1 raisedTo: 5/3) isFloat. + self assert: ((i negated raisedTo: 3) -1 raisedTo: 5/3) isFloat ].! ! -!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/11/2011 22:12'! +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/11/2011 22:09'! testExactSqrt " - FractionTest new testExactSqrt + IntegerTest new testExactSqrt " - | f | - self assert: (4/9) sqrt classAndValueEquals: 2/3. - #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) pairsDo: [ :i :j | - f _ i / j. - self assert: f squared sqrt classAndValueEquals: f. - f _ j / i. - self assert: f squared sqrt classAndValueEquals: f ]! ! + self assert: 4 sqrt classAndValueEquals: 2. + self assert: 9 sqrt classAndValueEquals: 3. + self assert: Float maxExactInteger squared sqrt classAndValueEquals: Float maxExactInteger. + self assert: (Float maxExactInteger+1) squared sqrt classAndValueEquals: Float maxExactInteger+1. + #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i | + self assert: i squared sqrt classAndValueEquals: i ]! ! -!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'nice 12/11/2012 19:56'! +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 12/11/2012 19:53'! testFloorLog - self assert: (1/100 floorLog: 10) = -2. - self assert: (((2 raisedTo: Float emax + 11)/3) floorLog: 10) - = ((Float emax + 11)*2 log - 3 log) floor description: 'Fraction>>log should not overflow'. - self assert: ((3/(2 raisedTo: Float precision - Float emin)) floorLog: 10) - = ((Float emin - Float precision)*2 log + 3 log) floor description: 'Fraction>>log should not underflow'! ! + self assert: (100 floorLog: 10) = 2. + self assert: (((2 raisedTo: Float emax + 3) floorLog: 10) = (2 log*(Float emax + 3)) floor) description: 'Integer>>floorLog: should not overflow'! ! -!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'nice 12/11/2012 22:27'! +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 12/11/2012 22:30'! testFloorLogExactness - 1 + (Float fminDenormalized floorLog: 10) to: -1 do: [:n | + 1 to: (Float fmax floorLog: 10) do: [:n | self assert: ((10 raisedTo: n) floorLog: 10) = n]. "Float version is not exact for at least 2 reasons: - 1/(10 raisedTo: n) asFloat is not exact + (10 raisedTo: n) asFloat is not exact for n > 22 (aFloat log: radix) is not exact - (1 + (Float fminDenormalized floorLog: 10) to: -1) count: [:n | - ((10 raisedTo: n) asFloat floorLog: 10) ~= n]." - ! ! - -!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:38'! -testInexactRaisedTo - " - FractionTest new testInexactRaisedTo - " - self assert: (((1 << 1024 + 1) / (1 << 1024 + 3)) raisedTo: 1/3) = 1.0. - self assert: (((1 << 1024 + 1) / (1 << 1024 + 3)) negated raisedTo: 1/3) = -1.0! ! - -!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:27'! -testInexactSqrt - " - FractionTest new testInexactSqrt - " - self assert: ((1 << 1024 + 1) / (1 << 1024 + 3)) sqrt = 1.0! ! + (1 to: (Float fmax floorLog: 10)) count: [:n | + ((10 raisedTo: n) asFloat floorLog: 10) ~= n]."! ! -!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/18/2018 10:42:49'! +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/18/2018 10:47:37'! testLn - self verify: (1/100) ln isWithinOneFloatAwayFrom: -2 * 10 ln. - self verify: ((2 raisedTo: Float emax + 11) / 3) ln isWithinOneFloatAwayFrom: (Float emax + 11) * 2 ln - 3 ln. - self verify: (3 / (2 raisedTo: Float precision - Float emin)) ln isWithinOneFloatAwayFrom: (Float emin - Float precision) * 2 ln + 3 ln! ! + self verify: 100 ln isWithinOneFloatAwayFrom: 10 ln*2. + self verify: (2 raisedTo: Float emax + 3) ln isWithinOneFloatAwayFrom: 2 ln * (Float emax + 3)! ! -!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/18/2018 10:45:24'! +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/18/2018 10:48:49'! testLog - self assert: (1/100) log = -2. - self verify: ((2 raisedTo: Float emax + 11) / 3) log isWithinOneFloatAwayFrom: (Float emax + 11) * 2 log - 3 log. - self verify: (3 / (2 raisedTo: Float precision - Float emin)) log isWithinOneFloatAwayFrom: (Float emin - Float precision) * 2 log + 3 log.! ! + self assert: 100 log = 2. + self verify: (2 raisedTo: Float emax + 3) log isWithinOneFloatAwayFrom: 2 log * (Float emax + 3)! ! -!FractionTest methodsFor: 'tests - mathematical functions' stamp: 'nice 10/19/2011 20:48'! +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/19/2011 22:48'! testNthRoot - self assert: ((-2 raisedTo: 35) / (3 raisedTo: 20) raisedTo: 1/5) equals: (-2 raisedTo: 7) / (3 raisedTo: 4). - self assert: (1 / (1 << 2000) raisedTo: 1/100) equals: 1 / (1 << 20)! ! + " + IntegerTest new testNthRoot + " + | i | + i _ 1234987687234509123. + #(3 5 7 9 11 13 15 17 19 21 23 25 27) do: [ :n | + self assert: ((i raisedTo: n) nthRoot: n) = i ]. -!FractionTest methodsFor: 'tests - printing' stamp: 'nice 7/24/2010 18:43'! -testFractionPrinting + self shouldnt: [ (1 << 2000 nthRoot: 100) ] raise: ArithmeticError. + self assert: (1 << 2000 nthRoot: 100) equals: 1 << 20! ! - self assert: (353/359) printString = '(353/359)'. - self assert: ((2/3) printStringBase: 2) = '(10/11)'. - self assert: ((2/3) storeStringBase: 2) = '(2r10/2r11)'. - self assert: ((5/7) printStringBase: 3) = '(12/21)'. - self assert: ((5/7) storeStringBase: 3) = '(3r12/3r21)'. - self assert: ((11/13) printStringBase: 4) = '(23/31)'. - self assert: ((11/13) storeStringBase: 4) = '(4r23/4r31)'. - self assert: ((17/19) printStringBase: 5) = '(32/34)'. - self assert: ((17/19) storeStringBase: 5) = '(5r32/5r34)'. - self assert: ((23/29) printStringBase: 6) = '(35/45)'. - self assert: ((23/29) storeStringBase: 6) = '(6r35/6r45)'. - self assert: ((31/37) printStringBase: 7) = '(43/52)'. - self assert: ((31/37) storeStringBase: 7) = '(7r43/7r52)'. - self assert: ((41/43) printStringBase: 8) = '(51/53)'. - self assert: ((41/43) storeStringBase: 8) = '(8r51/8r53)'. - self assert: ((47/53) printStringBase: 9) = '(52/58)'. - self assert: ((47/53) storeStringBase: 9) = '(9r52/9r58)'. - self assert: ((59/61) printStringBase: 10) = '(59/61)'. - self assert: ((59/61) storeStringBase: 10) = '(59/61)'. - self assert: ((67/71) printStringBase: 11) = '(61/65)'. - self assert: ((67/71) storeStringBase: 11) = '(11r61/11r65)'. - self assert: ((73/79) printStringBase: 12) = '(61/67)'. - self assert: ((73/79) storeStringBase: 12) = '(12r61/12r67)'. - self assert: ((83/89) printStringBase: 13) = '(65/6B)'. - self assert: ((83/89) storeStringBase: 13) = '(13r65/13r6B)'. - self assert: ((97/101) printStringBase: 14) = '(6D/73)'. - self assert: ((97/101) storeStringBase: 14) = '(14r6D/14r73)'. - self assert: ((103/107) printStringBase: 15) = '(6D/72)'. - self assert: ((103/107) storeStringBase: 15) = '(15r6D/15r72)'. - self assert: ((109/113) printStringBase: 16) = '(6D/71)'. - self assert: ((109/113) storeStringBase: 16) = '(16r6D/16r71)'. - self assert: ((127/131) printStringBase: 17) = '(78/7C)'. - self assert: ((127/131) storeStringBase: 17) = '(17r78/17r7C)'. - self assert: ((137/139) printStringBase: 18) = '(7B/7D)'. - self assert: ((137/139) storeStringBase: 18) = '(18r7B/18r7D)'. - self assert: ((149/151) printStringBase: 19) = '(7G/7I)'. - self assert: ((149/151) storeStringBase: 19) = '(19r7G/19r7I)'. - self assert: ((157/163) printStringBase: 20) = '(7H/83)'. - self assert: ((157/163) storeStringBase: 20) = '(20r7H/20r83)'. - self assert: ((167/173) printStringBase: 21) = '(7K/85)'. - self assert: ((167/173) storeStringBase: 21) = '(21r7K/21r85)'. - self assert: ((179/181) printStringBase: 22) = '(83/85)'. - self assert: ((179/181) storeStringBase: 22) = '(22r83/22r85)'. - self assert: ((191/193) printStringBase: 23) = '(87/89)'. - self assert: ((191/193) storeStringBase: 23) = '(23r87/23r89)'. - self assert: ((197/199) printStringBase: 24) = '(85/87)'. - self assert: ((197/199) storeStringBase: 24) = '(24r85/24r87)'. - self assert: ((211/223) printStringBase: 25) = '(8B/8N)'. - self assert: ((211/223) storeStringBase: 25) = '(25r8B/25r8N)'. - self assert: ((227/229) printStringBase: 26) = '(8J/8L)'. - self assert: ((227/229) storeStringBase: 26) = '(26r8J/26r8L)'. - self assert: ((233/239) printStringBase: 27) = '(8H/8N)'. - self assert: ((233/239) storeStringBase: 27) = '(27r8H/27r8N)'. - self assert: ((241/251) printStringBase: 28) = '(8H/8R)'. - self assert: ((241/251) storeStringBase: 28) = '(28r8H/28r8R)'. - self assert: ((257/263) printStringBase: 29) = '(8P/92)'. - self assert: ((257/263) storeStringBase: 29) = '(29r8P/29r92)'. - self assert: ((269/271) printStringBase: 30) = '(8T/91)'. - self assert: ((269/271) storeStringBase: 30) = '(30r8T/30r91)'. - self assert: ((277/281) printStringBase: 31) = '(8T/92)'. - self assert: ((277/281) storeStringBase: 31) = '(31r8T/31r92)'. - self assert: ((283/293) printStringBase: 32) = '(8R/95)'. - self assert: ((283/293) storeStringBase: 32) = '(32r8R/32r95)'. - self assert: ((307/311) printStringBase: 33) = '(9A/9E)'. - self assert: ((307/311) storeStringBase: 33) = '(33r9A/33r9E)'. - self assert: ((313/317) printStringBase: 34) = '(97/9B)'. - self assert: ((313/317) storeStringBase: 34) = '(34r97/34r9B)'. - self assert: ((331/337) printStringBase: 35) = '(9G/9M)'. - self assert: ((331/337) storeStringBase: 35) = '(35r9G/35r9M)'. - self assert: ((347/349) printStringBase: 36) = '(9N/9P)'. - self assert: ((347/349) storeStringBase: 36) = '(36r9N/36r9P)'. +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 09:09'! +testNthRootErrorConditions + " + IntegerTest new testExactRaisedToErrorConditions + " - self assert: ((-2/3) printStringBase: 2) = '(-10/11)'. - self assert: ((-2/3) storeStringBase: 2) = '(-2r10/2r11)'. - self assert: ((5 / -7) printStringBase: 3) = '(-12/21)'. - self assert: ((5 / -7) storeStringBase: 3) = '(-3r12/3r21)'. -! ! + self should: [ -2 nthRoot: 1/4 ] raise: ArithmeticError. + self should: [ -2 nthRoot: 1.24 ] raise: ArithmeticError.! ! -!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:56'! -testIntegerWholeDivision - - self assert: 4 / (2/3) classAndValueEquals: 6. - - self assert: 4 / (-2/3) classAndValueEquals: -6. - - self assert: -4 / (-2/3) classAndValueEquals: 6. - - self assert: -4 / (2/3) classAndValueEquals: -6.! ! +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 3/15/2014 14:50'! +testNthRootExactness + | inexactRoots largeRaisedTo6 | + largeRaisedTo6 := (2 to: 100) collect: [:k | (k raisedTo: 11) raisedTo: 6]. + inexactRoots := largeRaisedTo6 reject: [:e | (e nthRoot: 6) isInteger]. + self assert: inexactRoots isEmpty description: 'Failed to find the exact 6th root of these numbers'! ! -!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:56'! -testIntegerWholeMultiplication - - self assert: 4 * (3/2) classAndValueEquals: 6. - - self assert: 4 * (-3/2) classAndValueEquals: -6. +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 10/19/2011 21:03'! +testNthRootTruncated + + | tooBigToBeAFloat large | + tooBigToBeAFloat := 1 << 2000. + self assert: (tooBigToBeAFloat nthRootTruncated: 100) equals: 1 << 20. + self assert: (tooBigToBeAFloat + 1 nthRootTruncated: 100) equals: 1 << 20. + self assert: (tooBigToBeAFloat - 1 nthRootTruncated: 100) equals: 1 << 20 - 1. - self assert: -4 * (-3/2) classAndValueEquals: 6. + large := -3 raisedTo: 255. + self assert: (large nthRootTruncated: 17) equals: (-3 raisedTo: 15). + self assert: (large + 11 nthRootTruncated: 17) equals: (-3 raisedTo: 15) + 1. + self assert: (large - 11 nthRootTruncated: 17) equals: (-3 raisedTo: 15). - self assert: -4 * (3/2) classAndValueEquals: -6.! ! + 2 to: 10 do: [:thePower | + 1 to: 10000 do: [:n | + | theTruncatedRoot | + theTruncatedRoot := n nthRootTruncated: thePower. + self assert: (theTruncatedRoot raisedTo: thePower) <= n. + self assert: (theTruncatedRoot + 1 raisedTo: thePower) > n]]! ! -!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:56'! -testReciprocal +!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'ul 11/25/2009 03:01'! +testSqrtFloor - self - assert: (1/2) reciprocal classAndValueEquals: 2; - assert: (3/4) reciprocal equals: (4/3); - assert: (-1/3) reciprocal classAndValueEquals: -3; - assert: (-3/5) reciprocal equals: (-5/3)! ! + #(-1234567890123 -10 -5 -1) do: [ :each | + self should: [ each sqrtFloor ] raise: Error ]. + #( + 0 1 2 3 4 5 10 16 30 160479924 386234481 501619156 524723498 580855366 766098594 834165249 1020363860 1042083924 1049218924 + 1459774772895569 3050005981408238 4856589481837079 5650488387708463 7831037396100244) do: [ :each | + self assert: each asFloat sqrt floor = each sqrtFloor ] + ! ! -!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:56'! -testWholeDifference - - self assert: (2/3) - (5/3) classAndValueEquals: -1.! ! +!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'nice 12/27/2009 03:11'! +testBitAt + | trials bitSequence2 | -!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:56'! -testWholeDivision - - self assert: (3/2) / (3/4) classAndValueEquals: 2. + self + assert: ((1 to: 100) allSatisfy: [:i | (0 bitAt: i) = 0]) + description: 'all bits of zero are set to zero'. - self assert: (3/2) / (-3/4) classAndValueEquals: -2. + self + assert: ((1 to: 100) allSatisfy: [:i | (-1 bitAt: i) = 1]) + description: 'In two complements, all bits of -1 are set to 1'. + - self assert: (-3/2) / (-3/4) classAndValueEquals: 2. + trials := #( + '2r10010011' + '2r11100100' + '2r10000000' + '2r0000101011011001' + '2r1000101011011001' + '2r0101010101011000' + '2r0010011110110010' + '2r0010011000000000' + '2r00100111101100101000101011011001' + '2r01110010011110110010100110101101' + '2r10101011101011001010000010110110' + '2r10101000000000000000000000000000' + '2r0010101110101001110010100000101101100010011110110010100010101100' + '2r1010101110101100101000001011011000100111101100101000101011011001' + '2r1010101110101000000000000000000000000000000000000000000000000000'). + trials do: [:bitSequence | | aNumber | + aNumber := Number readFrom: bitSequence. + bitSequence2 := (bitSequence size - 2 to: 1 by: -1) inject: '2r' into: [:string :i | string copyWith: (Character digitValue: (aNumber bitAt: i))]. + self assert: bitSequence2 = bitSequence]. - self assert: (-3/2) / (3/4) classAndValueEquals: -2.! ! - -!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:57'! -testWholeMultiplication - - self assert: (3/2) * (4/3) classAndValueEquals: 2. - - self assert: (3/2) * (-4/3) classAndValueEquals: -2. - - self assert: (-3/2) * (-4/3) classAndValueEquals: 2. - - self assert: (-3/2) * (4/3) classAndValueEquals: -2.! ! - -!FractionTest methodsFor: 'tests - arithmetic' stamp: 'nice 1/22/2012 18:57'! -testWholeSum - - self assert: (5/3) + (1/3) classAndValueEquals: 2.! ! + trials do: [:bitSequence | | bitInvert | + bitInvert := -1 - (Number readFrom: bitSequence). + bitSequence2 := (bitSequence size - 2 to: 1 by: -1) inject: '2r' into: [:string :i | string copyWith: (Character digitValue: 1 - (bitInvert bitAt: i))]. + self assert: bitSequence2 = bitSequence description: '-1-x is similar to a bitInvert operation in two complement']! ! -!FractionTest methodsFor: 'tests - conversions' stamp: 'nice 6/3/2011 21:32'! -testCeiling - self assert: (3 / 2) ceiling = 2. - self assert: (-3 / 2) ceiling = -1.! ! +!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'sd 6/5/2005 08:43'! +testBitLogic + "This little suite of tests is designed to verify correct operation of most + of Squeak's bit manipulation code, including two's complement + representation of negative values. It was written in a hurry and + is probably lacking several important checks." -!FractionTest methodsFor: 'tests - conversions' stamp: 'nice 6/3/2011 21:32'! -testFloor - self assert: (3 / 2) floor = 1. - self assert: (-3 / 2) floor = -2.! ! + "Shift 1 bit left then right and test for 1" + "self run: #testBitLogic" + | n | + 1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitShift: i negated) = 1]. -!FractionTest methodsFor: 'tests - conversions' stamp: 'nice 6/3/2011 21:39'! -testRounded - self assert: (4 / 5) rounded = 1. - self assert: (6 / 5) rounded = 1. - self assert: (-4 / 5) rounded = -1. - self assert: (-6 / 5) rounded = -1. - - "In case of tie, round to upper magnitude" - self assert: (3 / 2) rounded = 2. - self assert: (-3 / 2) rounded = -2.! ! + "Shift -1 left then right and test for 1" + 1 to: 100 do: [:i | self assert: ((-1 bitShift: i) bitShift: i negated) = -1]. -!FractionTest methodsFor: 'tests - conversions' stamp: 'nice 6/3/2011 21:35'! -testTruncated - self assert: (3 / 2) truncated = 1. - self assert: (-3 / 2) truncated = -1.! ! + "And a single bit with -1 and test for same value" + 1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitAnd: -1) = (1 bitShift: i)]. -!FractionTest methodsFor: 'tests - invariants' stamp: 'nice 1/22/2012 19:07'! -testThatFractionDenominatorIsPositive - self assert: (-3 / 2) numerator negative description: 'a Fraction sign is allways carried by its numerator'. - self assert: (-3 / 2) denominator positive description: 'a Fraction denominator is allways positive'. - - self assert: (3 / -2) numerator negative description: 'a Fraction sign is allways carried by its numerator'. - self assert: (3 / -2) denominator positive description: 'a Fraction denominator is allways positive'. - - self assert: (-3 / -2) numerator positive description: 'two negative signs are simplified'. - self assert: (-3 / -2) denominator positive description: 'a Fraction denominator is allways positive'.! ! + "Verify that (n bitAnd: n negated) = n for single bits" + 1 to: 100 do: [:i | n := 1 bitShift: i. self assert: (n bitAnd: n negated) = n]. -!FractionTest methodsFor: 'tests - invariants' stamp: 'nice 1/22/2012 19:12'! -testThatFractionIsReduced - self assert: (4 / 6) numerator equals: 2. - self assert: (4 / 6) denominator equals: 3. - - self assert: (4 / 2) classAndValueEquals: 2. - - "Fraction class>>#numerator:denominator: does not automatically reduce the Fraction. - Since it does not guaranty above invariant, it must be used with care." - self assert: (Fraction numerator: 4 denominator: 6) numerator equals: 4. - self assert: (Fraction numerator: 4 denominator: 6) denominator equals: 6. - self assert: (Fraction numerator: 4 denominator: 6) reduced numerator equals: 2. - self assert: (Fraction numerator: 4 denominator: 6) reduced denominator equals: 3.! ! + "Verify that n negated = (n complemented + 1) for single bits" + 1 to: 100 do: [:i | + n := 1 bitShift: i. + self assert: n negated = ((n bitXor: -1) + 1)]. -!FractionTest methodsFor: 'testing' stamp: 'jmv 10/9/2018 09:37:12'! -testHash + "Verify that (n + n complemented) = -1 for single bits" + 1 to: 100 do: [:i | + n := 1 bitShift: i. + self assert: (n + (n bitXor: -1)) = -1]. - | a fraction1 fraction2 | - fraction1 _ 1/3. - fraction2 _ (1/3) + (1e-1000). - self deny: fraction1 = fraction2 description: 'precondition'. - self assert: fraction1 asFloat = fraction2 asFloat description: 'precondition'. - a _ Set new. - a add: fraction1; add: fraction2. - self assert: a size = 2! ! + "Verify that n negated = (n complemented +1) for single bits" + 1 to: 100 do: [:i | + n := 1 bitShift: i. + self assert: n negated = ((n bitXor: -1) + 1)]. -!FractionTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:20:34'! -testIsType - self assert: ((1 / 2100) is: #Fraction). - self assert: ((1 / 2100) is: #Number).! ! + self assert: (-2 bitAnd: 16rFFFFFFFF) = 16rFFFFFFFE.! ! -!FractionTest methodsFor: 'tests - rounding' stamp: 'jmv 10/29/2021 11:13:20'! -testRoundHalfAwayFromZero - "See https://en.wikipedia.org/wiki/Rounding#Round_half_away_from_zero" - self assert: (1/2) roundedHAFZ = 1. - self assert: (3/2) roundedHAFZ = 2. - self assert: (-1/2) roundedHAFZ = -1. - self assert: (-3/2) roundedHAFZ = -2. - self assert: (((0 to: 5 by: 1/4) collect: [ :f | f roundedHAFZ ]) = #(0 0 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4 5 5 5) ). - self assert: (((0 to: -5 by: -1/4) collect: [ :f | f roundedHAFZ ]) = #(0 0 -1 -1 -1 -1 -2 -2 -2 -2 -3 -3 -3 -3 -4 -4 -4 -4 -5 -5 -5) ).! ! +!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'jmv 10/3/2018 18:03:31'! +testBitReversal + { 0. 1. SmallInteger maxVal-1. SmallInteger maxVal. SmallInteger maxVal+1. (2 raisedTo: 64)-1091. (2 raisedTo: 64)-1090. (2 raisedTo: 64)-1 } do: + [ : fixture | + | printedThenReversed reversedThenPrinted | + printedThenReversed := (fixture printStringBase: 2 length: 64 padded: true) reversed. + reversedThenPrinted := (fixture bitReverse: 64) printStringBase: 2 length: 64 padded: true. + self assert: printedThenReversed = reversedThenPrinted ]! ! -!FractionTest methodsFor: 'tests - rounding' stamp: 'jmv 10/9/2018 16:12:18'! -testRoundHalfToEven - "See https://en.wikipedia.org/wiki/Rounding#Round_half_to_even" - self assert: (1/2) rounded = 0. - self assert: (3/2) rounded = 2. - self assert: (-1/2) rounded = 0. - self assert: (-3/2) rounded = -2. - self assert: (((0 to: 5 by: 1/4) collect: [ :f | f rounded ]) = #(0 0 0 1 1 1 2 2 2 2 2 3 3 3 4 4 4 4 4 5 5) ). - self assert: (((0 to: -5 by: -1/4) collect: [ :f | f rounded ]) = #(0 0 0 -1 -1 -1 -2 -2 -2 -2 -2 -3 -3 -3 -4 -4 -4 -4 -4 -5 -5) ).! ! +!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'jmv 6/24/2020 11:23:19'! +testBitReversalCorrectClass + "This test was added due to a bug!! + The problem only happened in 64 bit systems running with jitted Cog VM." -!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:12'! -testAndSingleBitWithMinusOne - "And a single bit with -1 and test for same value" - 1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitAnd: -1) = (1 bitShift: i)].! ! + | a b | + a _ 16r944F245FDBB2B06. + 10 timesRepeat: [ + b _ (a bitReverse: 64) bitReverse: 64. + self assert: a class = b class ]! ! -!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'nice 1/10/2010 17:46'! -testLargeShift - "A sanity check for LargeInteger bitShifts" - +!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'nice 7/8/2008 02:47'! +testHighBit | suite | - suite := #( "some numbers on 64 bits or less" - '101101011101001100110111110110011101101101000001110110011' - '1101101001100010011001101110100000111011011010100011101100' - '101101101011110011001100110011011101011001111000100011101000' - '10101101101000101001111111111100101101011001011000100011100000' - '1000101010101001111011101010111001011111110011110001000110000000' - '1100101010101000010011101000110010111110110011110000000000000001' ). - "65 bits or less" - suite := suite , (suite collect: [:e | '1' , e reversed ]). - "129 bits or less" - suite := suite , (suite collect: [:e | e ,e ]). - suite do: [:bits | | num ls rs | - num := Integer readFrom: bits readStream base: 2. - 0 to: bits size-1 do: [:shift | - ls := (num bitShift: shift) printStringBase: 2. - rs := (num bitShift: 0-shift) printStringBase: 2. - self assert: ls = (bits , (String new: shift withAll: $0)). - self assert: rs = (bits copyFrom: 1 to: bits size - shift). - ]].! ! -!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:13'! -testMixedSignDigitLogic - "Verify that mixed sign logic with large integers works." - self assert: (-2 bitAnd: 16rFFFFFFFF) = 16rFFFFFFFE! ! + suite := (0 to: 1024) asArray , #(16rFDFD 16rFFFF 16r1000 16r1000000 16r1000001 16r70000000 16r7AFAFAFA ) , {SmallInteger maxVal . SmallInteger maxVal+1}. + suite := suite , (suite collect: [:e | e raisedTo: 20]). + + suite do: [:anInteger | + | highBit shifted | + highBit := 0. + shifted := 1. + [shifted > anInteger] whileFalse: [highBit := highBit+1. shifted := shifted bitShift: 1]. + self assert: anInteger highBit = highBit].! ! -!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:12'! -testNBitAndNNegatedEqualsN - "Verify that (n bitAnd: n negated) = n for single bits" - | n | - 1 to: 100 do: [:i | n := 1 bitShift: i. - self assert: (n bitAnd: n negated) = n]! ! +!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'nice 7/8/2008 02:44'! +testHighBitOfMagnitude + | suite | -!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:12'! -testNNegatedEqualsNComplementedPlusOne - "Verify that n negated = (n complemented + 1) for single bits" - | n | - 1 to: 100 do: [:i | n := 1 bitShift: i. - self assert: n negated = ((n bitXor: -1) + 1)]! ! + suite := (0 to: 1024) asArray , #(16rFDFD 16rFFFF 16r1000 16r1000000 16r1000001 16r70000000 16r7AFAFAFA ) , {SmallInteger maxVal . SmallInteger maxVal+1}. + suite := suite , (suite collect: [:e | e raisedTo: 20]). + + suite do: [:anInteger | + | highBit shifted | + highBit := 0. + shifted := 1. + [shifted > anInteger] whileFalse: [highBit := highBit+1. shifted := shifted bitShift: 1]. + self assert: anInteger highBitOfMagnitude = highBit. + self assert: anInteger negated highBitOfMagnitude = highBit].! ! -!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:13'! -testShiftMinusOne1LeftThenRight - "Shift -1 left then right and test for 1" - 1 to: 100 do: [:i | self assert: ((-1 bitShift: i) bitShift: i negated) = -1]. -! ! +!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'jmv 12/10/2018 18:36:38'! +testLowBit + | suite | -!IntegerDigitLogicTest methodsFor: 'tests' stamp: 'hmm 1/7/2002 21:12'! -testShiftOneLeftThenRight - "Shift 1 bit left then right and test for 1" - 1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitShift: i negated) = 1]. -! ! + suite := (0 to: 1024) asArray , #(16rFDFD 16rFFFF 16r1000 16r1000000 16r1000001 16r70000000 16r7AFAFAFA ) , {SmallInteger maxVal . SmallInteger maxVal+1}. + suite := suite , (suite collect: [:e | e raisedTo: 20]). + + suite do: [:anInteger | + | lowBit | + lowBit := (anInteger respondsTo: #bitAt:) + ifTrue: [(1 to: anInteger highBit) detect: [:bitIndex | (anInteger bitAt: bitIndex) ~= 0] ifNone: [0]] + ifFalse: [(1 to: anInteger highBit) detect: [:bitIndex | (anInteger bitAnd: (1 bitShift: bitIndex-1)) ~= 0] ifNone: [0]]. + self assert: anInteger lowBit = lowBit. + self assert: anInteger negated lowBit = lowBit]. + self assert: (LargePositiveInteger new: 0) lowBit = 0. + self assert: (LargePositiveInteger new: 2) lowBit = 0! ! -!IntegerTest methodsFor: 'private' stamp: 'jmv 10/11/2011 08:14'! -assert: a classAndValueEquals: b - self assert: a class = b class. - self assert: a = b! ! +!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'nice 1/26/2008 02:22'! +testTwoComplementBitLogicWithCarry + "This is non regression test for http://bugs.squeak.org/view.php?id=6874" + + "By property of two complement, following operation is: + ...111110000 this is -16 + ...111101111 this is -16-1 + ...111100000 this is -32, the result of bitAnd: on two complement + + This test used to fail with n=31 39 47.... because of bug 6874" + + self assert: ((2 to: 80) allSatisfy: [:n | ((2 raisedTo: n) negated bitAnd: (2 raisedTo: n) negated - 1) = (2 raisedTo: n + 1) negated]).! ! -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:01'! -testBackslashBackslashLnLn +!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'sd 6/5/2005 08:44'! +testTwoComplementRightShift + "self run: #testTwoComplementRightShift" - self assert: -42391158275216203514294433200 \\ -14130386091738734504764811067 = -14130386091738734504764811066. - self assert: -42391158275216203514294433201 \\ -14130386091738734504764811067 = 0. - self assert: -42391158275216203514294433202 \\ -14130386091738734504764811067 = -1. - self assert: -8727963568087712425891397479476727340041448 \\ -79766443076872509863361 = -79766443076872509863360. - self assert: -8727963568087712425891397479476727340041449 \\ -79766443076872509863361 = 0. - self assert: -8727963568087712425891397479476727340041450 \\ -79766443076872509863361 = -1! ! + | large small | + small := 2 << 16. + large := 2 << 32. + self assert: ((small negated bitShift: -1) ~= ((small + 1) negated bitShift: -1) + == ((large negated bitShift: -1) ~= ((large + 1) negated bitShift: -1))). + + self assert: ((small bitShift: -1) ~= (small + 1 bitShift: -1) + == ((large bitShift: -1) ~= (large + 1 bitShift: -1))).! ! -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:00'! -testBackslashBackslashLnLp +!IntegerTest methodsFor: 'testing - arithmetic' stamp: 'mga 5/11/2006 15:41'! +testCrossSumBase + "self run: #testCrossSumBase" - self assert: -42391158275216203514294433200 \\ 14130386091738734504764811067 = 1. - self assert: -42391158275216203514294433201 \\ 14130386091738734504764811067 = 0. - self assert: -42391158275216203514294433202 \\ 14130386091738734504764811067 = 14130386091738734504764811066. - self assert: -8727963568087712425891397479476727340041448 \\ 79766443076872509863361 = 1. - self assert: -8727963568087712425891397479476727340041449 \\ 79766443076872509863361 = 0. - self assert: -8727963568087712425891397479476727340041450 \\ 79766443076872509863361 = 79766443076872509863360! ! + self assert: ( + ((-20 to: 20) collect: [:each | each crossSumBase: 10]) asArray = + #(2 10 9 8 7 6 5 4 3 2 1 9 8 7 6 5 4 3 2 1 0 1 2 3 4 5 6 7 8 9 1 2 3 4 5 6 7 8 9 10 2)). + self assert: ( + ((-20 to: 20) collect: [:each | each crossSumBase: 2]) asArray = + #(2 3 2 2 1 4 3 3 2 3 2 2 1 3 2 2 1 2 1 1 0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4 1 2 2 3 2)). + self should: [10 crossSumBase: 1] raise: AssertionFailure! ! -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:01'! -testBackslashBackslashLnSn +!IntegerTest methodsFor: 'testing - arithmetic' stamp: 'nice 1/9/2013 02:11'! +testIntegerDivision + | suite | + suite := #( 1 2 5 1000 123456798 111222333444555 987654321098765432109876 ). + suite := suite , (suite collect: [:e | e negated]). + suite do: [:a | + suite do: [:b | + | q r | + q := a // b. + r := a \\ b. + self assert: b * q + r = a. + self assert: r abs < b abs. + self assert: (r isZero or: [b negative = r negative])]].! ! - self assert: -42391158275216203514294433201 \\ -3 = 0. - self assert: -42391158275216203514294433202 \\ -3 = -1. - self assert: -42391158275216203514294433203 \\ -3 = -2. - self assert: -42391158275216203514294433204 \\ -3 = 0! ! +!IntegerTest methodsFor: 'testing - arithmetic' stamp: 'nice 1/16/2013 18:38'! +testMontgomeryMultiplication + | a m mInv | + m := 15485863. + mInv := m montgomeryDigitBase - ((m bitAnd: m montgomeryDigitMax) reciprocalModulo: m montgomeryDigitBase). + a := (m montgomeryDigitBase raisedTo: m montgomeryNumberOfDigits) \\ m. + #(483933 3871465 8951195) do: [:s | + (s montgomeryTimes: a modulo: m mInvModB: mInv) ifNotNil: [:s1 | + | s2 sa ssa | + self assert: s = s1. + sa := s montgomeryTimes: (a * a \\ m) modulo: m mInvModB: mInv. + self assert: sa = (s * a \\ m). + ssa := sa montgomeryTimes: sa modulo: m mInvModB: mInv. + self assert: ssa = (s * s * a \\ m). + s2 := ssa montgomeryTimes: 1 modulo: m mInvModB: mInv. + self assert: s2 = (s * s \\ m)]].! ! -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:02'! -testBackslashBackslashLnSp +!IntegerTest methodsFor: 'testing - arithmetic' stamp: 'nice 1/9/2013 02:11'! +testQuoRem + | suite | + suite := #( 1 2 5 1000 123456798 111222333444555 987654321098765432109876 ). + suite := suite , (suite collect: [:e | e negated]). + suite do: [:a | + suite do: [:b | + | q r | + q := a quo: b. + r := a rem: b. + self assert: b * q + r = a. + self assert: r abs < b abs. + self assert: (r isZero or: [a negative = r negative])]].! ! - self assert: -42391158275216203514294433201 \\ 3 = 0. - self assert: -42391158275216203514294433202 \\ 3 = 2. - self assert: -42391158275216203514294433203 \\ 3 = 1. - self assert: -42391158275216203514294433204 \\ 3 = 0! ! +!IntegerTest methodsFor: 'testing - arithmetic' stamp: 'nice 6/4/2011 20:46'! +testRaisedToModulo + #(301 2047) do: [:m | + 1 to: m - 1 by: (m // 30) do: [:x | + 11 to: m - 1 by: (m // 40) do: [:y | + self assert: (x raisedTo: y) \\ m = (x raisedTo: y modulo: m)]]]. + self assert: (8951195 raisedTo: 7742931 modulo: 15485863) = 15485862.! ! -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:04'! -testBackslashBackslashLpLn +!IntegerTest methodsFor: 'tests - basic' stamp: 'md 4/21/2003 16:17'! +testEven + + self deny: (1073741825 even). + self assert: (1073741824 even). + ! ! - self assert: 42391158275216203514294433200 \\ -14130386091738734504764811067 = -1. - self assert: 42391158275216203514294433201 \\ -14130386091738734504764811067 = 0. - self assert: 42391158275216203514294433202 \\ -14130386091738734504764811067 = -14130386091738734504764811066. - self assert: 8727963568087712425891397479476727340041448 \\ -79766443076872509863361 = -1. - self assert: 8727963568087712425891397479476727340041449 \\ -79766443076872509863361 = 0. - self assert: 8727963568087712425891397479476727340041450 \\ -79766443076872509863361 = -79766443076872509863360! ! +!IntegerTest methodsFor: 'tests - basic' stamp: 'jpb 8/2/2019 23:55:59'! +testIsInteger + self assert: 0 isInteger. + self assert: (0 is: #Integer). + self assert: (1 is: #Integer). + self assert: (1 is: #Number). + + self assert: (10000 is: #Integer). + self assert: (10000 is: #Number).! ! -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:05'! -testBackslashBackslashLpLp +!IntegerTest methodsFor: 'tests - basic' stamp: 'md 4/15/2003 20:40'! +testIsPowerOfTwo - self assert: 42391158275216203514294433200 \\ 14130386091738734504764811067 = 14130386091738734504764811066. - self assert: 42391158275216203514294433201 \\ 14130386091738734504764811067 = 0. - self assert: 42391158275216203514294433202 \\ 14130386091738734504764811067 = 1. - self assert: 8727963568087712425891397479476727340041448 \\ 79766443076872509863361 = 79766443076872509863360. - self assert: 8727963568087712425891397479476727340041449 \\ 79766443076872509863361 = 0. - self assert: 8727963568087712425891397479476727340041450 \\ 79766443076872509863361 = 1! ! + self assert: (0 isPowerOfTwo). + self assert: (1 isPowerOfTwo). + self assert: (2 isPowerOfTwo). + self deny: (3 isPowerOfTwo). + self assert: (4 isPowerOfTwo). + ! ! -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:06'! -testBackslashBackslashLpSn +!IntegerTest methodsFor: 'tests - basic' stamp: 'nice 1/25/2008 22:51'! +testIsPowerOfTwoM6873 + "This is a non regression test for http://bugs.squeak.org/view.php?id=6873" - self assert: 42391158275216203514294433201 \\ -3 = 0. - self assert: 42391158275216203514294433202 \\ -3 = -2. - self assert: 42391158275216203514294433203 \\ -3 = -1. - self assert: 42391158275216203514294433204 \\ -3 = 0! ! + self deny: ((1 to: 80) anySatisfy: [:n | (2 raisedTo: n) negated isPowerOfTwo]) + description: 'A negative integer cannot be a power of two'.! ! -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:07'! -testBackslashBackslashLpSp +!IntegerTest methodsFor: 'tests - basic' stamp: 'ul 11/25/2009 02:51'! +testIsPrime - self assert: 42391158275216203514294433201 \\ 3 = 0. - self assert: 42391158275216203514294433202 \\ 3 = 1. - self assert: 42391158275216203514294433203 \\ 3 = 2. - self assert: 42391158275216203514294433204 \\ 3 = 0! ! + "Not primes:" + #(-100 -5 -3 -2 -1 0 1) do: [ :each | + self deny: each isPrime ]. -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:08'! -testBackslashBackslashSnLn + "The following tests should return 'true'" + #(17 78901 104729 15485863 2038074743) do: [ :each | + self assert: each isPrime ]. + + "The following tests should return 'false' (first 5 are Carmichael integers)" + #(561 2821 6601 10585 15841 256 29996224275831) do: [ :each | + self deny: each isPrime ].! ! - self assert: 0 \\ -42391158275216203514294433201 = 0. - self assert: -1 \\ -42391158275216203514294433201 = -1. - self assert: -14348907 \\ -42391158275216203514294433201 = -14348907! ! +!IntegerTest methodsFor: 'tests - basic' stamp: 'ul 11/25/2009 02:49'! +testIsProbablyPrime -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:09'! -testBackslashBackslashSnLp + "Not primes:" + #(-100 -5 -3 -2 -1 0 1) do: [ :each | + self deny: each isProbablyPrime ]. - self assert: 0 \\ 42391158275216203514294433201 = 0. - self assert: -1 \\ 42391158275216203514294433201 = 42391158275216203514294433200. - self assert: -14348907 \\ 42391158275216203514294433201 = 42391158275216203514280084294! ! + "The following tests should return 'true'" + #(17 78901 104729 15485863 2038074743 29996224275833) do: [ :each | + self assert: each isProbablyPrime ]. + + "The following tests should return 'false' (first 5 are Carmichael integers)" + #(561 2821 6601 10585 15841 256 29996224275831) do: [ :each | + self deny: each isProbablyPrime ].! ! -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:09'! -testBackslashBackslashSnSn +!IntegerTest methodsFor: 'tests - basic' stamp: 'md 2/12/2006 14:36'! +testLargePrimesUpTo - self assert: 0 \\ -3 = 0. - self assert: -1 \\ -3 = -1. - self assert: -9 \\ -3 = 0. - self assert: -10 \\ -3 = -1. - self assert: -11 \\ -3 = -2. - self assert: -12 \\ -3 = 0. - self assert: -13 \\ -3 = -1! ! + | nn | + nn := (2 raisedTo: 17) - 1. + self deny: (Integer primesUpTo: nn) last = nn. + self assert: (Integer primesUpTo: nn + 1) last = nn. + + +! ! -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:10'! -testBackslashBackslashSnSp +!IntegerTest methodsFor: 'tests - basic' stamp: 'md 2/12/2006 14:36'! +testPrimesUpTo - self assert: 0 \\ 3 = 0. - self assert: -1 \\ 3 = 2. - self assert: -9 \\ 3 = 0. - self assert: -10 \\ 3 = 2. - self assert: -11 \\ 3 = 1. - self assert: -12 \\ 3 = 0. - self assert: -13 \\ 3 = 2! ! + | primes nn| + primes := Integer primesUpTo: 100. + self assert: primes = #(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97). + + "upTo: semantics means 'non-inclusive'" + primes := Integer primesUpTo: 5. + self assert: primes = #(2 3). + + "this test is green for nn>25000, see #testLargePrimesUpTo" + nn := 5. + self deny: (Integer primesUpTo: nn) last = nn. + self assert: (Integer primesUpTo: nn + 1) last = nn.! ! -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:11'! -testBackslashBackslashSpLn +!IntegerTest methodsFor: 'tests - basic' stamp: 'eem 7/16/2014 15:29'! +testRange + self assert: SmallInteger maxVal class equals: SmallInteger. + self assert: (SmallInteger maxVal + 1) class equals: LargePositiveInteger. + self assert: SmallInteger minVal class equals: SmallInteger. + self assert: (SmallInteger minVal - 1) class equals: LargeNegativeInteger! ! - self assert: 0 \\ -42391158275216203514294433201 = 0. - self assert: 1 \\ -42391158275216203514294433201 = -42391158275216203514294433200. - self assert: 14348907 \\ -42391158275216203514294433201 = -42391158275216203514280084294! ! +!IntegerTest methodsFor: 'tests - instance creation' stamp: 'sd 6/5/2005 08:46'! +testDifferentBases + "self run: #testDifferentBases" + "| value | + 2 to: 36 do: [:each| + value := 0. + 1 to: each-1 do: [:n| value := value + (n * (each raisedToInteger: n))]. + value := value negated. + Transcript tab; show: 'self assert: (', value printString, ' printStringBase: ', each printString, ') = ''', (value printStringBase: each), '''.'; cr. + Transcript tab; show: 'self assert: (', value printString, ' radix: ', each printString, ') = ''', (value radix: each), '''.'; cr. + Transcript tab; show: 'self assert: ', value printString, ' printStringHex = ''', (value printStringBase: 16), '''.'; cr. + Transcript tab; show: 'self assert: (', value printString, ' storeStringBase: ', each printString, ') = ''', (value storeStringBase: each), '''.'; cr. + Transcript tab; show: 'self assert: ', value printString, ' storeStringHex = ''', (value storeStringBase: 16), '''.'; cr. -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:12'! -testBackslashBackslashSpLp - self assert: 0 \\ 42391158275216203514294433201 = 0. - self assert: 1 \\ 42391158275216203514294433201 = 1. - self assert: 14348907 \\ 42391158275216203514294433201 = 14348907! ! +]. + " -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:13'! -testBackslashBackslashSpSn + self assert: 2r10 = 2. + self assert: 3r210 = 21. + self assert: 4r3210 = 228. + self assert: 5r43210 = 2930. + self assert: 6r543210 = 44790. + self assert: 7r6543210 = 800667. + self assert: 8r76543210 = 16434824. + self assert: 9r876543210 = 381367044. + self assert: 10r9876543210 = 9876543210. + self assert: 11rA9876543210 = 282458553905. + self assert: 12rBA9876543210 = 8842413667692. + self assert: 13rCBA9876543210 = 300771807240918. + self assert: 14rDCBA9876543210 = 11046255305880158. + self assert: 15rEDCBA9876543210 = 435659737878916215. + self assert: 16rFEDCBA9876543210 = 18364758544493064720. + self assert: 17rGFEDCBA9876543210 = 824008854613343261192. + self assert: 18rHGFEDCBA9876543210 = 39210261334551566857170. + self assert: 19rIHGFEDCBA9876543210 = 1972313422155189164466189. + self assert: 20rJIHGFEDCBA9876543210 = 104567135734072022160664820. + self assert: 21rKJIHGFEDCBA9876543210 = 5827980550840017565077671610. + self assert: 22rLKJIHGFEDCBA9876543210 = 340653664490377789692799452102. + self assert: 23rMLKJIHGFEDCBA9876543210 = 20837326537038308910317109288851. + self assert: 24rNMLKJIHGFEDCBA9876543210 = 1331214537196502869015340298036888. + self assert: 25rONMLKJIHGFEDCBA9876543210 = 88663644327703473714387251271141900. + self assert: 26rPONMLKJIHGFEDCBA9876543210 = 6146269788878825859099399609538763450. + self assert: 27rQPONMLKJIHGFEDCBA9876543210 = 442770531899482980347734468443677777577. + self assert: 28rRQPONMLKJIHGFEDCBA9876543210 = 33100056003358651440264672384704297711484. + self assert: 29rSRQPONMLKJIHGFEDCBA9876543210 = 2564411043271974895869785066497940850811934. + self assert: 30rTSRQPONMLKJIHGFEDCBA9876543210 = 205646315052919334126040428061831153388822830. + self assert: 31rUTSRQPONMLKJIHGFEDCBA9876543210 = 17050208381689099029767742314582582184093573615. + self assert: 32rVUTSRQPONMLKJIHGFEDCBA9876543210 = 1459980823972598128486511383358617792788444579872. + self assert: 33rWVUTSRQPONMLKJIHGFEDCBA9876543210 = 128983956064237823710866404905431464703849549412368. + self assert: 34rXWVUTSRQPONMLKJIHGFEDCBA9876543210 = 11745843093701610854378775891116314824081102660800418. + self assert: 35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = 1101553773143634726491620528194292510495517905608180485. + self assert: 36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = 106300512100105327644605138221229898724869759421181854980. - self assert: 0 \\ -3 = 0. - self assert: 1 \\ -3 = -2. - self assert: 9 \\ -3 = 0. - self assert: 10 \\ -3 = -2. - self assert: 11 \\ -3 = -1. - self assert: 12 \\ -3 = 0. - self assert: 13 \\ -3 = -2! ! + self assert: -2r10 = -2. + self assert: -3r210 = -21. + self assert: -4r3210 = -228. + self assert: -5r43210 = -2930. + self assert: -6r543210 = -44790. + self assert: -7r6543210 = -800667. + self assert: -8r76543210 = -16434824. + self assert: -9r876543210 = -381367044. + self assert: -10r9876543210 = -9876543210. + self assert: -11rA9876543210 = -282458553905. + self assert: -12rBA9876543210 = -8842413667692. + self assert: -13rCBA9876543210 = -300771807240918. + self assert: -14rDCBA9876543210 = -11046255305880158. + self assert: -15rEDCBA9876543210 = -435659737878916215. + self assert: -16rFEDCBA9876543210 = -18364758544493064720. + self assert: -17rGFEDCBA9876543210 = -824008854613343261192. + self assert: -18rHGFEDCBA9876543210 = -39210261334551566857170. + self assert: -19rIHGFEDCBA9876543210 = -1972313422155189164466189. + self assert: -20rJIHGFEDCBA9876543210 = -104567135734072022160664820. + self assert: -21rKJIHGFEDCBA9876543210 = -5827980550840017565077671610. + self assert: -22rLKJIHGFEDCBA9876543210 = -340653664490377789692799452102. + self assert: -23rMLKJIHGFEDCBA9876543210 = -20837326537038308910317109288851. + self assert: -24rNMLKJIHGFEDCBA9876543210 = -1331214537196502869015340298036888. + self assert: -25rONMLKJIHGFEDCBA9876543210 = -88663644327703473714387251271141900. + self assert: -26rPONMLKJIHGFEDCBA9876543210 = -6146269788878825859099399609538763450. + self assert: -27rQPONMLKJIHGFEDCBA9876543210 = -442770531899482980347734468443677777577. + self assert: -28rRQPONMLKJIHGFEDCBA9876543210 = -33100056003358651440264672384704297711484. + self assert: -29rSRQPONMLKJIHGFEDCBA9876543210 = -2564411043271974895869785066497940850811934. + self assert: -30rTSRQPONMLKJIHGFEDCBA9876543210 = -205646315052919334126040428061831153388822830. + self assert: -31rUTSRQPONMLKJIHGFEDCBA9876543210 = -17050208381689099029767742314582582184093573615. + self assert: -32rVUTSRQPONMLKJIHGFEDCBA9876543210 = -1459980823972598128486511383358617792788444579872. + self assert: -33rWVUTSRQPONMLKJIHGFEDCBA9876543210 = -128983956064237823710866404905431464703849549412368. + self assert: -34rXWVUTSRQPONMLKJIHGFEDCBA9876543210 = -11745843093701610854378775891116314824081102660800418. + self assert: -35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = -1101553773143634726491620528194292510495517905608180485. + self assert: -36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = -106300512100105327644605138221229898724869759421181854980.! ! -!IntegerTest methodsFor: 'tests - division - \\' stamp: 'sqr 1/25/2014 14:13'! -testBackslashBackslashSpSp +!IntegerTest methodsFor: 'tests - instance creation' stamp: 'jmv 9/1/2010 13:56'! +testIntegerReadFrom + self assert: (Integer readFrom: '123' readStream base: 10) = 123. + self assert: (Integer readFrom: '-123' readStream base: 10) = -123. + self should: [Integer readFrom: 'abc' readStream base: 10] raise: Error. + self should: [Integer readFrom: 'D12' readStream base: 10] raise: Error. + self assert: (Integer readFrom: '1two3' readStream base: 10) = 1. +! ! - self assert: 0 \\ 3 = 0. - self assert: 1 \\ 3 = 1. - self assert: 9 \\ 3 = 0. - self assert: 10 \\ 3 = 1. - self assert: 11 \\ 3 = 2. - self assert: 12 \\ 3 = 0. - self assert: 13 \\ 3 = 1! ! +!IntegerTest methodsFor: 'tests - instance creation' stamp: 'md 3/25/2003 23:14'! +testNew + self should: [Integer new] raise: TestResult error. ! ! -!IntegerTest methodsFor: 'tests - benchmarks' stamp: 'sd 6/5/2005 08:37'! -testBenchFib +!IntegerTest methodsFor: 'tests - instance creation' stamp: 'jmv 9/1/2010 13:26'! +testReadFrom + "Ensure remaining characters in a stream are not lost when parsing an integer." - self assert: (0 benchFib = 1). - self assert: (1 benchFib = 1). - self assert: (2 benchFib = 3). - ! ! + | rs i s | + rs := ReadStream on: '123s could be confused with a ScaledDecimal'. + i := Number readFrom: rs. + self assert: i isInteger. + self assert: i = 123. + s := rs upToEnd. + self assert: 's could be confused with a ScaledDecimal' = s. + + "Modified for Cuis. Classic number parsing considers this to be an integer." + rs := ReadStream on: '123.s could be confused with a ScaledDecimal'. + i := Number readFrom: rs. + self assert: i isInteger. + self assert: i = 123. + s := rs upToEnd. + self assert: '.s could be confused with a ScaledDecimal' = s +! ! -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 8/21/2016 20:02:52'! -testBigReceiverInexactNthRoot - " - IntegerTest new testBigReceiverInexactNthRoot - " +!IntegerTest methodsFor: 'tests - instance creation' stamp: 'jmv 9/1/2010 13:45'! +testStringAsNumber + "This covers parsing in Number>>readFrom: + Trailing decimal points should be ignored." - "Inexact 3rd root (not a whole cube number), so a Float must be answered. - However, receiver is too big for Float arithmethic." - | bigNum result | - bigNum _ (100 factorial raisedTo: 3) + 1. "Add 1 so it is not a whole cube" - self assert: bigNum asFloat isInfinite. "Otherwise, we chose a bad sample" - result _ bigNum nthRoot: 3. - self assert: result isFloat. - self deny: result isInfinite. - self assert: result = 100 factorial asFloat. "No other float is closer. See following line" - self assert: 100 factorial asFloat = (100 factorial+1) asFloat! ! + self assert: ('123' asNumber isInteger). + self assert: ('123' asNumber = 123). + self assert: ('-123' asNumber isInteger). + self assert: ('-123' asNumber = -123). + self assert: ('123.' asNumber) isInteger. + self assert: ('123.' asNumber = 123). + self assert: ('-123.' asNumber) isInteger. + self assert: ('-123.' asNumber = -123). + self assert: ('123This is not to be read' asNumber isInteger). + self assert: ('123This is not to be read' asNumber = 123). + self assert: ('123s could be confused with a ScaledDecimal' asNumber isInteger). + self assert: ('123s could be confused with a ScaledDecimal' asNumber = 123). + self assert: ('123e could be confused with a Float' asNumber isInteger). + self assert: ('123e could be confused with a Float' asNumber = 123). +! ! -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 8/21/2016 20:03:04'! -testBigReceiverInexactSqrt - " - IntegerTest new testBigReceiverInexactSqrt - " +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:53'! +testDivLnLn - "Inexact 3rd root (not a whole cube number), so a Float must be answered. - However, receiver is too big for Float arithmethic." - | bigNum result | - bigNum _ 100 factorial squared + 1. "Add 1 so it is not a whole square" - self assert: bigNum asFloat isInfinite. "Otherwise, we chose a bad sample" - result _ bigNum sqrt. - self assert: result isFloat. - self deny: result isInfinite. - self assert: result = 100 factorial asFloat. "No other float is closer. See following lines" - self assert: (result successor asFraction squared - bigNum) abs >= (result asFraction squared - bigNum) abs. - self assert: (result predecessor asFraction squared - bigNum) abs >= (result asFraction squared - bigNum) abs.! ! + self assert: (-42391158275216203514294433200 div: -14130386091738734504764811067) = 3. + self assert: (-42391158275216203514294433201 div: -14130386091738734504764811067) = 3. + self assert: (-42391158275216203514294433202 div: -14130386091738734504764811067) = 4. + self assert: (-8727963568087712425891397479476727340041448 div: -79766443076872509863361) = 109418989131512359209. + self assert: (-8727963568087712425891397479476727340041449 div: -79766443076872509863361) = 109418989131512359209. + self assert: (-8727963568087712425891397479476727340041450 div: -79766443076872509863361) = 109418989131512359210! ! -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 21:46'! -testExactRaisedTo - " - IntegerTest new testExactRaisedTo - " - self assert: (4 raisedTo: 1/2) classAndValueEquals: 2. - self assert: (9 raisedTo: 1/2) classAndValueEquals: 3. - self assert: (9 raisedTo: -1/2) classAndValueEquals: 1/3. - self assert: (-1 raisedTo: 1/3) classAndValueEquals: -1. - #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i | - self assert: (i squared raisedTo: 1/2) classAndValueEquals: i. - self assert: (i negated squared raisedTo: 1/2) classAndValueEquals: i ]. +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:53'! +testDivLnLp - self assert: (8 raisedTo: 1/3) classAndValueEquals: 2. - self assert: (27 raisedTo: 1/3) classAndValueEquals: 3. - #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i | - self assert: ((i raisedTo: 3) raisedTo: 1/3) classAndValueEquals: i. - self assert: ((i negated raisedTo: 3) raisedTo: 1/3) classAndValueEquals: i negated ]. + self assert: (-42391158275216203514294433200 div: 14130386091738734504764811067) = -3. + self assert: (-42391158275216203514294433201 div: 14130386091738734504764811067) = -3. + self assert: (-42391158275216203514294433202 div: 14130386091738734504764811067) = -4. + self assert: (-8727963568087712425891397479476727340041448 div: 79766443076872509863361) = -109418989131512359209. + self assert: (-8727963568087712425891397479476727340041449 div: 79766443076872509863361) = -109418989131512359209. + self assert: (-8727963568087712425891397479476727340041450 div: 79766443076872509863361) = -109418989131512359210! ! - self assert: (4 raisedTo: 3/2) classAndValueEquals: 8. - self assert: (8 raisedTo: 2/3) classAndValueEquals: 4. - self assert: (8 raisedTo: -2/3) classAndValueEquals: 1/4. - #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i | - self assert: ((i raisedTo: 3) raisedTo: 2/3) classAndValueEquals: i*i. - self assert: ((i raisedTo: 2) raisedTo: 3/2) classAndValueEquals: i*i*i. - self assert: ((i negated raisedTo: 3) raisedTo: 2/3) classAndValueEquals: i*i. - self assert: ((i negated raisedTo: 2) raisedTo: 3/2) classAndValueEquals: i*i*i ]. +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:54'! +testDivLnSn - self assert: (32 raisedTo: 3/5) classAndValueEquals: 8. - self assert: (8 raisedTo: 5/3) classAndValueEquals: 32. - #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i | - self assert: ((i raisedTo: 5) raisedTo: 3/5) classAndValueEquals: i*i*i. - self assert: ((i raisedTo: 3) raisedTo: 5/3) classAndValueEquals: i*i*i*i*i. - self assert: ((i negated raisedTo: 5) raisedTo: 3/5) classAndValueEquals: (i*i*i) negated. - self assert: ((i negated raisedTo: 3) raisedTo: 5/3) classAndValueEquals: (i*i*i*i*i) negated. + self assert: (-42391158275216203514294433201 div: -3) = 14130386091738734504764811067. + self assert: (-42391158275216203514294433202 div: -3) = 14130386091738734504764811068. + self assert: (-42391158275216203514294433203 div: -3) = 14130386091738734504764811068. + self assert: (-42391158275216203514294433204 div: -3) = 14130386091738734504764811068! ! - self assert: ((i raisedTo: -5) raisedTo: 3/5) classAndValueEquals: 1/(i*i*i). - self assert: ((i raisedTo: -3) raisedTo: 5/3) classAndValueEquals: 1/(i*i*i*i*i). - self assert: ((i negated raisedTo: -5) raisedTo: 3/5) classAndValueEquals: -1/(i*i*i). - self assert: ((i negated raisedTo: -3) raisedTo: 5/3) classAndValueEquals: -1/(i*i*i*i*i). +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! +testDivLnSp - self assert: ((i raisedTo: 5) raisedTo: -3/5) classAndValueEquals: 1/(i*i*i). - self assert: ((i raisedTo: 3) raisedTo: -5/3) classAndValueEquals: 1/(i*i*i*i*i). - self assert: ((i negated raisedTo: 5) raisedTo: -3/5) classAndValueEquals: -1/(i*i*i). - self assert: ((i negated raisedTo: 3) raisedTo: -5/3) classAndValueEquals: -1/(i*i*i*i*i). + self assert: (-42391158275216203514294433201 div: 3) = -14130386091738734504764811067. + self assert: (-42391158275216203514294433202 div: 3) = -14130386091738734504764811068. + self assert: (-42391158275216203514294433203 div: 3) = -14130386091738734504764811068. + self assert: (-42391158275216203514294433204 div: 3) = -14130386091738734504764811068! ! - "No exact result => Float result" - self assert: ((i raisedTo: 3) +1 raisedTo: 5/3) isFloat. - self assert: ((i negated raisedTo: 3) -1 raisedTo: 5/3) isFloat ].! ! +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:54'! +testDivLpLn -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/11/2011 22:09'! -testExactSqrt - " - IntegerTest new testExactSqrt - " - self assert: 4 sqrt classAndValueEquals: 2. - self assert: 9 sqrt classAndValueEquals: 3. - self assert: Float maxExactInteger squared sqrt classAndValueEquals: Float maxExactInteger. - self assert: (Float maxExactInteger+1) squared sqrt classAndValueEquals: Float maxExactInteger+1. - #( 1 5 29 135 1234 567890 123123123 456456456456 98765432109876543210987654321 987123987123987123987123987123987123987123987123) do: [ :i | - self assert: i squared sqrt classAndValueEquals: i ]! ! + self assert: (42391158275216203514294433200 div: -14130386091738734504764811067) = -2. + self assert: (42391158275216203514294433201 div: -14130386091738734504764811067) = -3. + self assert: (42391158275216203514294433202 div: -14130386091738734504764811067) = -3. + self assert: (8727963568087712425891397479476727340041448 div: -79766443076872509863361) = -109418989131512359208. + self assert: (8727963568087712425891397479476727340041449 div: -79766443076872509863361) = -109418989131512359209. + self assert: (8727963568087712425891397479476727340041450 div: -79766443076872509863361) = -109418989131512359209! ! -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 12/11/2012 19:53'! -testFloorLog - self assert: (100 floorLog: 10) = 2. - self assert: (((2 raisedTo: Float emax + 3) floorLog: 10) = (2 log*(Float emax + 3)) floor) description: 'Integer>>floorLog: should not overflow'! ! +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! +testDivLpLp -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 12/11/2012 22:30'! -testFloorLogExactness + self assert: (42391158275216203514294433200 div: 14130386091738734504764811067) = 2. + self assert: (42391158275216203514294433201 div: 14130386091738734504764811067) = 3. + self assert: (42391158275216203514294433202 div: 14130386091738734504764811067) = 3. + self assert: (8727963568087712425891397479476727340041448 div: 79766443076872509863361) = 109418989131512359208. + self assert: (8727963568087712425891397479476727340041449 div: 79766443076872509863361) = 109418989131512359209. + self assert: (8727963568087712425891397479476727340041450 div: 79766443076872509863361) = 109418989131512359209! ! - 1 to: (Float fmax floorLog: 10) do: [:n | - self assert: ((10 raisedTo: n) floorLog: 10) = n]. +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:55'! +testDivLpSn - "Float version is not exact for at least 2 reasons: - (10 raisedTo: n) asFloat is not exact for n > 22 - (aFloat log: radix) is not exact + self assert: (42391158275216203514294433201 div: -3) = -14130386091738734504764811067. + self assert: (42391158275216203514294433202 div: -3) = -14130386091738734504764811067. + self assert: (42391158275216203514294433203 div: -3) = -14130386091738734504764811067. + self assert: (42391158275216203514294433204 div: -3) = -14130386091738734504764811068! ! - (1 to: (Float fmax floorLog: 10)) count: [:n | - ((10 raisedTo: n) asFloat floorLog: 10) ~= n]."! ! +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! +testDivLpSp -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/18/2018 10:47:37'! -testLn - self verify: 100 ln isWithinOneFloatAwayFrom: 10 ln*2. - self verify: (2 raisedTo: Float emax + 3) ln isWithinOneFloatAwayFrom: 2 ln * (Float emax + 3)! ! + self assert: (42391158275216203514294433201 div: 3) = 14130386091738734504764811067. + self assert: (42391158275216203514294433202 div: 3) = 14130386091738734504764811067. + self assert: (42391158275216203514294433203 div: 3) = 14130386091738734504764811067. + self assert: (42391158275216203514294433204 div: 3) = 14130386091738734504764811068! ! -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 12/18/2018 10:48:49'! -testLog - self assert: 100 log = 2. - self verify: (2 raisedTo: Float emax + 3) log isWithinOneFloatAwayFrom: 2 log * (Float emax + 3)! ! +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:55'! +testDivSnLn -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/19/2011 22:48'! -testNthRoot - " - IntegerTest new testNthRoot - " - | i | - i _ 1234987687234509123. - #(3 5 7 9 11 13 15 17 19 21 23 25 27) do: [ :n | - self assert: ((i raisedTo: n) nthRoot: n) = i ]. + self assert: (0 div: -42391158275216203514294433201) = 0. + self assert: (-1 div: -42391158275216203514294433201) = 1. + self assert: (-14348907 div: -42391158275216203514294433201) = 1! ! - self shouldnt: [ (1 << 2000 nthRoot: 100) ] raise: ArithmeticError. - self assert: (1 << 2000 nthRoot: 100) equals: 1 << 20! ! +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! +testDivSnLp -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'jmv 10/13/2011 09:09'! -testNthRootErrorConditions - " - IntegerTest new testExactRaisedToErrorConditions - " + self assert: (0 div: 42391158275216203514294433201) = 0. + self assert: (-1 div: 42391158275216203514294433201) = -1. + self assert: (-14348907 div: 42391158275216203514294433201) = -1! ! - self should: [ -2 nthRoot: 1/4 ] raise: ArithmeticError. - self should: [ -2 nthRoot: 1.24 ] raise: ArithmeticError.! ! +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:56'! +testDivSnSn -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 3/15/2014 14:50'! -testNthRootExactness - | inexactRoots largeRaisedTo6 | - largeRaisedTo6 := (2 to: 100) collect: [:k | (k raisedTo: 11) raisedTo: 6]. - inexactRoots := largeRaisedTo6 reject: [:e | (e nthRoot: 6) isInteger]. - self assert: inexactRoots isEmpty description: 'Failed to find the exact 6th root of these numbers'! ! + self assert: (0 div: -3) = 0. + self assert: (-1 div: -3) = 1. + self assert: (-9 div: -3) = 3. + self assert: (-10 div: -3) = 4. + self assert: (-11 div: -3) = 4. + self assert: (-12 div: -3) = 4. + self assert: (-13 div: -3) = 5! ! -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'nice 10/19/2011 21:03'! -testNthRootTruncated - - | tooBigToBeAFloat large | - tooBigToBeAFloat := 1 << 2000. - self assert: (tooBigToBeAFloat nthRootTruncated: 100) equals: 1 << 20. - self assert: (tooBigToBeAFloat + 1 nthRootTruncated: 100) equals: 1 << 20. - self assert: (tooBigToBeAFloat - 1 nthRootTruncated: 100) equals: 1 << 20 - 1. - - large := -3 raisedTo: 255. - self assert: (large nthRootTruncated: 17) equals: (-3 raisedTo: 15). - self assert: (large + 11 nthRootTruncated: 17) equals: (-3 raisedTo: 15) + 1. - self assert: (large - 11 nthRootTruncated: 17) equals: (-3 raisedTo: 15). - - 2 to: 10 do: [:thePower | - 1 to: 10000 do: [:n | - | theTruncatedRoot | - theTruncatedRoot := n nthRootTruncated: thePower. - self assert: (theTruncatedRoot raisedTo: thePower) <= n. - self assert: (theTruncatedRoot + 1 raisedTo: thePower) > n]]! ! +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! +testDivSnSp -!IntegerTest methodsFor: 'tests - mathematical functions' stamp: 'ul 11/25/2009 03:01'! -testSqrtFloor + self assert: (0 div: 3) = 0. + self assert: (-1 div: 3) = -1. + self assert: (-9 div: 3) = -3. + self assert: (-10 div: 3) = -4. + self assert: (-11 div: 3) = -4. + self assert: (-12 div: 3) = -4. + self assert: (-13 div: 3) = -5! ! - #(-1234567890123 -10 -5 -1) do: [ :each | - self should: [ each sqrtFloor ] raise: Error ]. - #( - 0 1 2 3 4 5 10 16 30 160479924 386234481 501619156 524723498 580855366 766098594 834165249 1020363860 1042083924 1049218924 - 1459774772895569 3050005981408238 4856589481837079 5650488387708463 7831037396100244) do: [ :each | - self assert: each asFloat sqrt floor = each sqrtFloor ] - ! ! +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:55'! +testDivSpLn -!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'nice 12/27/2009 03:11'! -testBitAt - | trials bitSequence2 | + self assert: (0 div: -42391158275216203514294433201) = 0. + self assert: (1 div: -42391158275216203514294433201) = 0. + self assert: (14348907 div: -42391158275216203514294433201) = 0! ! - self - assert: ((1 to: 100) allSatisfy: [:i | (0 bitAt: i) = 0]) - description: 'all bits of zero are set to zero'. - - self - assert: ((1 to: 100) allSatisfy: [:i | (-1 bitAt: i) = 1]) - description: 'In two complements, all bits of -1 are set to 1'. - - - trials := #( - '2r10010011' - '2r11100100' - '2r10000000' - '2r0000101011011001' - '2r1000101011011001' - '2r0101010101011000' - '2r0010011110110010' - '2r0010011000000000' - '2r00100111101100101000101011011001' - '2r01110010011110110010100110101101' - '2r10101011101011001010000010110110' - '2r10101000000000000000000000000000' - '2r0010101110101001110010100000101101100010011110110010100010101100' - '2r1010101110101100101000001011011000100111101100101000101011011001' - '2r1010101110101000000000000000000000000000000000000000000000000000'). - trials do: [:bitSequence | | aNumber | - aNumber := Number readFrom: bitSequence. - bitSequence2 := (bitSequence size - 2 to: 1 by: -1) inject: '2r' into: [:string :i | string copyWith: (Character digitValue: (aNumber bitAt: i))]. - self assert: bitSequence2 = bitSequence]. - - trials do: [:bitSequence | | bitInvert | - bitInvert := -1 - (Number readFrom: bitSequence). - bitSequence2 := (bitSequence size - 2 to: 1 by: -1) inject: '2r' into: [:string :i | string copyWith: (Character digitValue: 1 - (bitInvert bitAt: i))]. - self assert: bitSequence2 = bitSequence description: '-1-x is similar to a bitInvert operation in two complement']! ! +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! +testDivSpLp -!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'sd 6/5/2005 08:43'! -testBitLogic - "This little suite of tests is designed to verify correct operation of most - of Squeak's bit manipulation code, including two's complement - representation of negative values. It was written in a hurry and - is probably lacking several important checks." + self assert: (0 div: 42391158275216203514294433201) = 0. + self assert: (1 div: 42391158275216203514294433201) = 0. + self assert: (14348907 div: 42391158275216203514294433201) = 0! ! - "Shift 1 bit left then right and test for 1" - "self run: #testBitLogic" - | n | - 1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitShift: i negated) = 1]. +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:54'! +testDivSpSn - "Shift -1 left then right and test for 1" - 1 to: 100 do: [:i | self assert: ((-1 bitShift: i) bitShift: i negated) = -1]. + self assert: (0 div: -3) = 0. + self assert: (1 div: -3) = 0. + self assert: (9 div: -3) = -3. + self assert: (10 div: -3) = -3. + self assert: (11 div: -3) = -3. + self assert: (12 div: -3) = -4. + self assert: (13 div: -3) = -4! ! - "And a single bit with -1 and test for same value" - 1 to: 100 do: [:i | self assert: ((1 bitShift: i) bitAnd: -1) = (1 bitShift: i)]. +!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! +testDivSpSp - "Verify that (n bitAnd: n negated) = n for single bits" - 1 to: 100 do: [:i | n := 1 bitShift: i. self assert: (n bitAnd: n negated) = n]. + self assert: (0 div: 3) = 0. + self assert: (1 div: 3) = 0. + self assert: (9 div: 3) = 3. + self assert: (10 div: 3) = 3. + self assert: (11 div: 3) = 3. + self assert: (12 div: 3) = 4. + self assert: (13 div: 3) = 4! ! - "Verify that n negated = (n complemented + 1) for single bits" - 1 to: 100 do: [:i | - n := 1 bitShift: i. - self assert: n negated = ((n bitXor: -1) + 1)]. +!IntegerTest methodsFor: 'tests - printing' stamp: 'jmv 1/9/2014 23:39'! +testIntegerPadding + "self run: #testIntegerPadding" - "Verify that (n + n complemented) = -1 for single bits" - 1 to: 100 do: [:i | - n := 1 bitShift: i. - self assert: (n + (n bitXor: -1)) = -1]. + self assert: (1 printStringBase: 10 length: 0 padded: false) = '1'. + self assert: (1 printStringBase: 10 length: 1 padded: false) = '1'. + self assert: (1 printStringBase: 10 length: 2 padded: false) = ' 1'. + self assert: (1024 printStringBase: 10 length: 19 padded: false) = ' 1024'. + self assert: (1024 printStringBase: 10 length: -1 padded: false) = '1024'. + self assert: (1024 printStringBase: 10 length: 5 padded: false) = ' 1024'. + self assert: (-1024 printStringBase: 10 length: 5 padded: false) = '-1024'. + self assert: (-1024 printStringBase: 10 length: 19 padded: false) = ' -1024'. - "Verify that n negated = (n complemented +1) for single bits" - 1 to: 100 do: [:i | - n := 1 bitShift: i. - self assert: n negated = ((n bitXor: -1) + 1)]. + self assert: (1 printStringBase: 10 length: 0 padded: true) = '1'. + self assert: (1 printStringBase: 10 length: 1 padded: true) = '1'. + self assert: (1 printStringBase: 10 length: 2 padded: true) = '01'. + self assert: (1024 printStringBase: 10 length: 19 padded: true) = '0000000000000001024'. + self assert: (1024 printStringBase: 10 length: -1 padded: true) = '1024'. + self assert: (1024 printStringBase: 10 length: 5 padded: true) = '01024'. + self assert: (-1024 printStringBase: 10 length: 5 padded: true) = '-1024'. + self assert: (-1024 printStringBase: 10 length: 19 padded: true) = '-000000000000001024'. - self assert: (-2 bitAnd: 16rFFFFFFFF) = 16rFFFFFFFE.! ! + self assert: (1 printStringBase: 16 length: 0 padded: false) = '1'. + self assert: (1 printStringBase: 16 length: 1 padded: false) = '1'. + self assert: (1 printStringBase: 16 length: 2 padded: false) = ' 1'. + self assert: (2047 printStringBase: 16 length: 19 padded: false) = ' 7FF'. + self assert: (2047 printStringBase: 16 length: -1 padded: false) = '7FF'. + self assert: (2047 printStringBase: 16 length: 4 padded: false) = ' 7FF'. + self assert: (-2047 printStringBase: 16 length: 4 padded: false) = '-7FF'. + self assert: (-2047 printStringBase: 16 length: 19 padded: false) = ' -7FF'. -!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'jmv 10/3/2018 18:03:31'! -testBitReversal - { 0. 1. SmallInteger maxVal-1. SmallInteger maxVal. SmallInteger maxVal+1. (2 raisedTo: 64)-1091. (2 raisedTo: 64)-1090. (2 raisedTo: 64)-1 } do: - [ : fixture | - | printedThenReversed reversedThenPrinted | - printedThenReversed := (fixture printStringBase: 2 length: 64 padded: true) reversed. - reversedThenPrinted := (fixture bitReverse: 64) printStringBase: 2 length: 64 padded: true. - self assert: printedThenReversed = reversedThenPrinted ]! ! - -!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'jmv 6/24/2020 11:23:19'! -testBitReversalCorrectClass - "This test was added due to a bug!! - The problem only happened in 64 bit systems running with jitted Cog VM." - - | a b | - a _ 16r944F245FDBB2B06. - 10 timesRepeat: [ - b _ (a bitReverse: 64) bitReverse: 64. - self assert: a class = b class ]! ! - -!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'nice 7/8/2008 02:47'! -testHighBit - | suite | - - suite := (0 to: 1024) asArray , #(16rFDFD 16rFFFF 16r1000 16r1000000 16r1000001 16r70000000 16r7AFAFAFA ) , {SmallInteger maxVal . SmallInteger maxVal+1}. - suite := suite , (suite collect: [:e | e raisedTo: 20]). - - suite do: [:anInteger | - | highBit shifted | - highBit := 0. - shifted := 1. - [shifted > anInteger] whileFalse: [highBit := highBit+1. shifted := shifted bitShift: 1]. - self assert: anInteger highBit = highBit].! ! - -!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'nice 7/8/2008 02:44'! -testHighBitOfMagnitude - | suite | - - suite := (0 to: 1024) asArray , #(16rFDFD 16rFFFF 16r1000 16r1000000 16r1000001 16r70000000 16r7AFAFAFA ) , {SmallInteger maxVal . SmallInteger maxVal+1}. - suite := suite , (suite collect: [:e | e raisedTo: 20]). - - suite do: [:anInteger | - | highBit shifted | - highBit := 0. - shifted := 1. - [shifted > anInteger] whileFalse: [highBit := highBit+1. shifted := shifted bitShift: 1]. - self assert: anInteger highBitOfMagnitude = highBit. - self assert: anInteger negated highBitOfMagnitude = highBit].! ! + self assert: (1 printStringBase: 16 length: 0 padded: true) = '1'. + self assert: (1 printStringBase: 16 length: 1 padded: true) = '1'. + self assert: (1 printStringBase: 16 length: 2 padded: true) = '01'. + self assert: (2047 printStringBase: 16 length: 19 padded: true) = '00000000000000007FF'. + self assert: (2047 printStringBase: 16 length: -1 padded: true) = '7FF'. + self assert: (2047 printStringBase: 16 length: 4 padded: true) = '07FF'. + self assert: (-2047 printStringBase: 16 length: 4 padded: true) = '-7FF'. + self assert: (-2047 printStringBase: 16 length: 19 padded: true) = '-0000000000000007FF'! ! -!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'jmv 12/10/2018 18:36:38'! -testLowBit - | suite | +!IntegerTest methodsFor: 'tests - printing' stamp: 'jmv 1/9/2014 22:54'! +testNegativeIntegerPrinting + "self run: #testnegativeIntegerPrinting" - suite := (0 to: 1024) asArray , #(16rFDFD 16rFFFF 16r1000 16r1000000 16r1000001 16r70000000 16r7AFAFAFA ) , {SmallInteger maxVal . SmallInteger maxVal+1}. - suite := suite , (suite collect: [:e | e raisedTo: 20]). - - suite do: [:anInteger | - | lowBit | - lowBit := (anInteger respondsTo: #bitAt:) - ifTrue: [(1 to: anInteger highBit) detect: [:bitIndex | (anInteger bitAt: bitIndex) ~= 0] ifNone: [0]] - ifFalse: [(1 to: anInteger highBit) detect: [:bitIndex | (anInteger bitAnd: (1 bitShift: bitIndex-1)) ~= 0] ifNone: [0]]. - self assert: anInteger lowBit = lowBit. - self assert: anInteger negated lowBit = lowBit]. - self assert: (LargePositiveInteger new: 0) lowBit = 0. - self assert: (LargePositiveInteger new: 2) lowBit = 0! ! + self assert: (-2 printStringBase: 2) = '-10'. + self assert: -2 printStringHex = '-2'. + self assert: (-2 storeStringBase: 2) = '-2r10'. + self assert: -2 storeStringHex = '-16r2'. + self assert: (-21 printStringBase: 3) = '-210'. + self assert: -21 printStringHex = '-15'. + self assert: (-21 storeStringBase: 3) = '-3r210'. + self assert: -21 storeStringHex = '-16r15'. + self assert: (-228 printStringBase: 4) = '-3210'. + self assert: -228 printStringHex = '-E4'. + self assert: (-228 storeStringBase: 4) = '-4r3210'. + self assert: -228 storeStringHex = '-16rE4'. + self assert: (-2930 printStringBase: 5) = '-43210'. + self assert: -2930 printStringHex = '-B72'. + self assert: (-2930 storeStringBase: 5) = '-5r43210'. + self assert: -2930 storeStringHex = '-16rB72'. + self assert: (-44790 printStringBase: 6) = '-543210'. + self assert: -44790 printStringHex = '-AEF6'. + self assert: (-44790 storeStringBase: 6) = '-6r543210'. + self assert: -44790 storeStringHex = '-16rAEF6'. + self assert: (-800667 printStringBase: 7) = '-6543210'. + self assert: -800667 printStringHex = '-C379B'. + self assert: (-800667 storeStringBase: 7) = '-7r6543210'. + self assert: -800667 storeStringHex = '-16rC379B'. + self assert: (-16434824 printStringBase: 8) = '-76543210'. + self assert: -16434824 printStringHex = '-FAC688'. + self assert: (-16434824 storeStringBase: 8) = '-8r76543210'. + self assert: -16434824 storeStringHex = '-16rFAC688'. + self assert: (-381367044 printStringBase: 9) = '-876543210'. + self assert: -381367044 printStringHex = '-16BB3304'. + self assert: (-381367044 storeStringBase: 9) = '-9r876543210'. + self assert: -381367044 storeStringHex = '-16r16BB3304'. + self assert: (-9876543210 printStringBase: 10) = '-9876543210'. + self assert: -9876543210 printStringHex = '-24CB016EA'. + self assert: (-9876543210 storeStringBase: 10) = '-9876543210'. + self assert: -9876543210 storeStringHex = '-16r24CB016EA'. + self assert: (-282458553905 printStringBase: 11) = '-A9876543210'. + self assert: -282458553905 printStringHex = '-41C3D77E31'. + self assert: (-282458553905 storeStringBase: 11) = '-11rA9876543210'. + self assert: -282458553905 storeStringHex = '-16r41C3D77E31'. + self assert: (-8842413667692 printStringBase: 12) = '-BA9876543210'. + self assert: -8842413667692 printStringHex = '-80AC8ECF56C'. + self assert: (-8842413667692 storeStringBase: 12) = '-12rBA9876543210'. + self assert: -8842413667692 storeStringHex = '-16r80AC8ECF56C'. + self assert: (-300771807240918 printStringBase: 13) = '-CBA9876543210'. + self assert: -300771807240918 printStringHex = '-1118CE4BAA2D6'. + self assert: (-300771807240918 storeStringBase: 13) = '-13rCBA9876543210'. + self assert: -300771807240918 storeStringHex = '-16r1118CE4BAA2D6'. + self assert: (-11046255305880158 printStringBase: 14) = '-DCBA9876543210'. + self assert: -11046255305880158 printStringHex = '-273E82BB9AF25E'. + self assert: (-11046255305880158 storeStringBase: 14) = '-14rDCBA9876543210'. + self assert: -11046255305880158 storeStringHex = '-16r273E82BB9AF25E'. + self assert: (-435659737878916215 printStringBase: 15) = '-EDCBA9876543210'. + self assert: -435659737878916215 printStringHex = '-60BC6392F366C77'. + self assert: (-435659737878916215 storeStringBase: 15) = '-15rEDCBA9876543210'. + self assert: -435659737878916215 storeStringHex = '-16r60BC6392F366C77'. + self assert: (-18364758544493064720 printStringBase: 16) = '-FEDCBA9876543210'. + self assert: -18364758544493064720 printStringHex = '-FEDCBA9876543210'. + self assert: (-18364758544493064720 storeStringBase: 16) = '-16rFEDCBA9876543210'. + self assert: -18364758544493064720 storeStringHex = '-16rFEDCBA9876543210'. + self assert: (-824008854613343261192 printStringBase: 17) = '-GFEDCBA9876543210'. + self assert: -824008854613343261192 printStringHex = '-2CAB6B877C1CD2D208'. + self assert: (-824008854613343261192 storeStringBase: 17) = '-17rGFEDCBA9876543210'. + self assert: -824008854613343261192 storeStringHex = '-16r2CAB6B877C1CD2D208'. + self assert: (-39210261334551566857170 printStringBase: 18) = '-HGFEDCBA9876543210'. + self assert: -39210261334551566857170 printStringHex = '-84D97AFCAE81415B3D2'. + self assert: (-39210261334551566857170 storeStringBase: 18) = '-18rHGFEDCBA9876543210'. + self assert: -39210261334551566857170 storeStringHex = '-16r84D97AFCAE81415B3D2'. + self assert: (-1972313422155189164466189 printStringBase: 19) = '-IHGFEDCBA9876543210'. + self assert: -1972313422155189164466189 printStringHex = '-1A1A75329C5C6FC00600D'. + self assert: (-1972313422155189164466189 storeStringBase: 19) = '-19rIHGFEDCBA9876543210'. + self assert: -1972313422155189164466189 storeStringHex = '-16r1A1A75329C5C6FC00600D'. + self assert: (-104567135734072022160664820 printStringBase: 20) = '-JIHGFEDCBA9876543210'. + self assert: -104567135734072022160664820 printStringHex = '-567EF3C9636D242A8C68F4'. + self assert: (-104567135734072022160664820 storeStringBase: 20) = '-20rJIHGFEDCBA9876543210'. + self assert: -104567135734072022160664820 storeStringHex = '-16r567EF3C9636D242A8C68F4'. + self assert: (-5827980550840017565077671610 printStringBase: 21) = '-KJIHGFEDCBA9876543210'. + self assert: -5827980550840017565077671610 printStringHex = '-12D4CAE2B8A09BCFDBE30EBA'. + self assert: (-5827980550840017565077671610 storeStringBase: 21) = '-21rKJIHGFEDCBA9876543210'. + self assert: -5827980550840017565077671610 storeStringHex = '-16r12D4CAE2B8A09BCFDBE30EBA'. + self assert: (-340653664490377789692799452102 printStringBase: 22) = '-LKJIHGFEDCBA9876543210'. + self assert: -340653664490377789692799452102 printStringHex = '-44CB61B5B47E1A5D8F88583C6'. + self assert: (-340653664490377789692799452102 storeStringBase: 22) = '-22rLKJIHGFEDCBA9876543210'. + self assert: -340653664490377789692799452102 storeStringHex = '-16r44CB61B5B47E1A5D8F88583C6'. + self assert: (-20837326537038308910317109288851 printStringBase: 23) = '-MLKJIHGFEDCBA9876543210'. + self assert: -20837326537038308910317109288851 printStringHex = '-1070108876456E0EF115B389F93'. + self assert: (-20837326537038308910317109288851 storeStringBase: 23) = '-23rMLKJIHGFEDCBA9876543210'. + self assert: -20837326537038308910317109288851 storeStringHex = '-16r1070108876456E0EF115B389F93'. + self assert: (-1331214537196502869015340298036888 printStringBase: 24) = '-NMLKJIHGFEDCBA9876543210'. + self assert: -1331214537196502869015340298036888 printStringHex = '-41A24A285154B026B6ED206C6698'. + self assert: (-1331214537196502869015340298036888 storeStringBase: 24) = '-24rNMLKJIHGFEDCBA9876543210'. + self assert: -1331214537196502869015340298036888 storeStringHex = '-16r41A24A285154B026B6ED206C6698'. + self assert: (-88663644327703473714387251271141900 printStringBase: 25) = '-ONMLKJIHGFEDCBA9876543210'. + self assert: -88663644327703473714387251271141900 printStringHex = '-111374860A2C6CEBE5999630398A0C'. + self assert: (-88663644327703473714387251271141900 storeStringBase: 25) = '-25rONMLKJIHGFEDCBA9876543210'. + self assert: -88663644327703473714387251271141900 storeStringHex = '-16r111374860A2C6CEBE5999630398A0C'. + self assert: (-6146269788878825859099399609538763450 printStringBase: 26) = '-PONMLKJIHGFEDCBA9876543210'. + self assert: -6146269788878825859099399609538763450 printStringHex = '-49FBA7F30B0F48BD14E6A99BD8ADABA'. + self assert: (-6146269788878825859099399609538763450 storeStringBase: 26) = '-26rPONMLKJIHGFEDCBA9876543210'. + self assert: -6146269788878825859099399609538763450 storeStringHex = '-16r49FBA7F30B0F48BD14E6A99BD8ADABA'. + self assert: (-442770531899482980347734468443677777577 printStringBase: 27) = '-QPONMLKJIHGFEDCBA9876543210'. + self assert: -442770531899482980347734468443677777577 printStringHex = '-14D1A80A997343640C1145A073731DEA9'. + self assert: (-442770531899482980347734468443677777577 storeStringBase: 27) = '-27rQPONMLKJIHGFEDCBA9876543210'. + self assert: -442770531899482980347734468443677777577 storeStringHex = '-16r14D1A80A997343640C1145A073731DEA9'. + self assert: (-33100056003358651440264672384704297711484 printStringBase: 28) = '-RQPONMLKJIHGFEDCBA9876543210'. + self assert: -33100056003358651440264672384704297711484 printStringHex = '-6145B6E6DACFA25D0E936F51D25932377C'. + self assert: (-33100056003358651440264672384704297711484 storeStringBase: 28) = '-28rRQPONMLKJIHGFEDCBA9876543210'. + self assert: -33100056003358651440264672384704297711484 storeStringHex = '-16r6145B6E6DACFA25D0E936F51D25932377C'. + self assert: (-2564411043271974895869785066497940850811934 printStringBase: 29) = '-SRQPONMLKJIHGFEDCBA9876543210'. + self assert: -2564411043271974895869785066497940850811934 printStringHex = '-1D702071CBA4A1597D4DD37E95EFAC79241E'. + self assert: (-2564411043271974895869785066497940850811934 storeStringBase: 29) = '-29rSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -2564411043271974895869785066497940850811934 storeStringHex = '-16r1D702071CBA4A1597D4DD37E95EFAC79241E'. + self assert: (-205646315052919334126040428061831153388822830 printStringBase: 30) = '-TSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -205646315052919334126040428061831153388822830 printStringHex = '-938B4343B54B550989989D02998718FFB212E'. + self assert: (-205646315052919334126040428061831153388822830 storeStringBase: 30) = '-30rTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -205646315052919334126040428061831153388822830 storeStringHex = '-16r938B4343B54B550989989D02998718FFB212E'. + self assert: (-17050208381689099029767742314582582184093573615 printStringBase: 31) = '-UTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -17050208381689099029767742314582582184093573615 printStringHex = '-2FC8ECB1521BA16D24A69E976D53873E2C661EF'. + self assert: (-17050208381689099029767742314582582184093573615 storeStringBase: 31) = '-31rUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -17050208381689099029767742314582582184093573615 storeStringHex = '-16r2FC8ECB1521BA16D24A69E976D53873E2C661EF'. + self assert: (-1459980823972598128486511383358617792788444579872 printStringBase: 32) = '-VUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -1459980823972598128486511383358617792788444579872 printStringHex = '-FFBBCDEB38BDAB49CA307B9AC5A928398A418820'. + self assert: (-1459980823972598128486511383358617792788444579872 storeStringBase: 32) = '-32rVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -1459980823972598128486511383358617792788444579872 storeStringHex = '-16rFFBBCDEB38BDAB49CA307B9AC5A928398A418820'. + self assert: (-128983956064237823710866404905431464703849549412368 printStringBase: 33) = '-WVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -128983956064237823710866404905431464703849549412368 printStringHex = '-584120A0328DE272AB055A8AA003CE4A559F223810'. + self assert: (-128983956064237823710866404905431464703849549412368 storeStringBase: 33) = '-33rWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -128983956064237823710866404905431464703849549412368 storeStringHex = '-16r584120A0328DE272AB055A8AA003CE4A559F223810'. + self assert: (-11745843093701610854378775891116314824081102660800418 printStringBase: 34) = '-XWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -11745843093701610854378775891116314824081102660800418 printStringHex = '-1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'. + self assert: (-11745843093701610854378775891116314824081102660800418 storeStringBase: 34) = '-34rXWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -11745843093701610854378775891116314824081102660800418 storeStringHex = '-16r1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'. + self assert: (-1101553773143634726491620528194292510495517905608180485 printStringBase: 35) = '-YXWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -1101553773143634726491620528194292510495517905608180485 printStringHex = '-B8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'. + self assert: (-1101553773143634726491620528194292510495517905608180485 storeStringBase: 35) = '-35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -1101553773143634726491620528194292510495517905608180485 storeStringHex = '-16rB8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'. + self assert: (-106300512100105327644605138221229898724869759421181854980 printStringBase: 36) = '-ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -106300512100105327644605138221229898724869759421181854980 printStringHex = '-455D441E55A37239AB4C303189576071AF5578FFCA80504'. + self assert: (-106300512100105327644605138221229898724869759421181854980 storeStringBase: 36) = '-36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: -106300512100105327644605138221229898724869759421181854980 storeStringHex = '-16r455D441E55A37239AB4C303189576071AF5578FFCA80504'.! ! -!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'nice 1/26/2008 02:22'! -testTwoComplementBitLogicWithCarry - "This is non regression test for http://bugs.squeak.org/view.php?id=6874" - - "By property of two complement, following operation is: - ...111110000 this is -16 - ...111101111 this is -16-1 - ...111100000 this is -32, the result of bitAnd: on two complement - - This test used to fail with n=31 39 47.... because of bug 6874" +!IntegerTest methodsFor: 'tests - printing' stamp: 'nice 2/15/2008 22:23'! +testNumberOfDigits - self assert: ((2 to: 80) allSatisfy: [:n | ((2 raisedTo: n) negated bitAnd: (2 raisedTo: n) negated - 1) = (2 raisedTo: n + 1) negated]).! ! - -!IntegerTest methodsFor: 'tests - bitLogic' stamp: 'sd 6/5/2005 08:44'! -testTwoComplementRightShift - "self run: #testTwoComplementRightShift" - - | large small | - small := 2 << 16. - large := 2 << 32. - self assert: ((small negated bitShift: -1) ~= ((small + 1) negated bitShift: -1) - == ((large negated bitShift: -1) ~= ((large + 1) negated bitShift: -1))). - - self assert: ((small bitShift: -1) ~= (small + 1 bitShift: -1) - == ((large bitShift: -1) ~= (large + 1 bitShift: -1))).! ! + 2 to: 32 do: [:b | + 1 to: 1000//b do: [:n | + | bRaisedToN | + bRaisedToN := b raisedTo: n. + self assert: (bRaisedToN - 1 numberOfDigitsInBase: b) = n. + self assert: (bRaisedToN numberOfDigitsInBase: b) = (n+1). + self assert: (bRaisedToN + 1 numberOfDigitsInBase: b) = (n+1). + + self assert: (bRaisedToN negated + 1 numberOfDigitsInBase: b) = n. + self assert: (bRaisedToN negated numberOfDigitsInBase: b) = (n+1). + self assert: (bRaisedToN negated - 1 numberOfDigitsInBase: b) = (n+1).]]. +! ! -!IntegerTest methodsFor: 'testing - arithmetic' stamp: 'mga 5/11/2006 15:41'! -testCrossSumBase - "self run: #testCrossSumBase" +!IntegerTest methodsFor: 'tests - printing' stamp: 'jmv 1/9/2014 23:00'! +testPositiveIntegerPrinting + "self run: #testPositiveIntegerPrinting" - self assert: ( - ((-20 to: 20) collect: [:each | each crossSumBase: 10]) asArray = - #(2 10 9 8 7 6 5 4 3 2 1 9 8 7 6 5 4 3 2 1 0 1 2 3 4 5 6 7 8 9 1 2 3 4 5 6 7 8 9 10 2)). - self assert: ( - ((-20 to: 20) collect: [:each | each crossSumBase: 2]) asArray = - #(2 3 2 2 1 4 3 3 2 3 2 2 1 3 2 2 1 2 1 1 0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4 1 2 2 3 2)). - self should: [10 crossSumBase: 1] raise: AssertionFailure! ! - -!IntegerTest methodsFor: 'testing - arithmetic' stamp: 'nice 1/9/2013 02:11'! -testIntegerDivision - | suite | - suite := #( 1 2 5 1000 123456798 111222333444555 987654321098765432109876 ). - suite := suite , (suite collect: [:e | e negated]). - suite do: [:a | - suite do: [:b | - | q r | - q := a // b. - r := a \\ b. - self assert: b * q + r = a. - self assert: r abs < b abs. - self assert: (r isZero or: [b negative = r negative])]].! ! - -!IntegerTest methodsFor: 'testing - arithmetic' stamp: 'nice 1/16/2013 18:38'! -testMontgomeryMultiplication - | a m mInv | - m := 15485863. - mInv := m montgomeryDigitBase - ((m bitAnd: m montgomeryDigitMax) reciprocalModulo: m montgomeryDigitBase). - a := (m montgomeryDigitBase raisedTo: m montgomeryNumberOfDigits) \\ m. - #(483933 3871465 8951195) do: [:s | - (s montgomeryTimes: a modulo: m mInvModB: mInv) ifNotNil: [:s1 | - | s2 sa ssa | - self assert: s = s1. - sa := s montgomeryTimes: (a * a \\ m) modulo: m mInvModB: mInv. - self assert: sa = (s * a \\ m). - ssa := sa montgomeryTimes: sa modulo: m mInvModB: mInv. - self assert: ssa = (s * s * a \\ m). - s2 := ssa montgomeryTimes: 1 modulo: m mInvModB: mInv. - self assert: s2 = (s * s \\ m)]].! ! - -!IntegerTest methodsFor: 'testing - arithmetic' stamp: 'nice 1/9/2013 02:11'! -testQuoRem - | suite | - suite := #( 1 2 5 1000 123456798 111222333444555 987654321098765432109876 ). - suite := suite , (suite collect: [:e | e negated]). - suite do: [:a | - suite do: [:b | - | q r | - q := a quo: b. - r := a rem: b. - self assert: b * q + r = a. - self assert: r abs < b abs. - self assert: (r isZero or: [a negative = r negative])]].! ! + self assert: 0 printString = '0'. + self assert: 0 printStringHex = '0'. + self assert: 0 storeStringHex = '16r0'. + self assert: (2 printStringBase: 2) = '10'. + self assert: 2 printStringHex = '2'. + self assert: (2 storeStringBase: 2) = '2r10'. + self assert: 2 storeStringHex = '16r2'. + self assert: (21 printStringBase: 3) = '210'. + self assert: 21 printStringHex = '15'. + self assert: (21 storeStringBase: 3) = '3r210'. + self assert: 21 storeStringHex = '16r15'. + self assert: (228 printStringBase: 4) = '3210'. + self assert: 228 printStringHex = 'E4'. + self assert: (228 storeStringBase: 4) = '4r3210'. + self assert: 228 storeStringHex = '16rE4'. + self assert: (2930 printStringBase: 5) = '43210'. + self assert: 2930 printStringHex = 'B72'. + self assert: (2930 storeStringBase: 5) = '5r43210'. + self assert: 2930 storeStringHex = '16rB72'. + self assert: (44790 printStringBase: 6) = '543210'. + self assert: 44790 printStringHex = 'AEF6'. + self assert: (44790 storeStringBase: 6) = '6r543210'. + self assert: 44790 storeStringHex = '16rAEF6'. + self assert: (800667 printStringBase: 7) = '6543210'. + self assert: 800667 printStringHex = 'C379B'. + self assert: (800667 storeStringBase: 7) = '7r6543210'. + self assert: 800667 storeStringHex = '16rC379B'. + self assert: (16434824 printStringBase: 8) = '76543210'. + self assert: 16434824 printStringHex = 'FAC688'. + self assert: (16434824 storeStringBase: 8) = '8r76543210'. + self assert: 16434824 storeStringHex = '16rFAC688'. + self assert: (381367044 printStringBase: 9) = '876543210'. + self assert: 381367044 printStringHex = '16BB3304'. + self assert: (381367044 storeStringBase: 9) = '9r876543210'. + self assert: 381367044 storeStringHex = '16r16BB3304'. + self assert: (9876543210 printStringBase: 10) = '9876543210'. + self assert: 9876543210 printStringHex = '24CB016EA'. + self assert: (9876543210 storeStringBase: 10) = '9876543210'. + self assert: 9876543210 storeStringHex = '16r24CB016EA'. + self assert: (282458553905 printStringBase: 11) = 'A9876543210'. + self assert: 282458553905 printStringHex = '41C3D77E31'. + self assert: (282458553905 storeStringBase: 11) = '11rA9876543210'. + self assert: 282458553905 storeStringHex = '16r41C3D77E31'. + self assert: (8842413667692 printStringBase: 12) = 'BA9876543210'. + self assert: 8842413667692 printStringHex = '80AC8ECF56C'. + self assert: (8842413667692 storeStringBase: 12) = '12rBA9876543210'. + self assert: 8842413667692 storeStringHex = '16r80AC8ECF56C'. + self assert: (300771807240918 printStringBase: 13) = 'CBA9876543210'. + self assert: 300771807240918 printStringHex = '1118CE4BAA2D6'. + self assert: (300771807240918 storeStringBase: 13) = '13rCBA9876543210'. + self assert: 300771807240918 storeStringHex = '16r1118CE4BAA2D6'. + self assert: (11046255305880158 printStringBase: 14) = 'DCBA9876543210'. + self assert: 11046255305880158 printStringHex = '273E82BB9AF25E'. + self assert: (11046255305880158 storeStringBase: 14) = '14rDCBA9876543210'. + self assert: 11046255305880158 storeStringHex = '16r273E82BB9AF25E'. + self assert: (435659737878916215 printStringBase: 15) = 'EDCBA9876543210'. + self assert: 435659737878916215 printStringHex = '60BC6392F366C77'. + self assert: (435659737878916215 storeStringBase: 15) = '15rEDCBA9876543210'. + self assert: 435659737878916215 storeStringHex = '16r60BC6392F366C77'. + self assert: (18364758544493064720 printStringBase: 16) = 'FEDCBA9876543210'. + self assert: 18364758544493064720 printStringHex = 'FEDCBA9876543210'. + self assert: (18364758544493064720 storeStringBase: 16) = '16rFEDCBA9876543210'. + self assert: 18364758544493064720 storeStringHex = '16rFEDCBA9876543210'. + self assert: (824008854613343261192 printStringBase: 17) = 'GFEDCBA9876543210'. + self assert: 824008854613343261192 printStringHex = '2CAB6B877C1CD2D208'. + self assert: (824008854613343261192 storeStringBase: 17) = '17rGFEDCBA9876543210'. + self assert: 824008854613343261192 storeStringHex = '16r2CAB6B877C1CD2D208'. + self assert: (39210261334551566857170 printStringBase: 18) = 'HGFEDCBA9876543210'. + self assert: 39210261334551566857170 printStringHex = '84D97AFCAE81415B3D2'. + self assert: (39210261334551566857170 storeStringBase: 18) = '18rHGFEDCBA9876543210'. + self assert: 39210261334551566857170 storeStringHex = '16r84D97AFCAE81415B3D2'. + self assert: (1972313422155189164466189 printStringBase: 19) = 'IHGFEDCBA9876543210'. + self assert: 1972313422155189164466189 printStringHex = '1A1A75329C5C6FC00600D'. + self assert: (1972313422155189164466189 storeStringBase: 19) = '19rIHGFEDCBA9876543210'. + self assert: 1972313422155189164466189 storeStringHex = '16r1A1A75329C5C6FC00600D'. + self assert: (104567135734072022160664820 printStringBase: 20) = 'JIHGFEDCBA9876543210'. + self assert: 104567135734072022160664820 printStringHex = '567EF3C9636D242A8C68F4'. + self assert: (104567135734072022160664820 storeStringBase: 20) = '20rJIHGFEDCBA9876543210'. + self assert: 104567135734072022160664820 storeStringHex = '16r567EF3C9636D242A8C68F4'. + self assert: (5827980550840017565077671610 printStringBase: 21) = 'KJIHGFEDCBA9876543210'. + self assert: 5827980550840017565077671610 printStringHex = '12D4CAE2B8A09BCFDBE30EBA'. + self assert: (5827980550840017565077671610 storeStringBase: 21) = '21rKJIHGFEDCBA9876543210'. + self assert: 5827980550840017565077671610 storeStringHex = '16r12D4CAE2B8A09BCFDBE30EBA'. + self assert: (340653664490377789692799452102 printStringBase: 22) = 'LKJIHGFEDCBA9876543210'. + self assert: 340653664490377789692799452102 printStringHex = '44CB61B5B47E1A5D8F88583C6'. + self assert: (340653664490377789692799452102 storeStringBase: 22) = '22rLKJIHGFEDCBA9876543210'. + self assert: 340653664490377789692799452102 storeStringHex = '16r44CB61B5B47E1A5D8F88583C6'. + self assert: (20837326537038308910317109288851 printStringBase: 23) = 'MLKJIHGFEDCBA9876543210'. + self assert: 20837326537038308910317109288851 printStringHex = '1070108876456E0EF115B389F93'. + self assert: (20837326537038308910317109288851 storeStringBase: 23) = '23rMLKJIHGFEDCBA9876543210'. + self assert: 20837326537038308910317109288851 storeStringHex = '16r1070108876456E0EF115B389F93'. + self assert: (1331214537196502869015340298036888 printStringBase: 24) = 'NMLKJIHGFEDCBA9876543210'. + self assert: 1331214537196502869015340298036888 printStringHex = '41A24A285154B026B6ED206C6698'. + self assert: (1331214537196502869015340298036888 storeStringBase: 24) = '24rNMLKJIHGFEDCBA9876543210'. + self assert: 1331214537196502869015340298036888 storeStringHex = '16r41A24A285154B026B6ED206C6698'. + self assert: (88663644327703473714387251271141900 printStringBase: 25) = 'ONMLKJIHGFEDCBA9876543210'. + self assert: 88663644327703473714387251271141900 printStringHex = '111374860A2C6CEBE5999630398A0C'. + self assert: (88663644327703473714387251271141900 storeStringBase: 25) = '25rONMLKJIHGFEDCBA9876543210'. + self assert: 88663644327703473714387251271141900 storeStringHex = '16r111374860A2C6CEBE5999630398A0C'. + self assert: (6146269788878825859099399609538763450 printStringBase: 26) = 'PONMLKJIHGFEDCBA9876543210'. + self assert: 6146269788878825859099399609538763450 printStringHex = '49FBA7F30B0F48BD14E6A99BD8ADABA'. + self assert: (6146269788878825859099399609538763450 storeStringBase: 26) = '26rPONMLKJIHGFEDCBA9876543210'. + self assert: 6146269788878825859099399609538763450 storeStringHex = '16r49FBA7F30B0F48BD14E6A99BD8ADABA'. + self assert: (442770531899482980347734468443677777577 printStringBase: 27) = 'QPONMLKJIHGFEDCBA9876543210'. + self assert: 442770531899482980347734468443677777577 printStringHex = '14D1A80A997343640C1145A073731DEA9'. + self assert: (442770531899482980347734468443677777577 storeStringBase: 27) = '27rQPONMLKJIHGFEDCBA9876543210'. + self assert: 442770531899482980347734468443677777577 storeStringHex = '16r14D1A80A997343640C1145A073731DEA9'. + self assert: (33100056003358651440264672384704297711484 printStringBase: 28) = 'RQPONMLKJIHGFEDCBA9876543210'. + self assert: 33100056003358651440264672384704297711484 printStringHex = '6145B6E6DACFA25D0E936F51D25932377C'. + self assert: (33100056003358651440264672384704297711484 storeStringBase: 28) = '28rRQPONMLKJIHGFEDCBA9876543210'. + self assert: 33100056003358651440264672384704297711484 storeStringHex = '16r6145B6E6DACFA25D0E936F51D25932377C'. + self assert: (2564411043271974895869785066497940850811934 printStringBase: 29) = 'SRQPONMLKJIHGFEDCBA9876543210'. + self assert: 2564411043271974895869785066497940850811934 printStringHex = '1D702071CBA4A1597D4DD37E95EFAC79241E'. + self assert: (2564411043271974895869785066497940850811934 storeStringBase: 29) = '29rSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 2564411043271974895869785066497940850811934 storeStringHex = '16r1D702071CBA4A1597D4DD37E95EFAC79241E'. + self assert: (205646315052919334126040428061831153388822830 printStringBase: 30) = 'TSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 205646315052919334126040428061831153388822830 printStringHex = '938B4343B54B550989989D02998718FFB212E'. + self assert: (205646315052919334126040428061831153388822830 storeStringBase: 30) = '30rTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 205646315052919334126040428061831153388822830 storeStringHex = '16r938B4343B54B550989989D02998718FFB212E'. + self assert: (17050208381689099029767742314582582184093573615 printStringBase: 31) = 'UTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 17050208381689099029767742314582582184093573615 printStringHex = '2FC8ECB1521BA16D24A69E976D53873E2C661EF'. + self assert: (17050208381689099029767742314582582184093573615 storeStringBase: 31) = '31rUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 17050208381689099029767742314582582184093573615 storeStringHex = '16r2FC8ECB1521BA16D24A69E976D53873E2C661EF'. + self assert: (1459980823972598128486511383358617792788444579872 printStringBase: 32) = 'VUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 1459980823972598128486511383358617792788444579872 printStringHex = 'FFBBCDEB38BDAB49CA307B9AC5A928398A418820'. + self assert: (1459980823972598128486511383358617792788444579872 storeStringBase: 32) = '32rVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 1459980823972598128486511383358617792788444579872 storeStringHex = '16rFFBBCDEB38BDAB49CA307B9AC5A928398A418820'. + self assert: (128983956064237823710866404905431464703849549412368 printStringBase: 33) = 'WVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 128983956064237823710866404905431464703849549412368 printStringHex = '584120A0328DE272AB055A8AA003CE4A559F223810'. + self assert: (128983956064237823710866404905431464703849549412368 storeStringBase: 33) = '33rWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 128983956064237823710866404905431464703849549412368 storeStringHex = '16r584120A0328DE272AB055A8AA003CE4A559F223810'. + self assert: (11745843093701610854378775891116314824081102660800418 printStringBase: 34) = 'XWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 11745843093701610854378775891116314824081102660800418 printStringHex = '1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'. + self assert: (11745843093701610854378775891116314824081102660800418 storeStringBase: 34) = '34rXWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 11745843093701610854378775891116314824081102660800418 storeStringHex = '16r1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'. + self assert: (1101553773143634726491620528194292510495517905608180485 printStringBase: 35) = 'YXWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 1101553773143634726491620528194292510495517905608180485 printStringHex = 'B8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'. + self assert: (1101553773143634726491620528194292510495517905608180485 storeStringBase: 35) = '35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 1101553773143634726491620528194292510495517905608180485 storeStringHex = '16rB8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'. + self assert: (106300512100105327644605138221229898724869759421181854980 printStringBase: 36) = 'ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 106300512100105327644605138221229898724869759421181854980 printStringHex = '455D441E55A37239AB4C303189576071AF5578FFCA80504'. + self assert: (106300512100105327644605138221229898724869759421181854980 storeStringBase: 36) = '36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'. + self assert: 106300512100105327644605138221229898724869759421181854980 storeStringHex = '16r455D441E55A37239AB4C303189576071AF5578FFCA80504'.! ! -!IntegerTest methodsFor: 'testing - arithmetic' stamp: 'nice 6/4/2011 20:46'! -testRaisedToModulo - #(301 2047) do: [:m | - 1 to: m - 1 by: (m // 30) do: [:x | - 11 to: m - 1 by: (m // 40) do: [:y | - self assert: (x raisedTo: y) \\ m = (x raisedTo: y modulo: m)]]]. - self assert: (8951195 raisedTo: 7742931 modulo: 15485863) = 15485862.! ! +!IntegerTest methodsFor: 'tests - printing' stamp: 'jmv 10/3/2018 18:05:41'! +testPrintOnBaseShowRadix -!IntegerTest methodsFor: 'tests - basic' stamp: 'md 4/21/2003 16:17'! -testEven - - self deny: (1073741825 even). - self assert: (1073741824 even). - ! ! + self assert: (123 printStringRadix: 10) = '10r123'. + self assert: (123 printStringRadix: 8) = '8r173'.! ! -!IntegerTest methodsFor: 'tests - basic' stamp: 'jpb 8/2/2019 23:55:59'! -testIsInteger - self assert: 0 isInteger. - self assert: (0 is: #Integer). - self assert: (1 is: #Integer). - self assert: (1 is: #Number). +!IntegerTest methodsFor: 'tests - printing' stamp: 'nice 2/15/2008 22:31'! +testPrintStringBase - self assert: (10000 is: #Integer). - self assert: (10000 is: #Number).! ! - -!IntegerTest methodsFor: 'tests - basic' stamp: 'md 4/15/2003 20:40'! -testIsPowerOfTwo - - self assert: (0 isPowerOfTwo). - self assert: (1 isPowerOfTwo). - self assert: (2 isPowerOfTwo). - self deny: (3 isPowerOfTwo). - self assert: (4 isPowerOfTwo). - ! ! - -!IntegerTest methodsFor: 'tests - basic' stamp: 'nice 1/25/2008 22:51'! -testIsPowerOfTwoM6873 - "This is a non regression test for http://bugs.squeak.org/view.php?id=6873" - - self deny: ((1 to: 80) anySatisfy: [:n | (2 raisedTo: n) negated isPowerOfTwo]) - description: 'A negative integer cannot be a power of two'.! ! - -!IntegerTest methodsFor: 'tests - basic' stamp: 'ul 11/25/2009 02:51'! -testIsPrime - - "Not primes:" - #(-100 -5 -3 -2 -1 0 1) do: [ :each | - self deny: each isPrime ]. + 2 to: 32 do: [:b | + 1 to: 1000//b do: [:n | + | bRaisedToN | + bRaisedToN := b raisedTo: n. + self assert: (bRaisedToN - 1 printStringBase: b) = (String new: n withAll: (Character digitValue: b-1)). + self assert: (bRaisedToN printStringBase: b) = ('1' , (String new: n withAll: $0)). + + self assert: (bRaisedToN negated + 1 printStringBase: b) = ('-' , (String new: n withAll: (Character digitValue: b-1))). + self assert: (bRaisedToN negated printStringBase: b) = ('-1' , (String new: n withAll: $0))]]. +! ! - "The following tests should return 'true'" - #(17 78901 104729 15485863 2038074743) do: [ :each | - self assert: each isPrime ]. - - "The following tests should return 'false' (first 5 are Carmichael integers)" - #(561 2821 6601 10585 15841 256 29996224275831) do: [ :each | - self deny: each isPrime ].! ! +!IntegerTest methodsFor: 'tests - printing' stamp: 'laza 3/30/2004 09:23'! +testRomanPrinting + self assert: 0 printStringRoman = ''. "No symbol for zero" + self assert: 1 printStringRoman = 'I'. + self assert: 2 printStringRoman = 'II'. + self assert: 3 printStringRoman = 'III'. + self assert: 4 printStringRoman = 'IV'. + self assert: 5 printStringRoman = 'V'. + self assert: 6 printStringRoman = 'VI'. + self assert: 7 printStringRoman = 'VII'. + self assert: 8 printStringRoman = 'VIII'. + self assert: 9 printStringRoman = 'IX'. + self assert: 10 printStringRoman = 'X'. + self assert: 23 printStringRoman = 'XXIII'. + self assert: 36 printStringRoman = 'XXXVI'. + self assert: 49 printStringRoman = 'XLIX'. + self assert: 62 printStringRoman = 'LXII'. + self assert: 75 printStringRoman = 'LXXV'. + self assert: 88 printStringRoman = 'LXXXVIII'. + self assert: 99 printStringRoman = 'XCIX'. + self assert: 100 printStringRoman = 'C'. + self assert: 101 printStringRoman = 'CI'. + self assert: 196 printStringRoman = 'CXCVI'. + self assert: 197 printStringRoman = 'CXCVII'. + self assert: 198 printStringRoman = 'CXCVIII'. + self assert: 293 printStringRoman = 'CCXCIII'. + self assert: 294 printStringRoman = 'CCXCIV'. + self assert: 295 printStringRoman = 'CCXCV'. + self assert: 390 printStringRoman = 'CCCXC'. + self assert: 391 printStringRoman = 'CCCXCI'. + self assert: 392 printStringRoman = 'CCCXCII'. + self assert: 487 printStringRoman = 'CDLXXXVII'. + self assert: 488 printStringRoman = 'CDLXXXVIII'. + self assert: 489 printStringRoman = 'CDLXXXIX'. + self assert: 584 printStringRoman = 'DLXXXIV'. + self assert: 585 printStringRoman = 'DLXXXV'. + self assert: 586 printStringRoman = 'DLXXXVI'. + self assert: 681 printStringRoman = 'DCLXXXI'. + self assert: 682 printStringRoman = 'DCLXXXII'. + self assert: 683 printStringRoman = 'DCLXXXIII'. + self assert: 778 printStringRoman = 'DCCLXXVIII'. + self assert: 779 printStringRoman = 'DCCLXXIX'. + self assert: 780 printStringRoman = 'DCCLXXX'. + self assert: 875 printStringRoman = 'DCCCLXXV'. + self assert: 876 printStringRoman = 'DCCCLXXVI'. + self assert: 877 printStringRoman = 'DCCCLXXVII'. + self assert: 972 printStringRoman = 'CMLXXII'. + self assert: 973 printStringRoman = 'CMLXXIII'. + self assert: 974 printStringRoman = 'CMLXXIV'. + self assert: 1069 printStringRoman = 'MLXIX'. + self assert: 1070 printStringRoman = 'MLXX'. + self assert: 1071 printStringRoman = 'MLXXI'. + self assert: 1166 printStringRoman = 'MCLXVI'. + self assert: 1167 printStringRoman = 'MCLXVII'. + self assert: 1168 printStringRoman = 'MCLXVIII'. + self assert: 1263 printStringRoman = 'MCCLXIII'. + self assert: 1264 printStringRoman = 'MCCLXIV'. + self assert: 1265 printStringRoman = 'MCCLXV'. + self assert: 1360 printStringRoman = 'MCCCLX'. + self assert: 1361 printStringRoman = 'MCCCLXI'. + self assert: 1362 printStringRoman = 'MCCCLXII'. + self assert: 1457 printStringRoman = 'MCDLVII'. + self assert: 1458 printStringRoman = 'MCDLVIII'. + self assert: 1459 printStringRoman = 'MCDLIX'. + self assert: 1554 printStringRoman = 'MDLIV'. + self assert: 1555 printStringRoman = 'MDLV'. + self assert: 1556 printStringRoman = 'MDLVI'. + self assert: 1651 printStringRoman = 'MDCLI'. + self assert: 1652 printStringRoman = 'MDCLII'. + self assert: 1653 printStringRoman = 'MDCLIII'. + self assert: 1748 printStringRoman = 'MDCCXLVIII'. + self assert: 1749 printStringRoman = 'MDCCXLIX'. + self assert: 1750 printStringRoman = 'MDCCL'. + self assert: 1845 printStringRoman = 'MDCCCXLV'. + self assert: 1846 printStringRoman = 'MDCCCXLVI'. + self assert: 1847 printStringRoman = 'MDCCCXLVII'. + self assert: 1942 printStringRoman = 'MCMXLII'. + self assert: 1943 printStringRoman = 'MCMXLIII'. + self assert: 1944 printStringRoman = 'MCMXLIV'. + self assert: 2004 printStringRoman = 'MMIV'. -!IntegerTest methodsFor: 'tests - basic' stamp: 'ul 11/25/2009 02:49'! -testIsProbablyPrime + self assert: -1 printStringRoman = '-I'. + self assert: -2 printStringRoman = '-II'. + self assert: -3 printStringRoman = '-III'. + self assert: -4 printStringRoman = '-IV'. + self assert: -5 printStringRoman = '-V'. + self assert: -6 printStringRoman = '-VI'. + self assert: -7 printStringRoman = '-VII'. + self assert: -8 printStringRoman = '-VIII'. + self assert: -9 printStringRoman = '-IX'. + self assert: -10 printStringRoman = '-X'. +! ! - "Not primes:" - #(-100 -5 -3 -2 -1 0 1) do: [ :each | - self deny: each isProbablyPrime ]. +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:57'! +testModLnLn - "The following tests should return 'true'" - #(17 78901 104729 15485863 2038074743 29996224275833) do: [ :each | - self assert: each isProbablyPrime ]. - - "The following tests should return 'false' (first 5 are Carmichael integers)" - #(561 2821 6601 10585 15841 256 29996224275831) do: [ :each | - self deny: each isProbablyPrime ].! ! + self assert: (-42391158275216203514294433200 mod: -14130386091738734504764811067) = 1. + self assert: (-42391158275216203514294433201 mod: -14130386091738734504764811067) = 0. + self assert: (-42391158275216203514294433202 mod: -14130386091738734504764811067) = 14130386091738734504764811066. + self assert: (-8727963568087712425891397479476727340041448 mod: -79766443076872509863361) = 1. + self assert: (-8727963568087712425891397479476727340041449 mod: -79766443076872509863361) = 0. + self assert: (-8727963568087712425891397479476727340041450 mod: -79766443076872509863361) = 79766443076872509863360! ! -!IntegerTest methodsFor: 'tests - basic' stamp: 'md 2/12/2006 14:36'! -testLargePrimesUpTo +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! +testModLnLp - | nn | - nn := (2 raisedTo: 17) - 1. - self deny: (Integer primesUpTo: nn) last = nn. - self assert: (Integer primesUpTo: nn + 1) last = nn. - - -! ! + self assert: (-42391158275216203514294433200 mod: 14130386091738734504764811067) = 1. + self assert: (-42391158275216203514294433201 mod: 14130386091738734504764811067) = 0. + self assert: (-42391158275216203514294433202 mod: 14130386091738734504764811067) = 14130386091738734504764811066. + self assert: (-8727963568087712425891397479476727340041448 mod: 79766443076872509863361) = 1. + self assert: (-8727963568087712425891397479476727340041449 mod: 79766443076872509863361) = 0. + self assert: (-8727963568087712425891397479476727340041450 mod: 79766443076872509863361) = 79766443076872509863360! ! -!IntegerTest methodsFor: 'tests - basic' stamp: 'md 2/12/2006 14:36'! -testPrimesUpTo +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 15:05'! +testModLnSn - | primes nn| - primes := Integer primesUpTo: 100. - self assert: primes = #(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97). - - "upTo: semantics means 'non-inclusive'" - primes := Integer primesUpTo: 5. - self assert: primes = #(2 3). - - "this test is green for nn>25000, see #testLargePrimesUpTo" - nn := 5. - self deny: (Integer primesUpTo: nn) last = nn. - self assert: (Integer primesUpTo: nn + 1) last = nn.! ! + self assert: (-42391158275216203514294433201 mod: -3) = 0. + self assert: (-42391158275216203514294433202 mod: -3) = 2. + self assert: (-42391158275216203514294433203 mod: -3) = 1. + self assert: (-42391158275216203514294433204 mod: -3) = 0! ! -!IntegerTest methodsFor: 'tests - basic' stamp: 'eem 7/16/2014 15:29'! -testRange - self assert: SmallInteger maxVal class equals: SmallInteger. - self assert: (SmallInteger maxVal + 1) class equals: LargePositiveInteger. - self assert: SmallInteger minVal class equals: SmallInteger. - self assert: (SmallInteger minVal - 1) class equals: LargeNegativeInteger! ! +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! +testModLnSp -!IntegerTest methodsFor: 'tests - instance creation' stamp: 'sd 6/5/2005 08:46'! -testDifferentBases - "self run: #testDifferentBases" - "| value | - 2 to: 36 do: [:each| - value := 0. - 1 to: each-1 do: [:n| value := value + (n * (each raisedToInteger: n))]. - value := value negated. - Transcript tab; show: 'self assert: (', value printString, ' printStringBase: ', each printString, ') = ''', (value printStringBase: each), '''.'; cr. - Transcript tab; show: 'self assert: (', value printString, ' radix: ', each printString, ') = ''', (value radix: each), '''.'; cr. - Transcript tab; show: 'self assert: ', value printString, ' printStringHex = ''', (value printStringBase: 16), '''.'; cr. - Transcript tab; show: 'self assert: (', value printString, ' storeStringBase: ', each printString, ') = ''', (value storeStringBase: each), '''.'; cr. - Transcript tab; show: 'self assert: ', value printString, ' storeStringHex = ''', (value storeStringBase: 16), '''.'; cr. + self assert: (-42391158275216203514294433201 mod: 3) = 0. + self assert: (-42391158275216203514294433202 mod: 3) = 2. + self assert: (-42391158275216203514294433203 mod: 3) = 1. + self assert: (-42391158275216203514294433204 mod: 3) = 0! ! +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 15:05'! +testModLpLn -]. - " + self assert: (42391158275216203514294433200 mod: -14130386091738734504764811067) = 14130386091738734504764811066. + self assert: (42391158275216203514294433201 mod: -14130386091738734504764811067) = 0. + self assert: (42391158275216203514294433202 mod: -14130386091738734504764811067) = 1. + self assert: (8727963568087712425891397479476727340041448 mod: -79766443076872509863361) = 79766443076872509863360. + self assert: (8727963568087712425891397479476727340041449 mod: -79766443076872509863361) = 0. + self assert: (8727963568087712425891397479476727340041450 mod: -79766443076872509863361) = 1! ! - self assert: 2r10 = 2. - self assert: 3r210 = 21. - self assert: 4r3210 = 228. - self assert: 5r43210 = 2930. - self assert: 6r543210 = 44790. - self assert: 7r6543210 = 800667. - self assert: 8r76543210 = 16434824. - self assert: 9r876543210 = 381367044. - self assert: 10r9876543210 = 9876543210. - self assert: 11rA9876543210 = 282458553905. - self assert: 12rBA9876543210 = 8842413667692. - self assert: 13rCBA9876543210 = 300771807240918. - self assert: 14rDCBA9876543210 = 11046255305880158. - self assert: 15rEDCBA9876543210 = 435659737878916215. - self assert: 16rFEDCBA9876543210 = 18364758544493064720. - self assert: 17rGFEDCBA9876543210 = 824008854613343261192. - self assert: 18rHGFEDCBA9876543210 = 39210261334551566857170. - self assert: 19rIHGFEDCBA9876543210 = 1972313422155189164466189. - self assert: 20rJIHGFEDCBA9876543210 = 104567135734072022160664820. - self assert: 21rKJIHGFEDCBA9876543210 = 5827980550840017565077671610. - self assert: 22rLKJIHGFEDCBA9876543210 = 340653664490377789692799452102. - self assert: 23rMLKJIHGFEDCBA9876543210 = 20837326537038308910317109288851. - self assert: 24rNMLKJIHGFEDCBA9876543210 = 1331214537196502869015340298036888. - self assert: 25rONMLKJIHGFEDCBA9876543210 = 88663644327703473714387251271141900. - self assert: 26rPONMLKJIHGFEDCBA9876543210 = 6146269788878825859099399609538763450. - self assert: 27rQPONMLKJIHGFEDCBA9876543210 = 442770531899482980347734468443677777577. - self assert: 28rRQPONMLKJIHGFEDCBA9876543210 = 33100056003358651440264672384704297711484. - self assert: 29rSRQPONMLKJIHGFEDCBA9876543210 = 2564411043271974895869785066497940850811934. - self assert: 30rTSRQPONMLKJIHGFEDCBA9876543210 = 205646315052919334126040428061831153388822830. - self assert: 31rUTSRQPONMLKJIHGFEDCBA9876543210 = 17050208381689099029767742314582582184093573615. - self assert: 32rVUTSRQPONMLKJIHGFEDCBA9876543210 = 1459980823972598128486511383358617792788444579872. - self assert: 33rWVUTSRQPONMLKJIHGFEDCBA9876543210 = 128983956064237823710866404905431464703849549412368. - self assert: 34rXWVUTSRQPONMLKJIHGFEDCBA9876543210 = 11745843093701610854378775891116314824081102660800418. - self assert: 35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = 1101553773143634726491620528194292510495517905608180485. - self assert: 36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = 106300512100105327644605138221229898724869759421181854980. +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! +testModLpLp - self assert: -2r10 = -2. - self assert: -3r210 = -21. - self assert: -4r3210 = -228. - self assert: -5r43210 = -2930. - self assert: -6r543210 = -44790. - self assert: -7r6543210 = -800667. - self assert: -8r76543210 = -16434824. - self assert: -9r876543210 = -381367044. - self assert: -10r9876543210 = -9876543210. - self assert: -11rA9876543210 = -282458553905. - self assert: -12rBA9876543210 = -8842413667692. - self assert: -13rCBA9876543210 = -300771807240918. - self assert: -14rDCBA9876543210 = -11046255305880158. - self assert: -15rEDCBA9876543210 = -435659737878916215. - self assert: -16rFEDCBA9876543210 = -18364758544493064720. - self assert: -17rGFEDCBA9876543210 = -824008854613343261192. - self assert: -18rHGFEDCBA9876543210 = -39210261334551566857170. - self assert: -19rIHGFEDCBA9876543210 = -1972313422155189164466189. - self assert: -20rJIHGFEDCBA9876543210 = -104567135734072022160664820. - self assert: -21rKJIHGFEDCBA9876543210 = -5827980550840017565077671610. - self assert: -22rLKJIHGFEDCBA9876543210 = -340653664490377789692799452102. - self assert: -23rMLKJIHGFEDCBA9876543210 = -20837326537038308910317109288851. - self assert: -24rNMLKJIHGFEDCBA9876543210 = -1331214537196502869015340298036888. - self assert: -25rONMLKJIHGFEDCBA9876543210 = -88663644327703473714387251271141900. - self assert: -26rPONMLKJIHGFEDCBA9876543210 = -6146269788878825859099399609538763450. - self assert: -27rQPONMLKJIHGFEDCBA9876543210 = -442770531899482980347734468443677777577. - self assert: -28rRQPONMLKJIHGFEDCBA9876543210 = -33100056003358651440264672384704297711484. - self assert: -29rSRQPONMLKJIHGFEDCBA9876543210 = -2564411043271974895869785066497940850811934. - self assert: -30rTSRQPONMLKJIHGFEDCBA9876543210 = -205646315052919334126040428061831153388822830. - self assert: -31rUTSRQPONMLKJIHGFEDCBA9876543210 = -17050208381689099029767742314582582184093573615. - self assert: -32rVUTSRQPONMLKJIHGFEDCBA9876543210 = -1459980823972598128486511383358617792788444579872. - self assert: -33rWVUTSRQPONMLKJIHGFEDCBA9876543210 = -128983956064237823710866404905431464703849549412368. - self assert: -34rXWVUTSRQPONMLKJIHGFEDCBA9876543210 = -11745843093701610854378775891116314824081102660800418. - self assert: -35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = -1101553773143634726491620528194292510495517905608180485. - self assert: -36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210 = -106300512100105327644605138221229898724869759421181854980.! ! - -!IntegerTest methodsFor: 'tests - instance creation' stamp: 'jmv 9/1/2010 13:56'! -testIntegerReadFrom - self assert: (Integer readFrom: '123' readStream base: 10) = 123. - self assert: (Integer readFrom: '-123' readStream base: 10) = -123. - self should: [Integer readFrom: 'abc' readStream base: 10] raise: Error. - self should: [Integer readFrom: 'D12' readStream base: 10] raise: Error. - self assert: (Integer readFrom: '1two3' readStream base: 10) = 1. -! ! + self assert: (42391158275216203514294433200 mod: 14130386091738734504764811067) = 14130386091738734504764811066. + self assert: (42391158275216203514294433201 mod: 14130386091738734504764811067) = 0. + self assert: (42391158275216203514294433202 mod: 14130386091738734504764811067) = 1. + self assert: (8727963568087712425891397479476727340041448 mod: 79766443076872509863361) = 79766443076872509863360. + self assert: (8727963568087712425891397479476727340041449 mod: 79766443076872509863361) = 0. + self assert: (8727963568087712425891397479476727340041450 mod: 79766443076872509863361) = 1! ! -!IntegerTest methodsFor: 'tests - instance creation' stamp: 'md 3/25/2003 23:14'! -testNew - self should: [Integer new] raise: TestResult error. ! ! +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 15:04'! +testModLpSn -!IntegerTest methodsFor: 'tests - instance creation' stamp: 'jmv 9/1/2010 13:26'! -testReadFrom - "Ensure remaining characters in a stream are not lost when parsing an integer." + self assert: (42391158275216203514294433201 mod: -3) = 0. + self assert: (42391158275216203514294433202 mod: -3) = 1. + self assert: (42391158275216203514294433203 mod: -3) = 2. + self assert: (42391158275216203514294433204 mod: -3) = 0! ! - | rs i s | - rs := ReadStream on: '123s could be confused with a ScaledDecimal'. - i := Number readFrom: rs. - self assert: i isInteger. - self assert: i = 123. - s := rs upToEnd. - self assert: 's could be confused with a ScaledDecimal' = s. - - "Modified for Cuis. Classic number parsing considers this to be an integer." - rs := ReadStream on: '123.s could be confused with a ScaledDecimal'. - i := Number readFrom: rs. - self assert: i isInteger. - self assert: i = 123. - s := rs upToEnd. - self assert: '.s could be confused with a ScaledDecimal' = s -! ! +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! +testModLpSp -!IntegerTest methodsFor: 'tests - instance creation' stamp: 'jmv 9/1/2010 13:45'! -testStringAsNumber - "This covers parsing in Number>>readFrom: - Trailing decimal points should be ignored." + self assert: (42391158275216203514294433201 mod: 3) = 0. + self assert: (42391158275216203514294433202 mod: 3) = 1. + self assert: (42391158275216203514294433203 mod: 3) = 2. + self assert: (42391158275216203514294433204 mod: 3) = 0! ! - self assert: ('123' asNumber isInteger). - self assert: ('123' asNumber = 123). - self assert: ('-123' asNumber isInteger). - self assert: ('-123' asNumber = -123). - self assert: ('123.' asNumber) isInteger. - self assert: ('123.' asNumber = 123). - self assert: ('-123.' asNumber) isInteger. - self assert: ('-123.' asNumber = -123). - self assert: ('123This is not to be read' asNumber isInteger). - self assert: ('123This is not to be read' asNumber = 123). - self assert: ('123s could be confused with a ScaledDecimal' asNumber isInteger). - self assert: ('123s could be confused with a ScaledDecimal' asNumber = 123). - self assert: ('123e could be confused with a Float' asNumber isInteger). - self assert: ('123e could be confused with a Float' asNumber = 123). -! ! +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 15:04'! +testModSnLn -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:53'! -testDivLnLn + self assert: (0 mod: -42391158275216203514294433201) = 0. + self assert: (-1 mod: -42391158275216203514294433201) = 42391158275216203514294433200. + self assert: (-14348907 mod: -42391158275216203514294433201) = 42391158275216203514280084294! ! - self assert: (-42391158275216203514294433200 div: -14130386091738734504764811067) = 3. - self assert: (-42391158275216203514294433201 div: -14130386091738734504764811067) = 3. - self assert: (-42391158275216203514294433202 div: -14130386091738734504764811067) = 4. - self assert: (-8727963568087712425891397479476727340041448 div: -79766443076872509863361) = 109418989131512359209. - self assert: (-8727963568087712425891397479476727340041449 div: -79766443076872509863361) = 109418989131512359209. - self assert: (-8727963568087712425891397479476727340041450 div: -79766443076872509863361) = 109418989131512359210! ! +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! +testModSnLp -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:53'! -testDivLnLp + self assert: (0 mod: 42391158275216203514294433201) = 0. + self assert: (-1 mod: 42391158275216203514294433201) = 42391158275216203514294433200. + self assert: (-14348907 mod: 42391158275216203514294433201) = 42391158275216203514280084294! ! - self assert: (-42391158275216203514294433200 div: 14130386091738734504764811067) = -3. - self assert: (-42391158275216203514294433201 div: 14130386091738734504764811067) = -3. - self assert: (-42391158275216203514294433202 div: 14130386091738734504764811067) = -4. - self assert: (-8727963568087712425891397479476727340041448 div: 79766443076872509863361) = -109418989131512359209. - self assert: (-8727963568087712425891397479476727340041449 div: 79766443076872509863361) = -109418989131512359209. - self assert: (-8727963568087712425891397479476727340041450 div: 79766443076872509863361) = -109418989131512359210! ! +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 15:00'! +testModSnSn -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:54'! -testDivLnSn + self assert: (0 mod: -3) = 0. + self assert: (-1 mod: -3) = 2. + self assert: (-9 mod: -3) = 0. + self assert: (-10 mod: -3) = 2. + self assert: (-11 mod: -3) = 1. + self assert: (-12 mod: -3) = 0. + self assert: (-13 mod: -3) = 2! ! - self assert: (-42391158275216203514294433201 div: -3) = 14130386091738734504764811067. - self assert: (-42391158275216203514294433202 div: -3) = 14130386091738734504764811068. - self assert: (-42391158275216203514294433203 div: -3) = 14130386091738734504764811068. - self assert: (-42391158275216203514294433204 div: -3) = 14130386091738734504764811068! ! +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:59'! +testModSnSp -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! -testDivLnSp + self assert: (0 mod: 3) = 0. + self assert: (-1 mod: 3) = 2. + self assert: (-9 mod: 3) = 0. + self assert: (-10 mod: 3) = 2. + self assert: (-11 mod: 3) = 1. + self assert: (-12 mod: 3) = 0. + self assert: (-13 mod: 3) = 2! ! - self assert: (-42391158275216203514294433201 div: 3) = -14130386091738734504764811067. - self assert: (-42391158275216203514294433202 div: 3) = -14130386091738734504764811068. - self assert: (-42391158275216203514294433203 div: 3) = -14130386091738734504764811068. - self assert: (-42391158275216203514294433204 div: 3) = -14130386091738734504764811068! ! +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 15:05'! +testModSpLn -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:54'! -testDivLpLn + self assert: (0 mod: -42391158275216203514294433201) = 0. + self assert: (1 mod: -42391158275216203514294433201) = 1. + self assert: (14348907 mod: -42391158275216203514294433201) = 14348907! ! - self assert: (42391158275216203514294433200 div: -14130386091738734504764811067) = -2. - self assert: (42391158275216203514294433201 div: -14130386091738734504764811067) = -3. - self assert: (42391158275216203514294433202 div: -14130386091738734504764811067) = -3. - self assert: (8727963568087712425891397479476727340041448 div: -79766443076872509863361) = -109418989131512359208. - self assert: (8727963568087712425891397479476727340041449 div: -79766443076872509863361) = -109418989131512359209. - self assert: (8727963568087712425891397479476727340041450 div: -79766443076872509863361) = -109418989131512359209! ! +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! +testModSpLp -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! -testDivLpLp + self assert: (0 mod: 42391158275216203514294433201) = 0. + self assert: (1 mod: 42391158275216203514294433201) = 1. + self assert: (14348907 mod: 42391158275216203514294433201) = 14348907! ! - self assert: (42391158275216203514294433200 div: 14130386091738734504764811067) = 2. - self assert: (42391158275216203514294433201 div: 14130386091738734504764811067) = 3. - self assert: (42391158275216203514294433202 div: 14130386091738734504764811067) = 3. - self assert: (8727963568087712425891397479476727340041448 div: 79766443076872509863361) = 109418989131512359208. - self assert: (8727963568087712425891397479476727340041449 div: 79766443076872509863361) = 109418989131512359209. - self assert: (8727963568087712425891397479476727340041450 div: 79766443076872509863361) = 109418989131512359209! ! +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:58'! +testModSpSn -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:55'! -testDivLpSn + self assert: (0 mod: -3) = 0. + self assert: (1 mod: -3) = 1. + self assert: (9 mod: -3) = 0. + self assert: (10 mod: -3) = 1. + self assert: (11 mod: -3) = 2. + self assert: (12 mod: -3) = 0. + self assert: (13 mod: -3) = 1! ! - self assert: (42391158275216203514294433201 div: -3) = -14130386091738734504764811067. - self assert: (42391158275216203514294433202 div: -3) = -14130386091738734504764811067. - self assert: (42391158275216203514294433203 div: -3) = -14130386091738734504764811067. - self assert: (42391158275216203514294433204 div: -3) = -14130386091738734504764811068! ! +!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! +testModSpSp -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! -testDivLpSp + self assert: (0 mod: 3) = 0. + self assert: (1 mod: 3) = 1. + self assert: (9 mod: 3) = 0. + self assert: (10 mod: 3) = 1. + self assert: (11 mod: 3) = 2. + self assert: (12 mod: 3) = 0. + self assert: (13 mod: 3) = 1! ! - self assert: (42391158275216203514294433201 div: 3) = 14130386091738734504764811067. - self assert: (42391158275216203514294433202 div: 3) = 14130386091738734504764811067. - self assert: (42391158275216203514294433203 div: 3) = 14130386091738734504764811067. - self assert: (42391158275216203514294433204 div: 3) = 14130386091738734504764811068! ! +!IntegerTest methodsFor: 'mathematical functions' stamp: 'jmv 10/15/2016 10:58:02'! +testNthRootExactnessForHugeValue + " + self new testNthRootExactnessForHugeValue + " + self assert: ((10 raisedTo: 600) nthRoot: 300) = 100. + self assert: ((10 raisedTo: 600) nthRoot: 300) class == SmallInteger. + self assert: ((10 raisedTo: 600) + 1 nthRoot: 300) = 100.0. + self assert: (((10 raisedTo: 600) + 1 nthRoot: 300) isKindOf: Float)! ! -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:55'! -testDivSnLn +!IntegerTest methodsFor: 'mathematical functions' stamp: 'jmv 10/15/2016 10:57:28'! +testNthRootImmuneToDoubleRounding +" +self new testNthRootImmuneToDoubleRounding +" + "Use a specially crafted number for causing double rounding. + Solution is 10...01.1 - verySmallQuantity. + Where verySmallQuantity is approximately 1/53/(1<<53). + If the verySmallQuantity is not taken into account, then solution is rounded to 10....010" + | exponent crafted root highPrecisionRoot | + exponent := 4. + crafted := (1 << Float precision + 3 raisedTo: exponent) - 1. + root := crafted nthRoot: exponent. + highPrecisionRoot := (crafted << (exponent squared * Float precision * 4) nthRootRounded: exponent) / (1 << (exponent * Float precision * 4)). + self assert: (root asFraction - highPrecisionRoot) abs < (root predecessor asFraction - highPrecisionRoot) abs. + + "Same with the other sign. + Solution is 10...00.1 + verySmallQuantity." + crafted := (1 << Float precision + 1 raisedTo: exponent) + 1. + root := crafted nthRoot: exponent. + highPrecisionRoot := (crafted << (exponent squared * Float precision * 4) nthRootRounded: exponent) / (1 << (exponent * Float precision * 4)). + self assert: (root asFraction - highPrecisionRoot) abs < (root successor asFraction - highPrecisionRoot) abs.! ! - self assert: (0 div: -42391158275216203514294433201) = 0. - self assert: (-1 div: -42391158275216203514294433201) = 1. - self assert: (-14348907 div: -42391158275216203514294433201) = 1! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:36'! +testQuoLnLn -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! -testDivSnLp + self assert: (-42391158275216203514294433200 quo: -14130386091738734504764811067) = 2. + self assert: (-42391158275216203514294433201 quo: -14130386091738734504764811067) = 3. + self assert: (-42391158275216203514294433202 quo: -14130386091738734504764811067) = 3. + self assert: (-8727963568087712425891397479476727340041448 quo: -79766443076872509863361) = 109418989131512359208. + self assert: (-8727963568087712425891397479476727340041449 quo: -79766443076872509863361) = 109418989131512359209. + self assert: (-8727963568087712425891397479476727340041450 quo: -79766443076872509863361) = 109418989131512359209! ! - self assert: (0 div: 42391158275216203514294433201) = 0. - self assert: (-1 div: 42391158275216203514294433201) = -1. - self assert: (-14348907 div: 42391158275216203514294433201) = -1! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:51'! +testQuoLnLp -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:56'! -testDivSnSn + self assert: (-42391158275216203514294433200 quo: 14130386091738734504764811067) = -2. + self assert: (-42391158275216203514294433201 quo: 14130386091738734504764811067) = -3. + self assert: (-42391158275216203514294433202 quo: 14130386091738734504764811067) = -3. + self assert: (-8727963568087712425891397479476727340041448 quo: 79766443076872509863361) = -109418989131512359208. + self assert: (-8727963568087712425891397479476727340041449 quo: 79766443076872509863361) = -109418989131512359209. + self assert: (-8727963568087712425891397479476727340041450 quo: 79766443076872509863361) = -109418989131512359209! ! - self assert: (0 div: -3) = 0. - self assert: (-1 div: -3) = 1. - self assert: (-9 div: -3) = 3. - self assert: (-10 div: -3) = 4. - self assert: (-11 div: -3) = 4. - self assert: (-12 div: -3) = 4. - self assert: (-13 div: -3) = 5! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! +testQuoLnSn -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! -testDivSnSp + self assert: (-42391158275216203514294433201 quo: -3) = 14130386091738734504764811067. + self assert: (-42391158275216203514294433202 quo: -3) = 14130386091738734504764811067. + self assert: (-42391158275216203514294433203 quo: -3) = 14130386091738734504764811067. + self assert: (-42391158275216203514294433204 quo: -3) = 14130386091738734504764811068! ! - self assert: (0 div: 3) = 0. - self assert: (-1 div: 3) = -1. - self assert: (-9 div: 3) = -3. - self assert: (-10 div: 3) = -4. - self assert: (-11 div: 3) = -4. - self assert: (-12 div: 3) = -4. - self assert: (-13 div: 3) = -5! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:51'! +testQuoLnSp -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:55'! -testDivSpLn + self assert: (-42391158275216203514294433201 quo: 3) = -14130386091738734504764811067. + self assert: (-42391158275216203514294433202 quo: 3) = -14130386091738734504764811067. + self assert: (-42391158275216203514294433203 quo: 3) = -14130386091738734504764811067. + self assert: (-42391158275216203514294433204 quo: 3) = -14130386091738734504764811068! ! - self assert: (0 div: -42391158275216203514294433201) = 0. - self assert: (1 div: -42391158275216203514294433201) = 0. - self assert: (14348907 div: -42391158275216203514294433201) = 0! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:52'! +testQuoLpLn -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! -testDivSpLp + self assert: (42391158275216203514294433200 quo: -14130386091738734504764811067) = -2. + self assert: (42391158275216203514294433201 quo: -14130386091738734504764811067) = -3. + self assert: (42391158275216203514294433202 quo: -14130386091738734504764811067) = -3. + self assert: (8727963568087712425891397479476727340041448 quo: -79766443076872509863361) = -109418989131512359208. + self assert: (8727963568087712425891397479476727340041449 quo: -79766443076872509863361) = -109418989131512359209. + self assert: (8727963568087712425891397479476727340041450 quo: -79766443076872509863361) = -109418989131512359209! ! - self assert: (0 div: 42391158275216203514294433201) = 0. - self assert: (1 div: 42391158275216203514294433201) = 0. - self assert: (14348907 div: 42391158275216203514294433201) = 0! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! +testQuoLpLp -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:54'! -testDivSpSn + self assert: (42391158275216203514294433200 quo: 14130386091738734504764811067) = 2. + self assert: (42391158275216203514294433201 quo: 14130386091738734504764811067) = 3. + self assert: (42391158275216203514294433202 quo: 14130386091738734504764811067) = 3. + self assert: (8727963568087712425891397479476727340041448 quo: 79766443076872509863361) = 109418989131512359208. + self assert: (8727963568087712425891397479476727340041449 quo: 79766443076872509863361) = 109418989131512359209. + self assert: (8727963568087712425891397479476727340041450 quo: 79766443076872509863361) = 109418989131512359209! ! - self assert: (0 div: -3) = 0. - self assert: (1 div: -3) = 0. - self assert: (9 div: -3) = -3. - self assert: (10 div: -3) = -3. - self assert: (11 div: -3) = -3. - self assert: (12 div: -3) = -4. - self assert: (13 div: -3) = -4! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:50'! +testQuoLpSn -!IntegerTest methodsFor: 'tests - division - div:' stamp: 'sqr 1/25/2014 14:36'! -testDivSpSp + self assert: (42391158275216203514294433201 quo: -3) = -14130386091738734504764811067. + self assert: (42391158275216203514294433202 quo: -3) = -14130386091738734504764811067. + self assert: (42391158275216203514294433203 quo: -3) = -14130386091738734504764811067. + self assert: (42391158275216203514294433204 quo: -3) = -14130386091738734504764811068! ! - self assert: (0 div: 3) = 0. - self assert: (1 div: 3) = 0. - self assert: (9 div: 3) = 3. - self assert: (10 div: 3) = 3. - self assert: (11 div: 3) = 3. - self assert: (12 div: 3) = 4. - self assert: (13 div: 3) = 4! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! +testQuoLpSp -!IntegerTest methodsFor: 'tests - printing' stamp: 'jmv 1/9/2014 23:39'! -testIntegerPadding - "self run: #testIntegerPadding" + self assert: (42391158275216203514294433201 quo: 3) = 14130386091738734504764811067. + self assert: (42391158275216203514294433202 quo: 3) = 14130386091738734504764811067. + self assert: (42391158275216203514294433203 quo: 3) = 14130386091738734504764811067. + self assert: (42391158275216203514294433204 quo: 3) = 14130386091738734504764811068! ! - self assert: (1 printStringBase: 10 length: 0 padded: false) = '1'. - self assert: (1 printStringBase: 10 length: 1 padded: false) = '1'. - self assert: (1 printStringBase: 10 length: 2 padded: false) = ' 1'. - self assert: (1024 printStringBase: 10 length: 19 padded: false) = ' 1024'. - self assert: (1024 printStringBase: 10 length: -1 padded: false) = '1024'. - self assert: (1024 printStringBase: 10 length: 5 padded: false) = ' 1024'. - self assert: (-1024 printStringBase: 10 length: 5 padded: false) = '-1024'. - self assert: (-1024 printStringBase: 10 length: 19 padded: false) = ' -1024'. +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! +testQuoSnLn - self assert: (1 printStringBase: 10 length: 0 padded: true) = '1'. - self assert: (1 printStringBase: 10 length: 1 padded: true) = '1'. - self assert: (1 printStringBase: 10 length: 2 padded: true) = '01'. - self assert: (1024 printStringBase: 10 length: 19 padded: true) = '0000000000000001024'. - self assert: (1024 printStringBase: 10 length: -1 padded: true) = '1024'. - self assert: (1024 printStringBase: 10 length: 5 padded: true) = '01024'. - self assert: (-1024 printStringBase: 10 length: 5 padded: true) = '-1024'. - self assert: (-1024 printStringBase: 10 length: 19 padded: true) = '-000000000000001024'. + self assert: (0 quo: -42391158275216203514294433201) = 0. + self assert: (-1 quo: -42391158275216203514294433201) = 0. + self assert: (-14348907 quo: -42391158275216203514294433201) = 0! ! - self assert: (1 printStringBase: 16 length: 0 padded: false) = '1'. - self assert: (1 printStringBase: 16 length: 1 padded: false) = '1'. - self assert: (1 printStringBase: 16 length: 2 padded: false) = ' 1'. - self assert: (2047 printStringBase: 16 length: 19 padded: false) = ' 7FF'. - self assert: (2047 printStringBase: 16 length: -1 padded: false) = '7FF'. - self assert: (2047 printStringBase: 16 length: 4 padded: false) = ' 7FF'. - self assert: (-2047 printStringBase: 16 length: 4 padded: false) = '-7FF'. - self assert: (-2047 printStringBase: 16 length: 19 padded: false) = ' -7FF'. +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:50'! +testQuoSnLp - self assert: (1 printStringBase: 16 length: 0 padded: true) = '1'. - self assert: (1 printStringBase: 16 length: 1 padded: true) = '1'. - self assert: (1 printStringBase: 16 length: 2 padded: true) = '01'. - self assert: (2047 printStringBase: 16 length: 19 padded: true) = '00000000000000007FF'. - self assert: (2047 printStringBase: 16 length: -1 padded: true) = '7FF'. - self assert: (2047 printStringBase: 16 length: 4 padded: true) = '07FF'. - self assert: (-2047 printStringBase: 16 length: 4 padded: true) = '-7FF'. - self assert: (-2047 printStringBase: 16 length: 19 padded: true) = '-0000000000000007FF'! ! + self assert: (0 quo: 42391158275216203514294433201) = 0. + self assert: (-1 quo: 42391158275216203514294433201) = 0. + self assert: (-14348907 quo: 42391158275216203514294433201) = 0! ! -!IntegerTest methodsFor: 'tests - printing' stamp: 'jmv 1/9/2014 22:54'! -testNegativeIntegerPrinting - "self run: #testnegativeIntegerPrinting" +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! +testQuoSnSn - self assert: (-2 printStringBase: 2) = '-10'. - self assert: -2 printStringHex = '-2'. - self assert: (-2 storeStringBase: 2) = '-2r10'. - self assert: -2 storeStringHex = '-16r2'. - self assert: (-21 printStringBase: 3) = '-210'. - self assert: -21 printStringHex = '-15'. - self assert: (-21 storeStringBase: 3) = '-3r210'. - self assert: -21 storeStringHex = '-16r15'. - self assert: (-228 printStringBase: 4) = '-3210'. - self assert: -228 printStringHex = '-E4'. - self assert: (-228 storeStringBase: 4) = '-4r3210'. - self assert: -228 storeStringHex = '-16rE4'. - self assert: (-2930 printStringBase: 5) = '-43210'. - self assert: -2930 printStringHex = '-B72'. - self assert: (-2930 storeStringBase: 5) = '-5r43210'. - self assert: -2930 storeStringHex = '-16rB72'. - self assert: (-44790 printStringBase: 6) = '-543210'. - self assert: -44790 printStringHex = '-AEF6'. - self assert: (-44790 storeStringBase: 6) = '-6r543210'. - self assert: -44790 storeStringHex = '-16rAEF6'. - self assert: (-800667 printStringBase: 7) = '-6543210'. - self assert: -800667 printStringHex = '-C379B'. - self assert: (-800667 storeStringBase: 7) = '-7r6543210'. - self assert: -800667 storeStringHex = '-16rC379B'. - self assert: (-16434824 printStringBase: 8) = '-76543210'. - self assert: -16434824 printStringHex = '-FAC688'. - self assert: (-16434824 storeStringBase: 8) = '-8r76543210'. - self assert: -16434824 storeStringHex = '-16rFAC688'. - self assert: (-381367044 printStringBase: 9) = '-876543210'. - self assert: -381367044 printStringHex = '-16BB3304'. - self assert: (-381367044 storeStringBase: 9) = '-9r876543210'. - self assert: -381367044 storeStringHex = '-16r16BB3304'. - self assert: (-9876543210 printStringBase: 10) = '-9876543210'. - self assert: -9876543210 printStringHex = '-24CB016EA'. - self assert: (-9876543210 storeStringBase: 10) = '-9876543210'. - self assert: -9876543210 storeStringHex = '-16r24CB016EA'. - self assert: (-282458553905 printStringBase: 11) = '-A9876543210'. - self assert: -282458553905 printStringHex = '-41C3D77E31'. - self assert: (-282458553905 storeStringBase: 11) = '-11rA9876543210'. - self assert: -282458553905 storeStringHex = '-16r41C3D77E31'. - self assert: (-8842413667692 printStringBase: 12) = '-BA9876543210'. - self assert: -8842413667692 printStringHex = '-80AC8ECF56C'. - self assert: (-8842413667692 storeStringBase: 12) = '-12rBA9876543210'. - self assert: -8842413667692 storeStringHex = '-16r80AC8ECF56C'. - self assert: (-300771807240918 printStringBase: 13) = '-CBA9876543210'. - self assert: -300771807240918 printStringHex = '-1118CE4BAA2D6'. - self assert: (-300771807240918 storeStringBase: 13) = '-13rCBA9876543210'. - self assert: -300771807240918 storeStringHex = '-16r1118CE4BAA2D6'. - self assert: (-11046255305880158 printStringBase: 14) = '-DCBA9876543210'. - self assert: -11046255305880158 printStringHex = '-273E82BB9AF25E'. - self assert: (-11046255305880158 storeStringBase: 14) = '-14rDCBA9876543210'. - self assert: -11046255305880158 storeStringHex = '-16r273E82BB9AF25E'. - self assert: (-435659737878916215 printStringBase: 15) = '-EDCBA9876543210'. - self assert: -435659737878916215 printStringHex = '-60BC6392F366C77'. - self assert: (-435659737878916215 storeStringBase: 15) = '-15rEDCBA9876543210'. - self assert: -435659737878916215 storeStringHex = '-16r60BC6392F366C77'. - self assert: (-18364758544493064720 printStringBase: 16) = '-FEDCBA9876543210'. - self assert: -18364758544493064720 printStringHex = '-FEDCBA9876543210'. - self assert: (-18364758544493064720 storeStringBase: 16) = '-16rFEDCBA9876543210'. - self assert: -18364758544493064720 storeStringHex = '-16rFEDCBA9876543210'. - self assert: (-824008854613343261192 printStringBase: 17) = '-GFEDCBA9876543210'. - self assert: -824008854613343261192 printStringHex = '-2CAB6B877C1CD2D208'. - self assert: (-824008854613343261192 storeStringBase: 17) = '-17rGFEDCBA9876543210'. - self assert: -824008854613343261192 storeStringHex = '-16r2CAB6B877C1CD2D208'. - self assert: (-39210261334551566857170 printStringBase: 18) = '-HGFEDCBA9876543210'. - self assert: -39210261334551566857170 printStringHex = '-84D97AFCAE81415B3D2'. - self assert: (-39210261334551566857170 storeStringBase: 18) = '-18rHGFEDCBA9876543210'. - self assert: -39210261334551566857170 storeStringHex = '-16r84D97AFCAE81415B3D2'. - self assert: (-1972313422155189164466189 printStringBase: 19) = '-IHGFEDCBA9876543210'. - self assert: -1972313422155189164466189 printStringHex = '-1A1A75329C5C6FC00600D'. - self assert: (-1972313422155189164466189 storeStringBase: 19) = '-19rIHGFEDCBA9876543210'. - self assert: -1972313422155189164466189 storeStringHex = '-16r1A1A75329C5C6FC00600D'. - self assert: (-104567135734072022160664820 printStringBase: 20) = '-JIHGFEDCBA9876543210'. - self assert: -104567135734072022160664820 printStringHex = '-567EF3C9636D242A8C68F4'. - self assert: (-104567135734072022160664820 storeStringBase: 20) = '-20rJIHGFEDCBA9876543210'. - self assert: -104567135734072022160664820 storeStringHex = '-16r567EF3C9636D242A8C68F4'. - self assert: (-5827980550840017565077671610 printStringBase: 21) = '-KJIHGFEDCBA9876543210'. - self assert: -5827980550840017565077671610 printStringHex = '-12D4CAE2B8A09BCFDBE30EBA'. - self assert: (-5827980550840017565077671610 storeStringBase: 21) = '-21rKJIHGFEDCBA9876543210'. - self assert: -5827980550840017565077671610 storeStringHex = '-16r12D4CAE2B8A09BCFDBE30EBA'. - self assert: (-340653664490377789692799452102 printStringBase: 22) = '-LKJIHGFEDCBA9876543210'. - self assert: -340653664490377789692799452102 printStringHex = '-44CB61B5B47E1A5D8F88583C6'. - self assert: (-340653664490377789692799452102 storeStringBase: 22) = '-22rLKJIHGFEDCBA9876543210'. - self assert: -340653664490377789692799452102 storeStringHex = '-16r44CB61B5B47E1A5D8F88583C6'. - self assert: (-20837326537038308910317109288851 printStringBase: 23) = '-MLKJIHGFEDCBA9876543210'. - self assert: -20837326537038308910317109288851 printStringHex = '-1070108876456E0EF115B389F93'. - self assert: (-20837326537038308910317109288851 storeStringBase: 23) = '-23rMLKJIHGFEDCBA9876543210'. - self assert: -20837326537038308910317109288851 storeStringHex = '-16r1070108876456E0EF115B389F93'. - self assert: (-1331214537196502869015340298036888 printStringBase: 24) = '-NMLKJIHGFEDCBA9876543210'. - self assert: -1331214537196502869015340298036888 printStringHex = '-41A24A285154B026B6ED206C6698'. - self assert: (-1331214537196502869015340298036888 storeStringBase: 24) = '-24rNMLKJIHGFEDCBA9876543210'. - self assert: -1331214537196502869015340298036888 storeStringHex = '-16r41A24A285154B026B6ED206C6698'. - self assert: (-88663644327703473714387251271141900 printStringBase: 25) = '-ONMLKJIHGFEDCBA9876543210'. - self assert: -88663644327703473714387251271141900 printStringHex = '-111374860A2C6CEBE5999630398A0C'. - self assert: (-88663644327703473714387251271141900 storeStringBase: 25) = '-25rONMLKJIHGFEDCBA9876543210'. - self assert: -88663644327703473714387251271141900 storeStringHex = '-16r111374860A2C6CEBE5999630398A0C'. - self assert: (-6146269788878825859099399609538763450 printStringBase: 26) = '-PONMLKJIHGFEDCBA9876543210'. - self assert: -6146269788878825859099399609538763450 printStringHex = '-49FBA7F30B0F48BD14E6A99BD8ADABA'. - self assert: (-6146269788878825859099399609538763450 storeStringBase: 26) = '-26rPONMLKJIHGFEDCBA9876543210'. - self assert: -6146269788878825859099399609538763450 storeStringHex = '-16r49FBA7F30B0F48BD14E6A99BD8ADABA'. - self assert: (-442770531899482980347734468443677777577 printStringBase: 27) = '-QPONMLKJIHGFEDCBA9876543210'. - self assert: -442770531899482980347734468443677777577 printStringHex = '-14D1A80A997343640C1145A073731DEA9'. - self assert: (-442770531899482980347734468443677777577 storeStringBase: 27) = '-27rQPONMLKJIHGFEDCBA9876543210'. - self assert: -442770531899482980347734468443677777577 storeStringHex = '-16r14D1A80A997343640C1145A073731DEA9'. - self assert: (-33100056003358651440264672384704297711484 printStringBase: 28) = '-RQPONMLKJIHGFEDCBA9876543210'. - self assert: -33100056003358651440264672384704297711484 printStringHex = '-6145B6E6DACFA25D0E936F51D25932377C'. - self assert: (-33100056003358651440264672384704297711484 storeStringBase: 28) = '-28rRQPONMLKJIHGFEDCBA9876543210'. - self assert: -33100056003358651440264672384704297711484 storeStringHex = '-16r6145B6E6DACFA25D0E936F51D25932377C'. - self assert: (-2564411043271974895869785066497940850811934 printStringBase: 29) = '-SRQPONMLKJIHGFEDCBA9876543210'. - self assert: -2564411043271974895869785066497940850811934 printStringHex = '-1D702071CBA4A1597D4DD37E95EFAC79241E'. - self assert: (-2564411043271974895869785066497940850811934 storeStringBase: 29) = '-29rSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -2564411043271974895869785066497940850811934 storeStringHex = '-16r1D702071CBA4A1597D4DD37E95EFAC79241E'. - self assert: (-205646315052919334126040428061831153388822830 printStringBase: 30) = '-TSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -205646315052919334126040428061831153388822830 printStringHex = '-938B4343B54B550989989D02998718FFB212E'. - self assert: (-205646315052919334126040428061831153388822830 storeStringBase: 30) = '-30rTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -205646315052919334126040428061831153388822830 storeStringHex = '-16r938B4343B54B550989989D02998718FFB212E'. - self assert: (-17050208381689099029767742314582582184093573615 printStringBase: 31) = '-UTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -17050208381689099029767742314582582184093573615 printStringHex = '-2FC8ECB1521BA16D24A69E976D53873E2C661EF'. - self assert: (-17050208381689099029767742314582582184093573615 storeStringBase: 31) = '-31rUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -17050208381689099029767742314582582184093573615 storeStringHex = '-16r2FC8ECB1521BA16D24A69E976D53873E2C661EF'. - self assert: (-1459980823972598128486511383358617792788444579872 printStringBase: 32) = '-VUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -1459980823972598128486511383358617792788444579872 printStringHex = '-FFBBCDEB38BDAB49CA307B9AC5A928398A418820'. - self assert: (-1459980823972598128486511383358617792788444579872 storeStringBase: 32) = '-32rVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -1459980823972598128486511383358617792788444579872 storeStringHex = '-16rFFBBCDEB38BDAB49CA307B9AC5A928398A418820'. - self assert: (-128983956064237823710866404905431464703849549412368 printStringBase: 33) = '-WVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -128983956064237823710866404905431464703849549412368 printStringHex = '-584120A0328DE272AB055A8AA003CE4A559F223810'. - self assert: (-128983956064237823710866404905431464703849549412368 storeStringBase: 33) = '-33rWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -128983956064237823710866404905431464703849549412368 storeStringHex = '-16r584120A0328DE272AB055A8AA003CE4A559F223810'. - self assert: (-11745843093701610854378775891116314824081102660800418 printStringBase: 34) = '-XWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -11745843093701610854378775891116314824081102660800418 printStringHex = '-1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'. - self assert: (-11745843093701610854378775891116314824081102660800418 storeStringBase: 34) = '-34rXWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -11745843093701610854378775891116314824081102660800418 storeStringHex = '-16r1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'. - self assert: (-1101553773143634726491620528194292510495517905608180485 printStringBase: 35) = '-YXWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -1101553773143634726491620528194292510495517905608180485 printStringHex = '-B8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'. - self assert: (-1101553773143634726491620528194292510495517905608180485 storeStringBase: 35) = '-35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -1101553773143634726491620528194292510495517905608180485 storeStringHex = '-16rB8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'. - self assert: (-106300512100105327644605138221229898724869759421181854980 printStringBase: 36) = '-ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -106300512100105327644605138221229898724869759421181854980 printStringHex = '-455D441E55A37239AB4C303189576071AF5578FFCA80504'. - self assert: (-106300512100105327644605138221229898724869759421181854980 storeStringBase: 36) = '-36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: -106300512100105327644605138221229898724869759421181854980 storeStringHex = '-16r455D441E55A37239AB4C303189576071AF5578FFCA80504'.! ! + self assert: (0 quo: -3) = 0. + self assert: (-1 quo: -3) = 0. + self assert: (-9 quo: -3) = 3. + self assert: (-10 quo: -3) = 3. + self assert: (-11 quo: -3) = 3. + self assert: (-12 quo: -3) = 4. + self assert: (-13 quo: -3) = 4! ! -!IntegerTest methodsFor: 'tests - printing' stamp: 'nice 2/15/2008 22:23'! -testNumberOfDigits - - 2 to: 32 do: [:b | - 1 to: 1000//b do: [:n | - | bRaisedToN | - bRaisedToN := b raisedTo: n. - self assert: (bRaisedToN - 1 numberOfDigitsInBase: b) = n. - self assert: (bRaisedToN numberOfDigitsInBase: b) = (n+1). - self assert: (bRaisedToN + 1 numberOfDigitsInBase: b) = (n+1). - - self assert: (bRaisedToN negated + 1 numberOfDigitsInBase: b) = n. - self assert: (bRaisedToN negated numberOfDigitsInBase: b) = (n+1). - self assert: (bRaisedToN negated - 1 numberOfDigitsInBase: b) = (n+1).]]. -! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:51'! +testQuoSnSp -!IntegerTest methodsFor: 'tests - printing' stamp: 'jmv 1/9/2014 23:00'! -testPositiveIntegerPrinting - "self run: #testPositiveIntegerPrinting" + self assert: (0 quo: 3) = 0. + self assert: (-1 quo: 3) = 0. + self assert: (-9 quo: 3) = -3. + self assert: (-10 quo: 3) = -3. + self assert: (-11 quo: 3) = -3. + self assert: (-12 quo: 3) = -4. + self assert: (-13 quo: 3) = -4! ! - self assert: 0 printString = '0'. - self assert: 0 printStringHex = '0'. - self assert: 0 storeStringHex = '16r0'. - self assert: (2 printStringBase: 2) = '10'. - self assert: 2 printStringHex = '2'. - self assert: (2 storeStringBase: 2) = '2r10'. - self assert: 2 storeStringHex = '16r2'. - self assert: (21 printStringBase: 3) = '210'. - self assert: 21 printStringHex = '15'. - self assert: (21 storeStringBase: 3) = '3r210'. - self assert: 21 storeStringHex = '16r15'. - self assert: (228 printStringBase: 4) = '3210'. - self assert: 228 printStringHex = 'E4'. - self assert: (228 storeStringBase: 4) = '4r3210'. - self assert: 228 storeStringHex = '16rE4'. - self assert: (2930 printStringBase: 5) = '43210'. - self assert: 2930 printStringHex = 'B72'. - self assert: (2930 storeStringBase: 5) = '5r43210'. - self assert: 2930 storeStringHex = '16rB72'. - self assert: (44790 printStringBase: 6) = '543210'. - self assert: 44790 printStringHex = 'AEF6'. - self assert: (44790 storeStringBase: 6) = '6r543210'. - self assert: 44790 storeStringHex = '16rAEF6'. - self assert: (800667 printStringBase: 7) = '6543210'. - self assert: 800667 printStringHex = 'C379B'. - self assert: (800667 storeStringBase: 7) = '7r6543210'. - self assert: 800667 storeStringHex = '16rC379B'. - self assert: (16434824 printStringBase: 8) = '76543210'. - self assert: 16434824 printStringHex = 'FAC688'. - self assert: (16434824 storeStringBase: 8) = '8r76543210'. - self assert: 16434824 storeStringHex = '16rFAC688'. - self assert: (381367044 printStringBase: 9) = '876543210'. - self assert: 381367044 printStringHex = '16BB3304'. - self assert: (381367044 storeStringBase: 9) = '9r876543210'. - self assert: 381367044 storeStringHex = '16r16BB3304'. - self assert: (9876543210 printStringBase: 10) = '9876543210'. - self assert: 9876543210 printStringHex = '24CB016EA'. - self assert: (9876543210 storeStringBase: 10) = '9876543210'. - self assert: 9876543210 storeStringHex = '16r24CB016EA'. - self assert: (282458553905 printStringBase: 11) = 'A9876543210'. - self assert: 282458553905 printStringHex = '41C3D77E31'. - self assert: (282458553905 storeStringBase: 11) = '11rA9876543210'. - self assert: 282458553905 storeStringHex = '16r41C3D77E31'. - self assert: (8842413667692 printStringBase: 12) = 'BA9876543210'. - self assert: 8842413667692 printStringHex = '80AC8ECF56C'. - self assert: (8842413667692 storeStringBase: 12) = '12rBA9876543210'. - self assert: 8842413667692 storeStringHex = '16r80AC8ECF56C'. - self assert: (300771807240918 printStringBase: 13) = 'CBA9876543210'. - self assert: 300771807240918 printStringHex = '1118CE4BAA2D6'. - self assert: (300771807240918 storeStringBase: 13) = '13rCBA9876543210'. - self assert: 300771807240918 storeStringHex = '16r1118CE4BAA2D6'. - self assert: (11046255305880158 printStringBase: 14) = 'DCBA9876543210'. - self assert: 11046255305880158 printStringHex = '273E82BB9AF25E'. - self assert: (11046255305880158 storeStringBase: 14) = '14rDCBA9876543210'. - self assert: 11046255305880158 storeStringHex = '16r273E82BB9AF25E'. - self assert: (435659737878916215 printStringBase: 15) = 'EDCBA9876543210'. - self assert: 435659737878916215 printStringHex = '60BC6392F366C77'. - self assert: (435659737878916215 storeStringBase: 15) = '15rEDCBA9876543210'. - self assert: 435659737878916215 storeStringHex = '16r60BC6392F366C77'. - self assert: (18364758544493064720 printStringBase: 16) = 'FEDCBA9876543210'. - self assert: 18364758544493064720 printStringHex = 'FEDCBA9876543210'. - self assert: (18364758544493064720 storeStringBase: 16) = '16rFEDCBA9876543210'. - self assert: 18364758544493064720 storeStringHex = '16rFEDCBA9876543210'. - self assert: (824008854613343261192 printStringBase: 17) = 'GFEDCBA9876543210'. - self assert: 824008854613343261192 printStringHex = '2CAB6B877C1CD2D208'. - self assert: (824008854613343261192 storeStringBase: 17) = '17rGFEDCBA9876543210'. - self assert: 824008854613343261192 storeStringHex = '16r2CAB6B877C1CD2D208'. - self assert: (39210261334551566857170 printStringBase: 18) = 'HGFEDCBA9876543210'. - self assert: 39210261334551566857170 printStringHex = '84D97AFCAE81415B3D2'. - self assert: (39210261334551566857170 storeStringBase: 18) = '18rHGFEDCBA9876543210'. - self assert: 39210261334551566857170 storeStringHex = '16r84D97AFCAE81415B3D2'. - self assert: (1972313422155189164466189 printStringBase: 19) = 'IHGFEDCBA9876543210'. - self assert: 1972313422155189164466189 printStringHex = '1A1A75329C5C6FC00600D'. - self assert: (1972313422155189164466189 storeStringBase: 19) = '19rIHGFEDCBA9876543210'. - self assert: 1972313422155189164466189 storeStringHex = '16r1A1A75329C5C6FC00600D'. - self assert: (104567135734072022160664820 printStringBase: 20) = 'JIHGFEDCBA9876543210'. - self assert: 104567135734072022160664820 printStringHex = '567EF3C9636D242A8C68F4'. - self assert: (104567135734072022160664820 storeStringBase: 20) = '20rJIHGFEDCBA9876543210'. - self assert: 104567135734072022160664820 storeStringHex = '16r567EF3C9636D242A8C68F4'. - self assert: (5827980550840017565077671610 printStringBase: 21) = 'KJIHGFEDCBA9876543210'. - self assert: 5827980550840017565077671610 printStringHex = '12D4CAE2B8A09BCFDBE30EBA'. - self assert: (5827980550840017565077671610 storeStringBase: 21) = '21rKJIHGFEDCBA9876543210'. - self assert: 5827980550840017565077671610 storeStringHex = '16r12D4CAE2B8A09BCFDBE30EBA'. - self assert: (340653664490377789692799452102 printStringBase: 22) = 'LKJIHGFEDCBA9876543210'. - self assert: 340653664490377789692799452102 printStringHex = '44CB61B5B47E1A5D8F88583C6'. - self assert: (340653664490377789692799452102 storeStringBase: 22) = '22rLKJIHGFEDCBA9876543210'. - self assert: 340653664490377789692799452102 storeStringHex = '16r44CB61B5B47E1A5D8F88583C6'. - self assert: (20837326537038308910317109288851 printStringBase: 23) = 'MLKJIHGFEDCBA9876543210'. - self assert: 20837326537038308910317109288851 printStringHex = '1070108876456E0EF115B389F93'. - self assert: (20837326537038308910317109288851 storeStringBase: 23) = '23rMLKJIHGFEDCBA9876543210'. - self assert: 20837326537038308910317109288851 storeStringHex = '16r1070108876456E0EF115B389F93'. - self assert: (1331214537196502869015340298036888 printStringBase: 24) = 'NMLKJIHGFEDCBA9876543210'. - self assert: 1331214537196502869015340298036888 printStringHex = '41A24A285154B026B6ED206C6698'. - self assert: (1331214537196502869015340298036888 storeStringBase: 24) = '24rNMLKJIHGFEDCBA9876543210'. - self assert: 1331214537196502869015340298036888 storeStringHex = '16r41A24A285154B026B6ED206C6698'. - self assert: (88663644327703473714387251271141900 printStringBase: 25) = 'ONMLKJIHGFEDCBA9876543210'. - self assert: 88663644327703473714387251271141900 printStringHex = '111374860A2C6CEBE5999630398A0C'. - self assert: (88663644327703473714387251271141900 storeStringBase: 25) = '25rONMLKJIHGFEDCBA9876543210'. - self assert: 88663644327703473714387251271141900 storeStringHex = '16r111374860A2C6CEBE5999630398A0C'. - self assert: (6146269788878825859099399609538763450 printStringBase: 26) = 'PONMLKJIHGFEDCBA9876543210'. - self assert: 6146269788878825859099399609538763450 printStringHex = '49FBA7F30B0F48BD14E6A99BD8ADABA'. - self assert: (6146269788878825859099399609538763450 storeStringBase: 26) = '26rPONMLKJIHGFEDCBA9876543210'. - self assert: 6146269788878825859099399609538763450 storeStringHex = '16r49FBA7F30B0F48BD14E6A99BD8ADABA'. - self assert: (442770531899482980347734468443677777577 printStringBase: 27) = 'QPONMLKJIHGFEDCBA9876543210'. - self assert: 442770531899482980347734468443677777577 printStringHex = '14D1A80A997343640C1145A073731DEA9'. - self assert: (442770531899482980347734468443677777577 storeStringBase: 27) = '27rQPONMLKJIHGFEDCBA9876543210'. - self assert: 442770531899482980347734468443677777577 storeStringHex = '16r14D1A80A997343640C1145A073731DEA9'. - self assert: (33100056003358651440264672384704297711484 printStringBase: 28) = 'RQPONMLKJIHGFEDCBA9876543210'. - self assert: 33100056003358651440264672384704297711484 printStringHex = '6145B6E6DACFA25D0E936F51D25932377C'. - self assert: (33100056003358651440264672384704297711484 storeStringBase: 28) = '28rRQPONMLKJIHGFEDCBA9876543210'. - self assert: 33100056003358651440264672384704297711484 storeStringHex = '16r6145B6E6DACFA25D0E936F51D25932377C'. - self assert: (2564411043271974895869785066497940850811934 printStringBase: 29) = 'SRQPONMLKJIHGFEDCBA9876543210'. - self assert: 2564411043271974895869785066497940850811934 printStringHex = '1D702071CBA4A1597D4DD37E95EFAC79241E'. - self assert: (2564411043271974895869785066497940850811934 storeStringBase: 29) = '29rSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 2564411043271974895869785066497940850811934 storeStringHex = '16r1D702071CBA4A1597D4DD37E95EFAC79241E'. - self assert: (205646315052919334126040428061831153388822830 printStringBase: 30) = 'TSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 205646315052919334126040428061831153388822830 printStringHex = '938B4343B54B550989989D02998718FFB212E'. - self assert: (205646315052919334126040428061831153388822830 storeStringBase: 30) = '30rTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 205646315052919334126040428061831153388822830 storeStringHex = '16r938B4343B54B550989989D02998718FFB212E'. - self assert: (17050208381689099029767742314582582184093573615 printStringBase: 31) = 'UTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 17050208381689099029767742314582582184093573615 printStringHex = '2FC8ECB1521BA16D24A69E976D53873E2C661EF'. - self assert: (17050208381689099029767742314582582184093573615 storeStringBase: 31) = '31rUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 17050208381689099029767742314582582184093573615 storeStringHex = '16r2FC8ECB1521BA16D24A69E976D53873E2C661EF'. - self assert: (1459980823972598128486511383358617792788444579872 printStringBase: 32) = 'VUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 1459980823972598128486511383358617792788444579872 printStringHex = 'FFBBCDEB38BDAB49CA307B9AC5A928398A418820'. - self assert: (1459980823972598128486511383358617792788444579872 storeStringBase: 32) = '32rVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 1459980823972598128486511383358617792788444579872 storeStringHex = '16rFFBBCDEB38BDAB49CA307B9AC5A928398A418820'. - self assert: (128983956064237823710866404905431464703849549412368 printStringBase: 33) = 'WVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 128983956064237823710866404905431464703849549412368 printStringHex = '584120A0328DE272AB055A8AA003CE4A559F223810'. - self assert: (128983956064237823710866404905431464703849549412368 storeStringBase: 33) = '33rWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 128983956064237823710866404905431464703849549412368 storeStringHex = '16r584120A0328DE272AB055A8AA003CE4A559F223810'. - self assert: (11745843093701610854378775891116314824081102660800418 printStringBase: 34) = 'XWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 11745843093701610854378775891116314824081102660800418 printStringHex = '1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'. - self assert: (11745843093701610854378775891116314824081102660800418 storeStringBase: 34) = '34rXWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 11745843093701610854378775891116314824081102660800418 storeStringHex = '16r1F64D4FC76000F7B92CF0CD5D0F350139AB9F25D8FA2'. - self assert: (1101553773143634726491620528194292510495517905608180485 printStringBase: 35) = 'YXWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 1101553773143634726491620528194292510495517905608180485 printStringHex = 'B8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'. - self assert: (1101553773143634726491620528194292510495517905608180485 storeStringBase: 35) = '35rYXWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 1101553773143634726491620528194292510495517905608180485 storeStringHex = '16rB8031AD55AD1FAA89E07A271CA1ED2F420415D1570305'. - self assert: (106300512100105327644605138221229898724869759421181854980 printStringBase: 36) = 'ZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 106300512100105327644605138221229898724869759421181854980 printStringHex = '455D441E55A37239AB4C303189576071AF5578FFCA80504'. - self assert: (106300512100105327644605138221229898724869759421181854980 storeStringBase: 36) = '36rZYXWVUTSRQPONMLKJIHGFEDCBA9876543210'. - self assert: 106300512100105327644605138221229898724869759421181854980 storeStringHex = '16r455D441E55A37239AB4C303189576071AF5578FFCA80504'.! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:52'! +testQuoSpLn -!IntegerTest methodsFor: 'tests - printing' stamp: 'jmv 10/3/2018 18:05:41'! -testPrintOnBaseShowRadix + self assert: (0 quo: -42391158275216203514294433201) = 0. + self assert: (1 quo: -42391158275216203514294433201) = 0. + self assert: (14348907 quo: -42391158275216203514294433201) = 0! ! - self assert: (123 printStringRadix: 10) = '10r123'. - self assert: (123 printStringRadix: 8) = '8r173'.! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! +testQuoSpLp -!IntegerTest methodsFor: 'tests - printing' stamp: 'nice 2/15/2008 22:31'! -testPrintStringBase - - 2 to: 32 do: [:b | - 1 to: 1000//b do: [:n | - | bRaisedToN | - bRaisedToN := b raisedTo: n. - self assert: (bRaisedToN - 1 printStringBase: b) = (String new: n withAll: (Character digitValue: b-1)). - self assert: (bRaisedToN printStringBase: b) = ('1' , (String new: n withAll: $0)). - - self assert: (bRaisedToN negated + 1 printStringBase: b) = ('-' , (String new: n withAll: (Character digitValue: b-1))). - self assert: (bRaisedToN negated printStringBase: b) = ('-1' , (String new: n withAll: $0))]]. -! ! + self assert: (0 quo: 42391158275216203514294433201) = 0. + self assert: (1 quo: 42391158275216203514294433201) = 0. + self assert: (14348907 quo: 42391158275216203514294433201) = 0! ! -!IntegerTest methodsFor: 'tests - printing' stamp: 'laza 3/30/2004 09:23'! -testRomanPrinting - self assert: 0 printStringRoman = ''. "No symbol for zero" - self assert: 1 printStringRoman = 'I'. - self assert: 2 printStringRoman = 'II'. - self assert: 3 printStringRoman = 'III'. - self assert: 4 printStringRoman = 'IV'. - self assert: 5 printStringRoman = 'V'. - self assert: 6 printStringRoman = 'VI'. - self assert: 7 printStringRoman = 'VII'. - self assert: 8 printStringRoman = 'VIII'. - self assert: 9 printStringRoman = 'IX'. - self assert: 10 printStringRoman = 'X'. - self assert: 23 printStringRoman = 'XXIII'. - self assert: 36 printStringRoman = 'XXXVI'. - self assert: 49 printStringRoman = 'XLIX'. - self assert: 62 printStringRoman = 'LXII'. - self assert: 75 printStringRoman = 'LXXV'. - self assert: 88 printStringRoman = 'LXXXVIII'. - self assert: 99 printStringRoman = 'XCIX'. - self assert: 100 printStringRoman = 'C'. - self assert: 101 printStringRoman = 'CI'. - self assert: 196 printStringRoman = 'CXCVI'. - self assert: 197 printStringRoman = 'CXCVII'. - self assert: 198 printStringRoman = 'CXCVIII'. - self assert: 293 printStringRoman = 'CCXCIII'. - self assert: 294 printStringRoman = 'CCXCIV'. - self assert: 295 printStringRoman = 'CCXCV'. - self assert: 390 printStringRoman = 'CCCXC'. - self assert: 391 printStringRoman = 'CCCXCI'. - self assert: 392 printStringRoman = 'CCCXCII'. - self assert: 487 printStringRoman = 'CDLXXXVII'. - self assert: 488 printStringRoman = 'CDLXXXVIII'. - self assert: 489 printStringRoman = 'CDLXXXIX'. - self assert: 584 printStringRoman = 'DLXXXIV'. - self assert: 585 printStringRoman = 'DLXXXV'. - self assert: 586 printStringRoman = 'DLXXXVI'. - self assert: 681 printStringRoman = 'DCLXXXI'. - self assert: 682 printStringRoman = 'DCLXXXII'. - self assert: 683 printStringRoman = 'DCLXXXIII'. - self assert: 778 printStringRoman = 'DCCLXXVIII'. - self assert: 779 printStringRoman = 'DCCLXXIX'. - self assert: 780 printStringRoman = 'DCCLXXX'. - self assert: 875 printStringRoman = 'DCCCLXXV'. - self assert: 876 printStringRoman = 'DCCCLXXVI'. - self assert: 877 printStringRoman = 'DCCCLXXVII'. - self assert: 972 printStringRoman = 'CMLXXII'. - self assert: 973 printStringRoman = 'CMLXXIII'. - self assert: 974 printStringRoman = 'CMLXXIV'. - self assert: 1069 printStringRoman = 'MLXIX'. - self assert: 1070 printStringRoman = 'MLXX'. - self assert: 1071 printStringRoman = 'MLXXI'. - self assert: 1166 printStringRoman = 'MCLXVI'. - self assert: 1167 printStringRoman = 'MCLXVII'. - self assert: 1168 printStringRoman = 'MCLXVIII'. - self assert: 1263 printStringRoman = 'MCCLXIII'. - self assert: 1264 printStringRoman = 'MCCLXIV'. - self assert: 1265 printStringRoman = 'MCCLXV'. - self assert: 1360 printStringRoman = 'MCCCLX'. - self assert: 1361 printStringRoman = 'MCCCLXI'. - self assert: 1362 printStringRoman = 'MCCCLXII'. - self assert: 1457 printStringRoman = 'MCDLVII'. - self assert: 1458 printStringRoman = 'MCDLVIII'. - self assert: 1459 printStringRoman = 'MCDLIX'. - self assert: 1554 printStringRoman = 'MDLIV'. - self assert: 1555 printStringRoman = 'MDLV'. - self assert: 1556 printStringRoman = 'MDLVI'. - self assert: 1651 printStringRoman = 'MDCLI'. - self assert: 1652 printStringRoman = 'MDCLII'. - self assert: 1653 printStringRoman = 'MDCLIII'. - self assert: 1748 printStringRoman = 'MDCCXLVIII'. - self assert: 1749 printStringRoman = 'MDCCXLIX'. - self assert: 1750 printStringRoman = 'MDCCL'. - self assert: 1845 printStringRoman = 'MDCCCXLV'. - self assert: 1846 printStringRoman = 'MDCCCXLVI'. - self assert: 1847 printStringRoman = 'MDCCCXLVII'. - self assert: 1942 printStringRoman = 'MCMXLII'. - self assert: 1943 printStringRoman = 'MCMXLIII'. - self assert: 1944 printStringRoman = 'MCMXLIV'. - self assert: 2004 printStringRoman = 'MMIV'. - - self assert: -1 printStringRoman = '-I'. - self assert: -2 printStringRoman = '-II'. - self assert: -3 printStringRoman = '-III'. - self assert: -4 printStringRoman = '-IV'. - self assert: -5 printStringRoman = '-V'. - self assert: -6 printStringRoman = '-VI'. - self assert: -7 printStringRoman = '-VII'. - self assert: -8 printStringRoman = '-VIII'. - self assert: -9 printStringRoman = '-IX'. - self assert: -10 printStringRoman = '-X'. -! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:50'! +testQuoSpSn -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:57'! -testModLnLn + self assert: (0 quo: -3) = 0. + self assert: (1 quo: -3) = 0. + self assert: (9 quo: -3) = -3. + self assert: (10 quo: -3) = -3. + self assert: (11 quo: -3) = -3. + self assert: (12 quo: -3) = -4. + self assert: (13 quo: -3) = -4! ! - self assert: (-42391158275216203514294433200 mod: -14130386091738734504764811067) = 1. - self assert: (-42391158275216203514294433201 mod: -14130386091738734504764811067) = 0. - self assert: (-42391158275216203514294433202 mod: -14130386091738734504764811067) = 14130386091738734504764811066. - self assert: (-8727963568087712425891397479476727340041448 mod: -79766443076872509863361) = 1. - self assert: (-8727963568087712425891397479476727340041449 mod: -79766443076872509863361) = 0. - self assert: (-8727963568087712425891397479476727340041450 mod: -79766443076872509863361) = 79766443076872509863360! ! +!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! +testQuoSpSp -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! -testModLnLp + self assert: (0 quo: 3) = 0. + self assert: (1 quo: 3) = 0. + self assert: (9 quo: 3) = 3. + self assert: (10 quo: 3) = 3. + self assert: (11 quo: 3) = 3. + self assert: (12 quo: 3) = 4. + self assert: (13 quo: 3) = 4! ! - self assert: (-42391158275216203514294433200 mod: 14130386091738734504764811067) = 1. - self assert: (-42391158275216203514294433201 mod: 14130386091738734504764811067) = 0. - self assert: (-42391158275216203514294433202 mod: 14130386091738734504764811067) = 14130386091738734504764811066. - self assert: (-8727963568087712425891397479476727340041448 mod: 79766443076872509863361) = 1. - self assert: (-8727963568087712425891397479476727340041449 mod: 79766443076872509863361) = 0. - self assert: (-8727963568087712425891397479476727340041450 mod: 79766443076872509863361) = 79766443076872509863360! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! +testRemLnLn -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 15:05'! -testModLnSn + self assert: (-42391158275216203514294433200 rem: -14130386091738734504764811067) = -14130386091738734504764811066. + self assert: (-42391158275216203514294433201 rem: -14130386091738734504764811067) = 0. + self assert: (-42391158275216203514294433202 rem: -14130386091738734504764811067) = -1. + self assert: (-8727963568087712425891397479476727340041448 rem: -79766443076872509863361) = -79766443076872509863360. + self assert: (-8727963568087712425891397479476727340041449 rem: -79766443076872509863361) = 0. + self assert: (-8727963568087712425891397479476727340041450 rem: -79766443076872509863361) = -1! ! - self assert: (-42391158275216203514294433201 mod: -3) = 0. - self assert: (-42391158275216203514294433202 mod: -3) = 2. - self assert: (-42391158275216203514294433203 mod: -3) = 1. - self assert: (-42391158275216203514294433204 mod: -3) = 0! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:47'! +testRemLnLp -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! -testModLnSp + self assert: (-42391158275216203514294433200 rem: 14130386091738734504764811067) = -14130386091738734504764811066. + self assert: (-42391158275216203514294433201 rem: 14130386091738734504764811067) = 0. + self assert: (-42391158275216203514294433202 rem: 14130386091738734504764811067) = -1. + self assert: (-8727963568087712425891397479476727340041448 rem: 79766443076872509863361) = -79766443076872509863360. + self assert: (-8727963568087712425891397479476727340041449 rem: 79766443076872509863361) = 0. + self assert: (-8727963568087712425891397479476727340041450 rem: 79766443076872509863361) = -1! ! - self assert: (-42391158275216203514294433201 mod: 3) = 0. - self assert: (-42391158275216203514294433202 mod: 3) = 2. - self assert: (-42391158275216203514294433203 mod: 3) = 1. - self assert: (-42391158275216203514294433204 mod: 3) = 0! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! +testRemLnSn -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 15:05'! -testModLpLn + self assert: (-42391158275216203514294433201 rem: -3) = 0. + self assert: (-42391158275216203514294433202 rem: -3) = -1. + self assert: (-42391158275216203514294433203 rem: -3) = -2. + self assert: (-42391158275216203514294433204 rem: -3) = 0! ! - self assert: (42391158275216203514294433200 mod: -14130386091738734504764811067) = 14130386091738734504764811066. - self assert: (42391158275216203514294433201 mod: -14130386091738734504764811067) = 0. - self assert: (42391158275216203514294433202 mod: -14130386091738734504764811067) = 1. - self assert: (8727963568087712425891397479476727340041448 mod: -79766443076872509863361) = 79766443076872509863360. - self assert: (8727963568087712425891397479476727340041449 mod: -79766443076872509863361) = 0. - self assert: (8727963568087712425891397479476727340041450 mod: -79766443076872509863361) = 1! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:49'! +testRemLnSp -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! -testModLpLp + self assert: (-42391158275216203514294433201 rem: 3) = 0. + self assert: (-42391158275216203514294433202 rem: 3) = -1. + self assert: (-42391158275216203514294433203 rem: 3) = -2. + self assert: (-42391158275216203514294433204 rem: 3) = 0! ! - self assert: (42391158275216203514294433200 mod: 14130386091738734504764811067) = 14130386091738734504764811066. - self assert: (42391158275216203514294433201 mod: 14130386091738734504764811067) = 0. - self assert: (42391158275216203514294433202 mod: 14130386091738734504764811067) = 1. - self assert: (8727963568087712425891397479476727340041448 mod: 79766443076872509863361) = 79766443076872509863360. - self assert: (8727963568087712425891397479476727340041449 mod: 79766443076872509863361) = 0. - self assert: (8727963568087712425891397479476727340041450 mod: 79766443076872509863361) = 1! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:48'! +testRemLpLn -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 15:04'! -testModLpSn + self assert: (42391158275216203514294433200 rem: -14130386091738734504764811067) = 14130386091738734504764811066. + self assert: (42391158275216203514294433201 rem: -14130386091738734504764811067) = 0. + self assert: (42391158275216203514294433202 rem: -14130386091738734504764811067) = 1. + self assert: (8727963568087712425891397479476727340041448 rem: -79766443076872509863361) = 79766443076872509863360. + self assert: (8727963568087712425891397479476727340041449 rem: -79766443076872509863361) = 0. + self assert: (8727963568087712425891397479476727340041450 rem: -79766443076872509863361) = 1! ! - self assert: (42391158275216203514294433201 mod: -3) = 0. - self assert: (42391158275216203514294433202 mod: -3) = 1. - self assert: (42391158275216203514294433203 mod: -3) = 2. - self assert: (42391158275216203514294433204 mod: -3) = 0! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! +testRemLpLp -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! -testModLpSp + self assert: (42391158275216203514294433200 rem: 14130386091738734504764811067) = 14130386091738734504764811066. + self assert: (42391158275216203514294433201 rem: 14130386091738734504764811067) = 0. + self assert: (42391158275216203514294433202 rem: 14130386091738734504764811067) = 1. + self assert: (8727963568087712425891397479476727340041448 rem: 79766443076872509863361) = 79766443076872509863360. + self assert: (8727963568087712425891397479476727340041449 rem: 79766443076872509863361) = 0. + self assert: (8727963568087712425891397479476727340041450 rem: 79766443076872509863361) = 1! ! - self assert: (42391158275216203514294433201 mod: 3) = 0. - self assert: (42391158275216203514294433202 mod: 3) = 1. - self assert: (42391158275216203514294433203 mod: 3) = 2. - self assert: (42391158275216203514294433204 mod: 3) = 0! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:49'! +testRemLpSn -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 15:04'! -testModSnLn + self assert: (42391158275216203514294433201 rem: -3) = 0. + self assert: (42391158275216203514294433202 rem: -3) = 1. + self assert: (42391158275216203514294433203 rem: -3) = 2. + self assert: (42391158275216203514294433204 rem: -3) = 0! ! - self assert: (0 mod: -42391158275216203514294433201) = 0. - self assert: (-1 mod: -42391158275216203514294433201) = 42391158275216203514294433200. - self assert: (-14348907 mod: -42391158275216203514294433201) = 42391158275216203514280084294! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! +testRemLpSp -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! -testModSnLp + self assert: (42391158275216203514294433201 rem: 3) = 0. + self assert: (42391158275216203514294433202 rem: 3) = 1. + self assert: (42391158275216203514294433203 rem: 3) = 2. + self assert: (42391158275216203514294433204 rem: 3) = 0! ! - self assert: (0 mod: 42391158275216203514294433201) = 0. - self assert: (-1 mod: 42391158275216203514294433201) = 42391158275216203514294433200. - self assert: (-14348907 mod: 42391158275216203514294433201) = 42391158275216203514280084294! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! +testRemSnLn -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 15:00'! -testModSnSn + self assert: (0 rem: -42391158275216203514294433201) = 0. + self assert: (-1 rem: -42391158275216203514294433201) = -1. + self assert: (-14348907 rem: -42391158275216203514294433201) = -14348907! ! - self assert: (0 mod: -3) = 0. - self assert: (-1 mod: -3) = 2. - self assert: (-9 mod: -3) = 0. - self assert: (-10 mod: -3) = 2. - self assert: (-11 mod: -3) = 1. - self assert: (-12 mod: -3) = 0. - self assert: (-13 mod: -3) = 2! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:47'! +testRemSnLp -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:59'! -testModSnSp + self assert: (0 rem: 42391158275216203514294433201) = 0. + self assert: (-1 rem: 42391158275216203514294433201) = -1. + self assert: (-14348907 rem: 42391158275216203514294433201) = -14348907! ! - self assert: (0 mod: 3) = 0. - self assert: (-1 mod: 3) = 2. - self assert: (-9 mod: 3) = 0. - self assert: (-10 mod: 3) = 2. - self assert: (-11 mod: 3) = 1. - self assert: (-12 mod: 3) = 0. - self assert: (-13 mod: 3) = 2! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! +testRemSnSn -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 15:05'! -testModSpLn + self assert: (0 rem: -3) = 0. + self assert: (-1 rem: -3) = -1. + self assert: (-9 rem: -3) = 0. + self assert: (-10 rem: -3) = -1. + self assert: (-11 rem: -3) = -2. + self assert: (-12 rem: -3) = 0. + self assert: (-13 rem: -3) = -1! ! - self assert: (0 mod: -42391158275216203514294433201) = 0. - self assert: (1 mod: -42391158275216203514294433201) = 1. - self assert: (14348907 mod: -42391158275216203514294433201) = 14348907! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:37'! +testRemSnSp -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! -testModSpLp + self assert: (0 rem: 3) = 0. + self assert: (-1 rem: 3) = -1. + self assert: (-9 rem: 3) = 0. + self assert: (-10 rem: 3) = -1. + self assert: (-11 rem: 3) = -2. + self assert: (-12 rem: 3) = 0. + self assert: (-13 rem: 3) = -1! ! - self assert: (0 mod: 42391158275216203514294433201) = 0. - self assert: (1 mod: 42391158275216203514294433201) = 1. - self assert: (14348907 mod: 42391158275216203514294433201) = 14348907! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:38'! +testRemSpLn -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:58'! -testModSpSn + self assert: (0 rem: -42391158275216203514294433201) = 0. + self assert: (1 rem: -42391158275216203514294433201) = 1. + self assert: (14348907 rem: -42391158275216203514294433201) = 14348907! ! - self assert: (0 mod: -3) = 0. - self assert: (1 mod: -3) = 1. - self assert: (9 mod: -3) = 0. - self assert: (10 mod: -3) = 1. - self assert: (11 mod: -3) = 2. - self assert: (12 mod: -3) = 0. - self assert: (13 mod: -3) = 1! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! +testRemSpLp -!IntegerTest methodsFor: 'tests - division - mod:' stamp: 'sqr 1/25/2014 14:35'! -testModSpSp + self assert: (0 rem: 42391158275216203514294433201) = 0. + self assert: (1 rem: 42391158275216203514294433201) = 1. + self assert: (14348907 rem: 42391158275216203514294433201) = 14348907! ! - self assert: (0 mod: 3) = 0. - self assert: (1 mod: 3) = 1. - self assert: (9 mod: 3) = 0. - self assert: (10 mod: 3) = 1. - self assert: (11 mod: 3) = 2. - self assert: (12 mod: 3) = 0. - self assert: (13 mod: 3) = 1! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:48'! +testRemSpSn -!IntegerTest methodsFor: 'mathematical functions' stamp: 'jmv 10/15/2016 10:58:02'! -testNthRootExactnessForHugeValue - " - self new testNthRootExactnessForHugeValue - " - self assert: ((10 raisedTo: 600) nthRoot: 300) = 100. - self assert: ((10 raisedTo: 600) nthRoot: 300) class == SmallInteger. - self assert: ((10 raisedTo: 600) + 1 nthRoot: 300) = 100.0. - self assert: (((10 raisedTo: 600) + 1 nthRoot: 300) isKindOf: Float)! ! + self assert: (0 rem: -3) = 0. + self assert: (1 rem: -3) = 1. + self assert: (9 rem: -3) = 0. + self assert: (10 rem: -3) = 1. + self assert: (11 rem: -3) = 2. + self assert: (12 rem: -3) = 0. + self assert: (13 rem: -3) = 1! ! -!IntegerTest methodsFor: 'mathematical functions' stamp: 'jmv 10/15/2016 10:57:28'! -testNthRootImmuneToDoubleRounding -" -self new testNthRootImmuneToDoubleRounding -" - "Use a specially crafted number for causing double rounding. - Solution is 10...01.1 - verySmallQuantity. - Where verySmallQuantity is approximately 1/53/(1<<53). - If the verySmallQuantity is not taken into account, then solution is rounded to 10....010" - | exponent crafted root highPrecisionRoot | - exponent := 4. - crafted := (1 << Float precision + 3 raisedTo: exponent) - 1. - root := crafted nthRoot: exponent. - highPrecisionRoot := (crafted << (exponent squared * Float precision * 4) nthRootRounded: exponent) / (1 << (exponent * Float precision * 4)). - self assert: (root asFraction - highPrecisionRoot) abs < (root predecessor asFraction - highPrecisionRoot) abs. - - "Same with the other sign. - Solution is 10...00.1 + verySmallQuantity." - crafted := (1 << Float precision + 1 raisedTo: exponent) + 1. - root := crafted nthRoot: exponent. - highPrecisionRoot := (crafted << (exponent squared * Float precision * 4) nthRootRounded: exponent) / (1 << (exponent * Float precision * 4)). - self assert: (root asFraction - highPrecisionRoot) abs < (root successor asFraction - highPrecisionRoot) abs.! ! +!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! +testRemSpSp -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:36'! -testQuoLnLn + self assert: (0 rem: 3) = 0. + self assert: (1 rem: 3) = 1. + self assert: (9 rem: 3) = 0. + self assert: (10 rem: 3) = 1. + self assert: (11 rem: 3) = 2. + self assert: (12 rem: 3) = 0. + self assert: (13 rem: 3) = 1! ! - self assert: (-42391158275216203514294433200 quo: -14130386091738734504764811067) = 2. - self assert: (-42391158275216203514294433201 quo: -14130386091738734504764811067) = 3. - self assert: (-42391158275216203514294433202 quo: -14130386091738734504764811067) = 3. - self assert: (-8727963568087712425891397479476727340041448 quo: -79766443076872509863361) = 109418989131512359208. - self assert: (-8727963568087712425891397479476727340041449 quo: -79766443076872509863361) = 109418989131512359209. - self assert: (-8727963568087712425891397479476727340041450 quo: -79766443076872509863361) = 109418989131512359209! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:56'! +testSlashSlashLnLn -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:51'! -testQuoLnLp + self assert: -42391158275216203514294433200 // -14130386091738734504764811067 = 2. + self assert: -42391158275216203514294433201 // -14130386091738734504764811067 = 3. + self assert: -42391158275216203514294433202 // -14130386091738734504764811067 = 3. + self assert: -8727963568087712425891397479476727340041448 // -79766443076872509863361 = 109418989131512359208. + self assert: -8727963568087712425891397479476727340041449 // -79766443076872509863361 = 109418989131512359209. + self assert: -8727963568087712425891397479476727340041450 // -79766443076872509863361 = 109418989131512359209! ! - self assert: (-42391158275216203514294433200 quo: 14130386091738734504764811067) = -2. - self assert: (-42391158275216203514294433201 quo: 14130386091738734504764811067) = -3. - self assert: (-42391158275216203514294433202 quo: 14130386091738734504764811067) = -3. - self assert: (-8727963568087712425891397479476727340041448 quo: 79766443076872509863361) = -109418989131512359208. - self assert: (-8727963568087712425891397479476727340041449 quo: 79766443076872509863361) = -109418989131512359209. - self assert: (-8727963568087712425891397479476727340041450 quo: 79766443076872509863361) = -109418989131512359209! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:47'! +testSlashSlashLnLp -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! -testQuoLnSn + self assert: -42391158275216203514294433200 // 14130386091738734504764811067 = -3. + self assert: -42391158275216203514294433201 // 14130386091738734504764811067 = -3. + self assert: -42391158275216203514294433202 // 14130386091738734504764811067 = -4. + self assert: -8727963568087712425891397479476727340041448 // 79766443076872509863361 = -109418989131512359209. + self assert: -8727963568087712425891397479476727340041449 // 79766443076872509863361 = -109418989131512359209. + self assert: -8727963568087712425891397479476727340041450 // 79766443076872509863361 = -109418989131512359210! ! - self assert: (-42391158275216203514294433201 quo: -3) = 14130386091738734504764811067. - self assert: (-42391158275216203514294433202 quo: -3) = 14130386091738734504764811067. - self assert: (-42391158275216203514294433203 quo: -3) = 14130386091738734504764811067. - self assert: (-42391158275216203514294433204 quo: -3) = 14130386091738734504764811068! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:54'! +testSlashSlashLnSn -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:51'! -testQuoLnSp + self assert: -42391158275216203514294433201 // -3 = 14130386091738734504764811067. + self assert: -42391158275216203514294433202 // -3 = 14130386091738734504764811067. + self assert: -42391158275216203514294433203 // -3 = 14130386091738734504764811067. + self assert: -42391158275216203514294433204 // -3 = 14130386091738734504764811068! ! - self assert: (-42391158275216203514294433201 quo: 3) = -14130386091738734504764811067. - self assert: (-42391158275216203514294433202 quo: 3) = -14130386091738734504764811067. - self assert: (-42391158275216203514294433203 quo: 3) = -14130386091738734504764811067. - self assert: (-42391158275216203514294433204 quo: 3) = -14130386091738734504764811068! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:45'! +testSlashSlashLnSp -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:52'! -testQuoLpLn + self assert: -42391158275216203514294433201 // 3 = -14130386091738734504764811067. + self assert: -42391158275216203514294433202 // 3 = -14130386091738734504764811068. + self assert: -42391158275216203514294433203 // 3 = -14130386091738734504764811068. + self assert: -42391158275216203514294433204 // 3 = -14130386091738734504764811068! ! - self assert: (42391158275216203514294433200 quo: -14130386091738734504764811067) = -2. - self assert: (42391158275216203514294433201 quo: -14130386091738734504764811067) = -3. - self assert: (42391158275216203514294433202 quo: -14130386091738734504764811067) = -3. - self assert: (8727963568087712425891397479476727340041448 quo: -79766443076872509863361) = -109418989131512359208. - self assert: (8727963568087712425891397479476727340041449 quo: -79766443076872509863361) = -109418989131512359209. - self assert: (8727963568087712425891397479476727340041450 quo: -79766443076872509863361) = -109418989131512359209! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:54'! +testSlashSlashLpLn -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! -testQuoLpLp + self assert: 42391158275216203514294433200 // -14130386091738734504764811067 = -3. + self assert: 42391158275216203514294433201 // -14130386091738734504764811067 = -3. + self assert: 42391158275216203514294433202 // -14130386091738734504764811067 = -4. + self assert: 8727963568087712425891397479476727340041448 // -79766443076872509863361 = -109418989131512359209. + self assert: 8727963568087712425891397479476727340041449 // -79766443076872509863361 = -109418989131512359209. + self assert: 8727963568087712425891397479476727340041450 // -79766443076872509863361 = -109418989131512359210! ! - self assert: (42391158275216203514294433200 quo: 14130386091738734504764811067) = 2. - self assert: (42391158275216203514294433201 quo: 14130386091738734504764811067) = 3. - self assert: (42391158275216203514294433202 quo: 14130386091738734504764811067) = 3. - self assert: (8727963568087712425891397479476727340041448 quo: 79766443076872509863361) = 109418989131512359208. - self assert: (8727963568087712425891397479476727340041449 quo: 79766443076872509863361) = 109418989131512359209. - self assert: (8727963568087712425891397479476727340041450 quo: 79766443076872509863361) = 109418989131512359209! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:52'! +testSlashSlashLpSn -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:50'! -testQuoLpSn + self assert: 42391158275216203514294433201 // -3 = -14130386091738734504764811067. + self assert: 42391158275216203514294433202 // -3 = -14130386091738734504764811068. + self assert: 42391158275216203514294433203 // -3 = -14130386091738734504764811068. + self assert: 42391158275216203514294433204 // -3 = -14130386091738734504764811068! ! - self assert: (42391158275216203514294433201 quo: -3) = -14130386091738734504764811067. - self assert: (42391158275216203514294433202 quo: -3) = -14130386091738734504764811067. - self assert: (42391158275216203514294433203 quo: -3) = -14130386091738734504764811067. - self assert: (42391158275216203514294433204 quo: -3) = -14130386091738734504764811068! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:52'! +testSlashSlashSnLn -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! -testQuoLpSp + self assert: 0 // -42391158275216203514294433201 = 0. + self assert: -1 // -42391158275216203514294433201 = 0. + self assert: -14348907 // -42391158275216203514294433201 = 0! ! - self assert: (42391158275216203514294433201 quo: 3) = 14130386091738734504764811067. - self assert: (42391158275216203514294433202 quo: 3) = 14130386091738734504764811067. - self assert: (42391158275216203514294433203 quo: 3) = 14130386091738734504764811067. - self assert: (42391158275216203514294433204 quo: 3) = 14130386091738734504764811068! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:44'! +testSlashSlashSnLp -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! -testQuoSnLn + self assert: 0 // 42391158275216203514294433201 = 0. + self assert: -1 // 42391158275216203514294433201 = -1. + self assert: -14348907 // 42391158275216203514294433201 = -1! ! - self assert: (0 quo: -42391158275216203514294433201) = 0. - self assert: (-1 quo: -42391158275216203514294433201) = 0. - self assert: (-14348907 quo: -42391158275216203514294433201) = 0! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:51'! +testSlashSlashSnSn -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:50'! -testQuoSnLp + self assert: 0 // -3 = 0. + self assert: -1 // -3 = 0. + self assert: -9 // -3 = 3. + self assert: -10 // -3 = 3. + self assert: -11 // -3 = 3. + self assert: -12 // -3 = 4. + self assert: -13 // -3 = 4! ! - self assert: (0 quo: 42391158275216203514294433201) = 0. - self assert: (-1 quo: 42391158275216203514294433201) = 0. - self assert: (-14348907 quo: 42391158275216203514294433201) = 0! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:42'! +testSlashSlashSnSp -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! -testQuoSnSn + self assert: 0 // 3 = 0. + self assert: -1 // 3 = -1. + self assert: -9 // 3 = -3. + self assert: -10 // 3 = -4. + self assert: -11 // 3 = -4. + self assert: -12 // 3 = -4. + self assert: -13 // 3 = -5! ! - self assert: (0 quo: -3) = 0. - self assert: (-1 quo: -3) = 0. - self assert: (-9 quo: -3) = 3. - self assert: (-10 quo: -3) = 3. - self assert: (-11 quo: -3) = 3. - self assert: (-12 quo: -3) = 4. - self assert: (-13 quo: -3) = 4! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:51'! +testSlashSlashSpLn -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:51'! -testQuoSnSp + self assert: 0 // -42391158275216203514294433201 = 0. + self assert: 1 // -42391158275216203514294433201 = -1. + self assert: 14348907 // -42391158275216203514294433201 = -1! ! - self assert: (0 quo: 3) = 0. - self assert: (-1 quo: 3) = 0. - self assert: (-9 quo: 3) = -3. - self assert: (-10 quo: 3) = -3. - self assert: (-11 quo: 3) = -3. - self assert: (-12 quo: 3) = -4. - self assert: (-13 quo: 3) = -4! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:44'! +testSlashSlashSpLp -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:52'! -testQuoSpLn + self assert: 0 // 42391158275216203514294433201 = 0. + self assert: 1 // 42391158275216203514294433201 = 0. + self assert: 14348907 // 42391158275216203514294433201 = 0! ! - self assert: (0 quo: -42391158275216203514294433201) = 0. - self assert: (1 quo: -42391158275216203514294433201) = 0. - self assert: (14348907 quo: -42391158275216203514294433201) = 0! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:50'! +testSlashSlashSpSn -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! -testQuoSpLp + self assert: 0 // -3 = 0. + self assert: 1 // -3 = -1. + self assert: 9 // -3 = -3. + self assert: 10 // -3 = -4. + self assert: 11 // -3 = -4. + self assert: 12 // -3 = -4. + self assert: 13 // -3 = -5! ! - self assert: (0 quo: 42391158275216203514294433201) = 0. - self assert: (1 quo: 42391158275216203514294433201) = 0. - self assert: (14348907 quo: 42391158275216203514294433201) = 0! ! +!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:42'! +testSlashSlashSpSp -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:50'! -testQuoSpSn + self assert: 0 // 3 = 0. + self assert: 1 // 3 = 0. + self assert: 9 // 3 = 3. + self assert: 10 // 3 = 3. + self assert: 11 // 3 = 3. + self assert: 12 // 3 = 4. + self assert: 13 // 3 = 4! ! - self assert: (0 quo: -3) = 0. - self assert: (1 quo: -3) = 0. - self assert: (9 quo: -3) = -3. - self assert: (10 quo: -3) = -3. - self assert: (11 quo: -3) = -3. - self assert: (12 quo: -3) = -4. - self assert: (13 quo: -3) = -4! ! - -!IntegerTest methodsFor: 'tests - division - quo:' stamp: 'sqr 1/25/2014 14:33'! -testQuoSpSp - - self assert: (0 quo: 3) = 0. - self assert: (1 quo: 3) = 0. - self assert: (9 quo: 3) = 3. - self assert: (10 quo: 3) = 3. - self assert: (11 quo: 3) = 3. - self assert: (12 quo: 3) = 4. - self assert: (13 quo: 3) = 4! ! - -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! -testRemLnLn +!IntegerTest methodsFor: 'tests - division' stamp: 'sqr 1/25/2014 13:38'! +testSlashSlashLpLp - self assert: (-42391158275216203514294433200 rem: -14130386091738734504764811067) = -14130386091738734504764811066. - self assert: (-42391158275216203514294433201 rem: -14130386091738734504764811067) = 0. - self assert: (-42391158275216203514294433202 rem: -14130386091738734504764811067) = -1. - self assert: (-8727963568087712425891397479476727340041448 rem: -79766443076872509863361) = -79766443076872509863360. - self assert: (-8727963568087712425891397479476727340041449 rem: -79766443076872509863361) = 0. - self assert: (-8727963568087712425891397479476727340041450 rem: -79766443076872509863361) = -1! ! + self assert: 42391158275216203514294433200 // 14130386091738734504764811067 = 2. + self assert: 42391158275216203514294433201 // 14130386091738734504764811067 = 3. + self assert: 42391158275216203514294433202 // 14130386091738734504764811067 = 3. + self assert: 8727963568087712425891397479476727340041448 // 79766443076872509863361 = 109418989131512359208. + self assert: 8727963568087712425891397479476727340041449 // 79766443076872509863361 = 109418989131512359209. + self assert: 8727963568087712425891397479476727340041450 // 79766443076872509863361 = 109418989131512359209! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:47'! -testRemLnLp +!IntegerTest methodsFor: 'tests - division' stamp: 'sqr 1/25/2014 13:33'! +testSlashSlashLpSp - self assert: (-42391158275216203514294433200 rem: 14130386091738734504764811067) = -14130386091738734504764811066. - self assert: (-42391158275216203514294433201 rem: 14130386091738734504764811067) = 0. - self assert: (-42391158275216203514294433202 rem: 14130386091738734504764811067) = -1. - self assert: (-8727963568087712425891397479476727340041448 rem: 79766443076872509863361) = -79766443076872509863360. - self assert: (-8727963568087712425891397479476727340041449 rem: 79766443076872509863361) = 0. - self assert: (-8727963568087712425891397479476727340041450 rem: 79766443076872509863361) = -1! ! + self assert: 42391158275216203514294433201 // 3 = 14130386091738734504764811067. + self assert: 42391158275216203514294433202 // 3 = 14130386091738734504764811067. + self assert: 42391158275216203514294433203 // 3 = 14130386091738734504764811067. + self assert: 42391158275216203514294433204 // 3 = 14130386091738734504764811068! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! -testRemLnSn +!IntegerTest methodsFor: 'as yet unclassified' stamp: 'jmv 9/10/2018 10:28:17'! +test01readFromWithEmptyStringRaisesAnError + |input| + + input := ReadStream on: ''. - self assert: (-42391158275216203514294433201 rem: -3) = 0. - self assert: (-42391158275216203514294433202 rem: -3) = -1. - self assert: (-42391158275216203514294433203 rem: -3) = -2. - self assert: (-42391158275216203514294433204 rem: -3) = 0! ! + self should: [ Integer readFrom: input ] raise: Error description: 'At least one digit expected here'! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:49'! -testRemLnSp +!IntegerTest methodsFor: 'as yet unclassified' stamp: 'jmv 9/10/2018 10:28:20'! +test02readFromWithInvalidStringRaisesAnError + | input | + + input := ReadStream on: 'hello'. - self assert: (-42391158275216203514294433201 rem: 3) = 0. - self assert: (-42391158275216203514294433202 rem: 3) = -1. - self assert: (-42391158275216203514294433203 rem: 3) = -2. - self assert: (-42391158275216203514294433204 rem: 3) = 0! ! + self should: [ Integer readFrom: input ] raise: Error description: 'At least one digit expected here'! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:48'! -testRemLpLn +!IntegerTest methodsFor: 'gcd and lcm' stamp: 'len 6/27/2019 10:23:39'! +testGCDAndLCM + | a b c | + a _ (-20 to: 20) atRandom. + b _ (-20 to: 20) atRandom. + c _ (-20 to: 20) atRandom. + self assert: (a gcd: b) * (a lcm: b) = (a*b) abs. + self assert: (a gcd: (b lcm: c)) = ((a gcd: b) lcm: (a gcd: c)). + self assert: (a lcm: (b gcd: c)) = ((a lcm: b) gcd: (a lcm: c))! ! - self assert: (42391158275216203514294433200 rem: -14130386091738734504764811067) = 14130386091738734504764811066. - self assert: (42391158275216203514294433201 rem: -14130386091738734504764811067) = 0. - self assert: (42391158275216203514294433202 rem: -14130386091738734504764811067) = 1. - self assert: (8727963568087712425891397479476727340041448 rem: -79766443076872509863361) = 79766443076872509863360. - self assert: (8727963568087712425891397479476727340041449 rem: -79766443076872509863361) = 0. - self assert: (8727963568087712425891397479476727340041450 rem: -79766443076872509863361) = 1! ! +!IntegerTest methodsFor: 'gcd and lcm' stamp: 'len 6/27/2019 10:25:17'! +testGCDExample + self assert: (120 gcd: 70) = 10! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! -testRemLpLp +!IntegerTest methodsFor: 'gcd and lcm' stamp: 'len 6/27/2019 10:38:26'! +testGCDProperties + | a b c | + a _ (-20 to: 20) atRandom. + b _ (-20 to: 20) atRandom. + c _ (-20 to: 20) atRandom. + self assert: a \\ (a gcd: b) = 0. "divides a" + self assert: b \\ (a gcd: b) = 0. "divides b" + self assert: (a gcd: b) = (a gcd: b) abs. "it is normalized to be >= 0" + self assert: (a gcd: b) = (b gcd: a). "commutative" + self assert: (a gcd: (b gcd: c)) = ((a gcd: b) gcd: c). "associative" + self assert: ((a gcd: 0) = a abs or: [a = 0]). + self assert: (0 gcd: 0) = 0. + self assert: (a + (b*c) gcd: b) = (a gcd: b). + self assert: (a*c gcd: b*c) = ((a gcd: b) * c abs)! ! - self assert: (42391158275216203514294433200 rem: 14130386091738734504764811067) = 14130386091738734504764811066. - self assert: (42391158275216203514294433201 rem: 14130386091738734504764811067) = 0. - self assert: (42391158275216203514294433202 rem: 14130386091738734504764811067) = 1. - self assert: (8727963568087712425891397479476727340041448 rem: 79766443076872509863361) = 79766443076872509863360. - self assert: (8727963568087712425891397479476727340041449 rem: 79766443076872509863361) = 0. - self assert: (8727963568087712425891397479476727340041450 rem: 79766443076872509863361) = 1! ! +!IntegerTest methodsFor: 'gcd and lcm' stamp: 'len 6/27/2019 10:50:25'! +testLCMExample + self assert: (120 lcm: 70) = 840! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:49'! -testRemLpSn +!IntegerTest methodsFor: 'gcd and lcm' stamp: 'len 6/27/2019 10:48:22'! +testLCMProperties + | a b c | + a _ (-10 to: 10) atRandom. + b _ (-10 to: 10) atRandom. + c _ (-10 to: 10) atRandom. + self assert: (a = 0 or: [(a lcm: b) \\ a = 0]). "a divides it" + self assert: (b = 0 or: [(a lcm: b) \\ b = 0]). "b divides it" + "is is the smallest positive integer divisible by both a and b:" + self deny: ((a ~= 0 and: [b ~= 0]) and: [(1 to: (a lcm: b) abs - 1) anySatisfy: [:any| any \\ a = 0 and: [any \\ b = 0]]]). + self assert: (a lcm: b) = (a lcm: b) abs. "it is normalized to be >= 0" + self assert: (a lcm: b) = (b lcm: a). "commutative" + self assert: (a lcm: (b lcm: c)) = ((a lcm: b) lcm: c). "associative" + self assert: (a lcm: 0) = 0. + self assert: (0 lcm: a) = 0. + self assert: (0 lcm: 0) = 0! ! - self assert: (42391158275216203514294433201 rem: -3) = 0. - self assert: (42391158275216203514294433202 rem: -3) = 1. - self assert: (42391158275216203514294433203 rem: -3) = 2. - self assert: (42391158275216203514294433204 rem: -3) = 0! ! +!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'jmv 8/21/2016 20:04:13'! +testCompactClassIndex + Smalltalk isSpur ifFalse: [ + self assert: LargeNegativeInteger indexIfCompact = 4 ]! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! -testRemLpSp +!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'ul 11/15/2010 11:51'! +testDenormalizedPrintString + "Check that an un-normalized instance behaves reasonably." - self assert: (42391158275216203514294433201 rem: 3) = 0. - self assert: (42391158275216203514294433202 rem: 3) = 1. - self assert: (42391158275216203514294433203 rem: 3) = 2. - self assert: (42391158275216203514294433204 rem: 3) = 0! ! + | i i0 | + i := LargeNegativeInteger new: 4. + i basicAt: 2 put: 255. + self assert: i size = 4. + self assert: i printString = '-65280'. "-256*255" + self assert: i normalize = -65280. + self assert: (i normalize isMemberOf: SmallInteger). + + i0 := LargeNegativeInteger new: 0. + self assert: i0 size = 0. + self assert: i0 printString = '-0'. + self assert: i0 normalize = 0. + self assert: (i0 normalize isMemberOf: SmallInteger)! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! -testRemSnLn +!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 21:40'! +testDigitAt - self assert: (0 rem: -42391158275216203514294433201) = 0. - self assert: (-1 rem: -42391158275216203514294433201) = -1. - self assert: (-14348907 rem: -42391158275216203514294433201) = -14348907! ! + | lni | + lni := -114605103402541699037609980192546360895434064385. + 1 to: 20 do: [:i | | digit | + digit := lni digitAt: i. + self assert: i equals: digit] +! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:47'! -testRemSnLp +!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 22:25'! +testDigitAtPut - self assert: (0 rem: 42391158275216203514294433201) = 0. - self assert: (-1 rem: 42391158275216203514294433201) = -1. - self assert: (-14348907 rem: 42391158275216203514294433201) = -14348907! ! + | lni | + lni := LargeNegativeInteger new: 20. + 1 to: 20 do: [:i | lni digitAt: i put: i]. + self assert: -114605103402541699037609980192546360895434064385equals: lni +! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! -testRemSnSn +!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 21:39'! +testDigitLength - self assert: (0 rem: -3) = 0. - self assert: (-1 rem: -3) = -1. - self assert: (-9 rem: -3) = 0. - self assert: (-10 rem: -3) = -1. - self assert: (-11 rem: -3) = -2. - self assert: (-12 rem: -3) = 0. - self assert: (-13 rem: -3) = -1! ! + | lni | + lni := -114605103402541699037609980192546360895434064385. + self assert: 20 equals: lni digitLength +! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:37'! -testRemSnSp +!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'ul 11/15/2010 11:52'! +testEmptyTemplate + "Check that an uninitialized instance behaves reasonably." - self assert: (0 rem: 3) = 0. - self assert: (-1 rem: 3) = -1. - self assert: (-9 rem: 3) = 0. - self assert: (-10 rem: 3) = -1. - self assert: (-11 rem: 3) = -2. - self assert: (-12 rem: 3) = 0. - self assert: (-13 rem: 3) = -1! ! + | i | + i := LargeNegativeInteger new: 4. + self assert: i size = 4. + self assert: i printString = '-0'. + self assert: i normalize = 0. + self assert: (i normalize isMemberOf: SmallInteger)! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:38'! -testRemSpLn +!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'nice 8/31/2012 23:00'! +testMinimumNegativeIntegerArithmetic + "We are speaking of minimum integer in underlying hardware here. + In 2-complement, abs(INT_MIN) = (INT-MAX+1) and thus overflows hardware register. + Since some old VM forgot this edge case they may fail and it's better to be aware of it. + http://code.google.com/p/cog/issues/detail?id=92 + http://bugs.squeak.org/view.php?id=7705 + We only test the cases of 32 and 64 bit signed integers." - self assert: (0 rem: -42391158275216203514294433201) = 0. - self assert: (1 rem: -42391158275216203514294433201) = 1. - self assert: (14348907 rem: -42391158275216203514294433201) = 14348907! ! + #(32 64) do: [:nBits | + | largePositiveInt largeNegativeInt | + largePositiveInt := (1 << (nBits - 1)). + largeNegativeInt := largePositiveInt negated. + self assert: (largeNegativeInt >> 3) equals: (largeNegativeInt bitInvert >> 3) bitInvert. + self assert: (largeNegativeInt + 1) equals: (largePositiveInt - 1) negated. + self assert: (largeNegativeInt - -1) equals: (largePositiveInt - 1) negated. + self assert: (largeNegativeInt // -1) equals: largePositiveInt. + self assert: (largeNegativeInt \\ -1) equals: 0. + self assert: (largeNegativeInt rem: -1) equals: 0. + self assert: (largeNegativeInt quo: -1) equals: largePositiveInt. + self assert: (largeNegativeInt * -1) equals: largePositiveInt. + self assert: (largeNegativeInt / -1) equals: largePositiveInt]! ! -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! -testRemSpLp +!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 22:26'! +testReplaceFromToWithStartingAt - self assert: (0 rem: 42391158275216203514294433201) = 0. - self assert: (1 rem: 42391158275216203514294433201) = 1. - self assert: (14348907 rem: 42391158275216203514294433201) = 14348907! ! - -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:48'! -testRemSpSn + | lni20 lni7 | + lni20 := LargeNegativeInteger new: 20. + 1 to: 20 do: [:i | lni20 digitAt: i put: i]. + lni7 := LargeNegativeInteger new: 7. + 1 to: 7 do: [:i | lni7 digitAt: i put: 11 - i]. + lni20 replaceFrom: 6 to: 10 with: lni7 startingAt: 2. + "unmodified digits" + (1 to: 5) , (11 to: 20) do: [:e | | digit | + digit := lni20 digitAt: e. + self assert: e equals: digit]. + "replaced digits" + 6 to: 10 do: [:e | | digit replacementDigit | + digit := lni20 digitAt: e. + replacementDigit := lni7 digitAt: e - 4. + self assert: replacementDigit equals: digit] +! ! - self assert: (0 rem: -3) = 0. - self assert: (1 rem: -3) = 1. - self assert: (9 rem: -3) = 0. - self assert: (10 rem: -3) = 1. - self assert: (11 rem: -3) = 2. - self assert: (12 rem: -3) = 0. - self assert: (13 rem: -3) = 1! ! +!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'jmv 9/1/2010 13:47'! +testBitShift -!IntegerTest methodsFor: 'tests - division - rem:' stamp: 'sqr 1/25/2014 14:35'! -testRemSpSp + "Check bitShift from and back to SmallInts" + + 1 to: 257 do: [:i | self should: [((i bitShift: i) bitShift: 0-i) = i]].! ! - self assert: (0 rem: 3) = 0. - self assert: (1 rem: 3) = 1. - self assert: (9 rem: 3) = 0. - self assert: (10 rem: 3) = 1. - self assert: (11 rem: 3) = 2. - self assert: (12 rem: 3) = 0. - self assert: (13 rem: 3) = 1! ! +!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'jmv 8/21/2016 20:04:20'! +testCompactClassIndex + Smalltalk isSpur ifFalse: [ + self assert: LargePositiveInteger indexIfCompact = 5 ]! ! -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:56'! -testSlashSlashLnLn +!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'ul 11/15/2010 11:52'! +testDenormalizedPrintString + "Check that an un-normalized instance behaves reasonably." - self assert: -42391158275216203514294433200 // -14130386091738734504764811067 = 2. - self assert: -42391158275216203514294433201 // -14130386091738734504764811067 = 3. - self assert: -42391158275216203514294433202 // -14130386091738734504764811067 = 3. - self assert: -8727963568087712425891397479476727340041448 // -79766443076872509863361 = 109418989131512359208. - self assert: -8727963568087712425891397479476727340041449 // -79766443076872509863361 = 109418989131512359209. - self assert: -8727963568087712425891397479476727340041450 // -79766443076872509863361 = 109418989131512359209! ! + | i i0 | + i := LargePositiveInteger new: 4. + i basicAt: 2 put: 255. + self assert: i size = 4. + self assert: i printString = '65280'. "256*255" + self assert: i normalize = 65280. + self assert: (i normalize isMemberOf: SmallInteger). + + i0 := LargePositiveInteger new: 0. + self assert: i0 size = 0. + self assert: i0 printString = '0'. + self assert: i0 normalize = 0. + self assert: (i0 normalize isMemberOf: SmallInteger)! ! -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:47'! -testSlashSlashLnLp +!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 21:40'! +testDigitAt - self assert: -42391158275216203514294433200 // 14130386091738734504764811067 = -3. - self assert: -42391158275216203514294433201 // 14130386091738734504764811067 = -3. - self assert: -42391158275216203514294433202 // 14130386091738734504764811067 = -4. - self assert: -8727963568087712425891397479476727340041448 // 79766443076872509863361 = -109418989131512359209. - self assert: -8727963568087712425891397479476727340041449 // 79766443076872509863361 = -109418989131512359209. - self assert: -8727963568087712425891397479476727340041450 // 79766443076872509863361 = -109418989131512359210! ! + | lpi | + lpi := 114605103402541699037609980192546360895434064385. + 1 to: 20 do: [:i | | digit | + digit := lpi digitAt: i. + self assert: i equals: digit] +! ! -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:54'! -testSlashSlashLnSn +!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 21:35'! +testDigitAtPut - self assert: -42391158275216203514294433201 // -3 = 14130386091738734504764811067. - self assert: -42391158275216203514294433202 // -3 = 14130386091738734504764811067. - self assert: -42391158275216203514294433203 // -3 = 14130386091738734504764811067. - self assert: -42391158275216203514294433204 // -3 = 14130386091738734504764811068! ! + | lpi | + lpi := LargePositiveInteger new: 20. + 1 to: 20 do: [:i | lpi digitAt: i put: i]. + self assert: 114605103402541699037609980192546360895434064385equals: lpi +! ! -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:45'! -testSlashSlashLnSp +!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 21:39'! +testDigitLength - self assert: -42391158275216203514294433201 // 3 = -14130386091738734504764811067. - self assert: -42391158275216203514294433202 // 3 = -14130386091738734504764811068. - self assert: -42391158275216203514294433203 // 3 = -14130386091738734504764811068. - self assert: -42391158275216203514294433204 // 3 = -14130386091738734504764811068! ! + | lpi | + lpi := 114605103402541699037609980192546360895434064385. + self assert: 20 equals: lpi digitLength +! ! -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:54'! -testSlashSlashLpLn +!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'ul 11/15/2010 11:52'! +testEmptyTemplate - self assert: 42391158275216203514294433200 // -14130386091738734504764811067 = -3. - self assert: 42391158275216203514294433201 // -14130386091738734504764811067 = -3. - self assert: 42391158275216203514294433202 // -14130386091738734504764811067 = -4. - self assert: 8727963568087712425891397479476727340041448 // -79766443076872509863361 = -109418989131512359209. - self assert: 8727963568087712425891397479476727340041449 // -79766443076872509863361 = -109418989131512359209. - self assert: 8727963568087712425891397479476727340041450 // -79766443076872509863361 = -109418989131512359210! ! + "Check that an uninitialized instance behaves reasonably." -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:52'! -testSlashSlashLpSn + | i | + i := LargePositiveInteger new: 4. + self assert: i size = 4. + self assert: i printString = '0'. + self assert: i normalize = 0. + self assert: (i normalize isMemberOf: SmallInteger)! ! - self assert: 42391158275216203514294433201 // -3 = -14130386091738734504764811067. - self assert: 42391158275216203514294433202 // -3 = -14130386091738734504764811068. - self assert: 42391158275216203514294433203 // -3 = -14130386091738734504764811068. - self assert: 42391158275216203514294433204 // -3 = -14130386091738734504764811068! ! +!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'nice 3/21/2014 18:38'! +testLargeSqrtFloor + "This test fails if a careless implementation naivly factors out the power of two (remove the trailing zeroes up to lowBit). + This was the case in a previous Squeak 4.x implementation." -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:52'! -testSlashSlashSnLn + | large root | + large := (SmallInteger maxVal << 100 + 1) << 100. + root := large sqrtFloor. + self assert: root squared <= large. + self assert: (root+1) squared > large.! ! - self assert: 0 // -42391158275216203514294433201 = 0. - self assert: -1 // -42391158275216203514294433201 = 0. - self assert: -14348907 // -42391158275216203514294433201 = 0! ! +!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'sd 6/5/2005 08:52'! +testMultDicAddSub + "self run: #testMultDicAddSub" -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:44'! -testSlashSlashSnLp + | n f f1 | + n := 100. + f := 100 factorial. + f1 := f*(n+1). + n timesRepeat: [f1 := f1 - f]. + self assert: (f1 = f). - self assert: 0 // 42391158275216203514294433201 = 0. - self assert: -1 // 42391158275216203514294433201 = -1. - self assert: -14348907 // 42391158275216203514294433201 = -1! ! + n timesRepeat: [f1 := f1 + f]. + self assert: (f1 // f = (n+1)). + self assert: (f1 negated = (Number readFrom: '-' , f1 printString)).! ! -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:51'! -testSlashSlashSnSn +!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'jmv 9/1/2010 13:48'! +testNormalize + "self run: #testNormalize" + "Check normalization and conversion to/from SmallInts" - self assert: 0 // -3 = 0. - self assert: -1 // -3 = 0. - self assert: -9 // -3 = 3. - self assert: -10 // -3 = 3. - self assert: -11 // -3 = 3. - self assert: -12 // -3 = 4. - self assert: -13 // -3 = 4! ! + self assert: ((SmallInteger maxVal + 1 - 1) = SmallInteger maxVal). + self assert: (SmallInteger maxVal + 3 - 6) = (SmallInteger maxVal-3). + self should: ((SmallInteger minVal - 1 + 1) = SmallInteger minVal). + self assert: (SmallInteger minVal - 3 + 6) = (SmallInteger minVal+3).! ! -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:42'! -testSlashSlashSnSp +!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 21:59'! +testReplaceFromToWithStartingAt - self assert: 0 // 3 = 0. - self assert: -1 // 3 = -1. - self assert: -9 // 3 = -3. - self assert: -10 // 3 = -4. - self assert: -11 // 3 = -4. - self assert: -12 // 3 = -4. - self assert: -13 // 3 = -5! ! + | lpi20 lpi7 | + lpi20 := LargePositiveInteger new: 20. + 1 to: 20 do: [:i | lpi20 digitAt: i put: i]. + lpi7 := LargePositiveInteger new: 7. + 1 to: 7 do: [:i | lpi7 digitAt: i put: 11 - i]. + lpi20 replaceFrom: 6 to: 10 with: lpi7 startingAt: 2. + "unmodified digits" + (1 to: 5) , (11 to: 20) do: [:e | | digit | + digit := lpi20 digitAt: e. + self assert: e equals: digit]. + "replaced digits" + 6 to: 10 do: [:e | | digit replacementDigit | + digit := lpi20 digitAt: e. + replacementDigit := lpi7 digitAt: e - 4. + self assert: replacementDigit equals: digit] +! ! -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:51'! -testSlashSlashSpLn +!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/26/2009 21:57'! +testFractionPart - self assert: 0 // -42391158275216203514294433201 = 0. - self assert: 1 // -42391158275216203514294433201 = -1. - self assert: 14348907 // -42391158275216203514294433201 = -1! ! + self + assert: 2 fractionPart = 0; + assert: (1/2) fractionPart = (1/2); + assert: (4/3) fractionPart = (1/3); + assert: 2.0 fractionPart = 0.0; + assert: 0.5 fractionPart = 0.5; + assert: 2.5 fractionPart = 0.5 +! ! -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:44'! -testSlashSlashSpLp +!NumberTest methodsFor: 'tests' stamp: 'jmv 11/21/2018 17:38:59'! +testHash1 + "Hash should be the same for equivalent instances of various Number classes" - self assert: 0 // 42391158275216203514294433201 = 0. - self assert: 1 // 42391158275216203514294433201 = 0. - self assert: 14348907 // 42391158275216203514294433201 = 0! ! + | boxedFloat float hash largeInteger smallInteger | + largeInteger := (LargePositiveInteger new: 4) + digitAt: 1 put: 1; + digitAt: 2 put: 2; + digitAt: 3 put: 3; + digitAt: 4 put: 4; + yourself. + smallInteger := largeInteger normalize. + float := smallInteger asFloat. + boxedFloat := BoxedFloat64 new + basicAt: 1 put: (float basicAt: 1); + basicAt: 2 put: (float basicAt: 2); yourself. + + hash := largeInteger hash. + self assert: smallInteger hash = hash. + self assert: float hash = hash. + self assert: boxedFloat hash = hash! ! -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:50'! -testSlashSlashSpSn +!NumberTest methodsFor: 'tests' stamp: 'jmv 11/21/2018 17:39:36'! +testHash2 + "Hash should be the same for equivalent instances of various Number classes" - self assert: 0 // -3 = 0. - self assert: 1 // -3 = -1. - self assert: 9 // -3 = -3. - self assert: 10 // -3 = -4. - self assert: 11 // -3 = -4. - self assert: 12 // -3 = -4. - self assert: 13 // -3 = -5! ! + | boxedFloat float hash largeInteger smallIntIn64ButLargeIntIn32Bits | + largeInteger := (LargePositiveInteger new: 4) + digitAt: 1 put: 0; + digitAt: 2 put: 0; + digitAt: 3 put: 0; + digitAt: 4 put: 64; + yourself. + smallIntIn64ButLargeIntIn32Bits := largeInteger normalize. + float := smallIntIn64ButLargeIntIn32Bits asFloat. + boxedFloat := BoxedFloat64 new + basicAt: 1 put: (float basicAt: 1); + basicAt: 2 put: (float basicAt: 2); yourself. + + hash := largeInteger hash. + self assert: smallIntIn64ButLargeIntIn32Bits hash = hash. + self assert: float hash = hash. + self assert: boxedFloat hash = hash! ! -!IntegerTest methodsFor: 'tests - division - //' stamp: 'sqr 1/25/2014 13:42'! -testSlashSlashSpSp +!NumberTest methodsFor: 'tests' stamp: 'jmv 11/21/2018 17:39:51'! +testHash3 + "Hash should be the same for equivalent instances of various Number classes" - self assert: 0 // 3 = 0. - self assert: 1 // 3 = 0. - self assert: 9 // 3 = 3. - self assert: 10 // 3 = 3. - self assert: 11 // 3 = 3. - self assert: 12 // 3 = 4. - self assert: 13 // 3 = 4! ! + | boxedFloat float hash largeInteger smallIntIn64ButLargeIntIn32Bits | + largeInteger := (LargePositiveInteger new: 4) + digitAt: 1 put: 1; + digitAt: 2 put: 2; + digitAt: 3 put: 3; + digitAt: 4 put: 80; + yourself. + smallIntIn64ButLargeIntIn32Bits := largeInteger normalize. + float := smallIntIn64ButLargeIntIn32Bits asFloat. + boxedFloat := BoxedFloat64 new + basicAt: 1 put: (float basicAt: 1); + basicAt: 2 put: (float basicAt: 2); yourself. + + hash := largeInteger hash. + self assert: smallIntIn64ButLargeIntIn32Bits hash = hash. + self assert: float hash = hash. + self assert: boxedFloat hash = hash! ! -!IntegerTest methodsFor: 'tests - division' stamp: 'sqr 1/25/2014 13:38'! -testSlashSlashLpLp +!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/26/2009 21:55'! +testIntegerPart - self assert: 42391158275216203514294433200 // 14130386091738734504764811067 = 2. - self assert: 42391158275216203514294433201 // 14130386091738734504764811067 = 3. - self assert: 42391158275216203514294433202 // 14130386091738734504764811067 = 3. - self assert: 8727963568087712425891397479476727340041448 // 79766443076872509863361 = 109418989131512359208. - self assert: 8727963568087712425891397479476727340041449 // 79766443076872509863361 = 109418989131512359209. - self assert: 8727963568087712425891397479476727340041450 // 79766443076872509863361 = 109418989131512359209! ! + self + assert: 2 integerPart = 2; + assert: (1/2) integerPart = 0; + assert: (4/3) integerPart = 1; + assert: 2.0 integerPart = 2.0; + assert: 0.5 integerPart = 0.0; + assert: 2.5 integerPart = 2.0 +! ! -!IntegerTest methodsFor: 'tests - division' stamp: 'sqr 1/25/2014 13:33'! -testSlashSlashLpSp +!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/23/2009 20:49'! +testOne - self assert: 42391158275216203514294433201 // 3 = 14130386091738734504764811067. - self assert: 42391158275216203514294433202 // 3 = 14130386091738734504764811067. - self assert: 42391158275216203514294433203 // 3 = 14130386091738734504764811067. - self assert: 42391158275216203514294433204 // 3 = 14130386091738734504764811068! ! + self + assert: Integer one = 1; + assert: Float one = 1.0; + assert: Fraction one = 1! ! -!IntegerTest methodsFor: 'as yet unclassified' stamp: 'jmv 9/10/2018 10:28:17'! -test01readFromWithEmptyStringRaisesAnError - |input| - - input := ReadStream on: ''. +!NumberTest methodsFor: 'tests' stamp: 'jmv 1/9/2014 21:23'! +testPrintShowingDecimalPlaces - self should: [ Integer readFrom: input ] raise: Error description: 'At least one digit expected here'! ! + self assert: (String streamContents: [ :s | 111.2 printOn: s fractionDigits: 2]) = '111.20'. + self assert: (String streamContents: [ :s | 111.2 printOn: s fractionDigits: 0]) = '111'. + self assert: (String streamContents: [ :s | 111 printOn: s fractionDigits: 0]) = '111'. + self assert: (String streamContents: [ :s | 111111111111111 printOn: s fractionDigits: 2]) = '111111111111111.00'. + self assert: (String streamContents: [ :s | 10 printOn: s fractionDigits: 20]) ='10.00000000000000000000'. + self assert: (String streamContents: [ :s | 0.98 printOn: s fractionDigits: 2]) = '0.98'. + self assert: (String streamContents: [ :s | -0.98 printOn: s fractionDigits: 2]) = '-0.98'. + self assert: (String streamContents: [ :s | 2.567 printOn: s fractionDigits: 2]) = '2.57'. + self assert: (String streamContents: [ :s | -2.567 printOn: s fractionDigits: 2]) = '-2.57'! ! -!IntegerTest methodsFor: 'as yet unclassified' stamp: 'jmv 9/10/2018 10:28:20'! -test02readFromWithInvalidStringRaisesAnError - | input | - - input := ReadStream on: 'hello'. +!NumberTest methodsFor: 'tests' stamp: 'jmv 12/21/2018 12:00:50'! +testPrintShowingDecimalPlaces2 + "This tests problems related to Float>>rounded and Float>>roundTo:: + - Float>>#rounded is inexact + - Float>>#roundTo: might overflow" - self should: [ Integer readFrom: input ] raise: Error description: 'At least one digit expected here'! ! + "This number is represented exactly asFloat, it should print exactly" + self assert: 5000000000000001.0 asTrueFraction = 5000000000000001. + self assert: 5000000000000001 highBit = 53. + self assert: (5000000000000001.0 printStringFractionDigits: 0) = '5000000000000001'. + + "50000000000001.25 asTrueFraction = (200000000000005/4). + 200000000000005 highBit = 48, 4 isPowerOfTwo, + So this number is also represented exactly as Float, it should print exactly. + Beware: (50000000000001.25 / 0.01) rounded exhibit the same problem as above." + self assert: (String streamContents: [ :s | 50000000000001.25 printOn: s fractionDigits: 2]) = '50000000000001.25'. -!IntegerTest methodsFor: 'gcd and lcm' stamp: 'len 6/27/2019 10:23:39'! -testGCDAndLCM - | a b c | - a _ (-20 to: 20) atRandom. - b _ (-20 to: 20) atRandom. - c _ (-20 to: 20) atRandom. - self assert: (a gcd: b) * (a lcm: b) = (a*b) abs. - self assert: (a gcd: (b lcm: c)) = ((a gcd: b) lcm: (a gcd: c)). - self assert: (a lcm: (b gcd: c)) = ((a lcm: b) gcd: (a lcm: c))! ! + "Since 4 isPowerOfTwo, this number is also represented exactly as Float, it should print exactly" + self assert: 50000000000001.25 asTrueFraction = (200000000000005/4). + self assert: 200000000000005 highBit = 48. + self assert: (50000000000001.25 printStringFractionDigits: 2) = '50000000000001.25'. + + "This number is close to fmax" + self shouldnt: [String streamContents: [ :s | 1.0e306 printOn: s fractionDigits: 3]] raise: Error.! ! -!IntegerTest methodsFor: 'gcd and lcm' stamp: 'len 6/27/2019 10:25:17'! -testGCDExample - self assert: (120 gcd: 70) = 10! ! +!NumberTest methodsFor: 'tests' stamp: 'jmv 1/9/2014 21:22'! +testPrintShowingDecimalPlaces3 + "This problem were reported at http://bugs.squeak.org/view.php?id=7028 + unfortunate inversion of left / right padding" + self assert: (String streamContents: [ :s | 1.009 printOn: s fractionDigits: 3]) = '1.009'. + self assert: (String streamContents: [ :s | 35.900 printOn: s fractionDigits: 3]) = '35.900'. + self assert: (String streamContents: [ :s | -0.097 printOn: s fractionDigits: 3]) = '-0.097'.! ! -!IntegerTest methodsFor: 'gcd and lcm' stamp: 'len 6/27/2019 10:38:26'! -testGCDProperties - | a b c | - a _ (-20 to: 20) atRandom. - b _ (-20 to: 20) atRandom. - c _ (-20 to: 20) atRandom. - self assert: a \\ (a gcd: b) = 0. "divides a" - self assert: b \\ (a gcd: b) = 0. "divides b" - self assert: (a gcd: b) = (a gcd: b) abs. "it is normalized to be >= 0" - self assert: (a gcd: b) = (b gcd: a). "commutative" - self assert: (a gcd: (b gcd: c)) = ((a gcd: b) gcd: c). "associative" - self assert: ((a gcd: 0) = a abs or: [a = 0]). - self assert: (0 gcd: 0) = 0. - self assert: (a + (b*c) gcd: b) = (a gcd: b). - self assert: (a*c gcd: b*c) = ((a gcd: b) * c abs)! ! +!NumberTest methodsFor: 'tests' stamp: 'nice 12/6/2007 21:24'! +testRaisedTo + "this is a test related to http://bugs.squeak.org/view.php?id=6781" + + self should: [0 raisedTo: -1] raise: ZeroDivide. + self should: [0 raisedTo: -1.0] raise: ZeroDivide.! ! -!IntegerTest methodsFor: 'gcd and lcm' stamp: 'len 6/27/2019 10:50:25'! -testLCMExample - self assert: (120 lcm: 70) = 840! ! +!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/25/2009 16:41'! +testRaisedToInteger -!IntegerTest methodsFor: 'gcd and lcm' stamp: 'len 6/27/2019 10:48:22'! -testLCMProperties - | a b c | - a _ (-10 to: 10) atRandom. - b _ (-10 to: 10) atRandom. - c _ (-10 to: 10) atRandom. - self assert: (a = 0 or: [(a lcm: b) \\ a = 0]). "a divides it" - self assert: (b = 0 or: [(a lcm: b) \\ b = 0]). "b divides it" - "is is the smallest positive integer divisible by both a and b:" - self deny: ((a ~= 0 and: [b ~= 0]) and: [(1 to: (a lcm: b) abs - 1) anySatisfy: [:any| any \\ a = 0 and: [any \\ b = 0]]]). - self assert: (a lcm: b) = (a lcm: b) abs. "it is normalized to be >= 0" - self assert: (a lcm: b) = (b lcm: a). "commutative" - self assert: (a lcm: (b lcm: c)) = ((a lcm: b) lcm: c). "associative" - self assert: (a lcm: 0) = 0. - self assert: (0 lcm: a) = 0. - self assert: (0 lcm: 0) = 0! ! + self + assert: (2 raisedToInteger: 0) = 1; + assert: (2 raisedToInteger: 1) = 2; + assert: (2 raisedToInteger: 4) = 16; + assert: (0 raisedToInteger: 0) = 1; + assert: (0 raisedToInteger: 2) = 0; + assert: (2 raisedToInteger: -1) = (1/2); + assert: (2 raisedToInteger: -4) = (1/16). + + self + assert: (-3 raisedTo: 0) = 1; + assert: (-3 raisedTo: 1) = -3; + assert: (-3 raisedTo: 2) = 9; + assert: (-3 raisedTo: 3) = -27; + assert: (-3 raisedTo: -2) = (1/9); + assert: (-3 raisedTo: -3) = (-1/27). + + self should: [ 0 raisedTo: -1 ] raise: ZeroDivide! ! -!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'jmv 8/21/2016 20:04:13'! -testCompactClassIndex - Smalltalk isSpur ifFalse: [ - self assert: LargeNegativeInteger indexIfCompact = 4 ]! ! +!NumberTest methodsFor: 'tests' stamp: 'jmv 4/5/2019 17:38:36'! +testRaisedToIntegerWithFloats -!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'ul 11/15/2010 11:51'! -testDenormalizedPrintString - "Check that an un-normalized instance behaves reasonably." + self + assert: (2.0 raisedToInteger: 0) = 1.0; + assert: (2.0 raisedToInteger: 1) = 2.0; + assert: (2.0 raisedToInteger: 4) = 16.0; + assert: (0.0 raisedToInteger: 0) = 1.0; + assert: (0.0 raisedToInteger: 2) = 0.0; + assert: (2.0 raisedToInteger: -1) = 0.5; + assert: (2.0 raisedToInteger: -4) = 0.0625; + assert: (Float e raisedToInteger: -746) = 0.0; + assert: (Float e raisedToInteger: -745) = 0.0 successor; + assert: (Float e raisedToInteger: -744) = 0.0 successor successor. + self + assert: (-3.0 raisedToInteger: 0) = 1.0; + assert: (-3.0 raisedToInteger: 1) = -3.0; + assert: (-3.0 raisedToInteger: 2) = 9.0; + assert: (-3.0 raisedToInteger: 3) = -27.0; + assert: (-2.0 raisedToInteger: -2) = 0.25; + assert: (-2.0 raisedToInteger: -3) = -0.125; + assert: (Float e negated raisedToInteger: -746) = 0.0; + assert: (Float e negated raisedToInteger: -745) = -0.0 predecessor; + assert: (Float e negated raisedToInteger: -744) = 0.0 successor successor. + + self should: [ 0.0 raisedToInteger: -1 ] raise: ZeroDivide! ! - | i i0 | - i := LargeNegativeInteger new: 4. - i basicAt: 2 put: 255. - self assert: i size = 4. - self assert: i printString = '-65280'. "-256*255" - self assert: i normalize = -65280. - self assert: (i normalize isMemberOf: SmallInteger). +!NumberTest methodsFor: 'tests' stamp: 'sd 6/5/2005 08:56'! +testReadFrom - i0 := LargeNegativeInteger new: 0. - self assert: i0 size = 0. - self assert: i0 printString = '-0'. - self assert: i0 normalize = 0. - self assert: (i0 normalize isMemberOf: SmallInteger)! ! + self assert: 1.0e-14 = (Number readFrom: '1.0e-14'). + self assert: 2r1e26 = (Number readFrom: '2r1e26').! ! -!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 21:40'! -testDigitAt +!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/23/2009 19:26'! +testReciprocal - | lni | - lni := -114605103402541699037609980192546360895434064385. - 1 to: 20 do: [:i | | digit | - digit := lni digitAt: i. - self assert: i equals: digit] -! ! - -!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 22:25'! -testDigitAtPut - - | lni | - lni := LargeNegativeInteger new: 20. - 1 to: 20 do: [:i | lni digitAt: i put: i]. - self assert: -114605103402541699037609980192546360895434064385equals: lni -! ! + self + assert: 1 reciprocal = 1; + assert: 2 reciprocal = (1/2); + assert: -1 reciprocal = -1; + assert: -3 reciprocal = (-1/3). + + self should: [ 0 reciprocal ] raise: ZeroDivide! ! -!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 21:39'! -testDigitLength +!NumberTest methodsFor: 'tests' stamp: 'sqr 6/26/2019 09:46:32'! +testZeroDivideHandler + "Test for user-defined ZeroDivide behavior" - | lni | - lni := -114605103402541699037609980192546360895434064385. - self assert: 20 equals: lni digitLength + [ + self assert: 1 / 0 = Float infinity. + self assert: -1 / 0 = Float negativeInfinity. + self assert: 1.0 / 0 = Float infinity. + self assert: -1.0 / 0 = Float negativeInfinity. + self assert: 1 / 0.0 = Float infinity. + self assert: -1 / 0.0 = Float negativeInfinity. + self assert: 1.0 / 0.0 = Float infinity. + self assert: -1.0 / 0.0 = Float negativeInfinity. + ] on: ZeroDivide + do: [:ex | ex resume: ex receiver sign * Float infinity ] ! ! -!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'ul 11/15/2010 11:52'! -testEmptyTemplate - "Check that an uninitialized instance behaves reasonably." +!NumberTest methodsFor: 'test' stamp: 'GC 9/8/2018 14:51:43'! +test01readFromWhenTheInitilValueIsNaNTheResultIsNaN - | i | - i := LargeNegativeInteger new: 4. - self assert: i size = 4. - self assert: i printString = '-0'. - self assert: i normalize = 0. - self assert: (i normalize isMemberOf: SmallInteger)! ! + |initialValue nan result | + + nan := Float nan. + initialValue := 'NaN'. + result := self subject: initialValue. + + self assert: result is: nan! ! -!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'nice 8/31/2012 23:00'! -testMinimumNegativeIntegerArithmetic - "We are speaking of minimum integer in underlying hardware here. - In 2-complement, abs(INT_MIN) = (INT-MAX+1) and thus overflows hardware register. - Since some old VM forgot this edge case they may fail and it's better to be aware of it. - http://code.google.com/p/cog/issues/detail?id=92 - http://bugs.squeak.org/view.php?id=7705 - We only test the cases of 32 and 64 bit signed integers." +!NumberTest methodsFor: 'test' stamp: 'GC 9/8/2018 15:07:25'! +test02readFromWhenTheInitilValueIsInfinityTheResultIsInfinity + + self assertThat: 'Infinity' isEqualTo: Float infinity! ! - #(32 64) do: [:nBits | - | largePositiveInt largeNegativeInt | - largePositiveInt := (1 << (nBits - 1)). - largeNegativeInt := largePositiveInt negated. - self assert: (largeNegativeInt >> 3) equals: (largeNegativeInt bitInvert >> 3) bitInvert. - self assert: (largeNegativeInt + 1) equals: (largePositiveInt - 1) negated. - self assert: (largeNegativeInt - -1) equals: (largePositiveInt - 1) negated. - self assert: (largeNegativeInt // -1) equals: largePositiveInt. - self assert: (largeNegativeInt \\ -1) equals: 0. - self assert: (largeNegativeInt rem: -1) equals: 0. - self assert: (largeNegativeInt quo: -1) equals: largePositiveInt. - self assert: (largeNegativeInt * -1) equals: largePositiveInt. - self assert: (largeNegativeInt / -1) equals: largePositiveInt]! ! +!NumberTest methodsFor: 'test' stamp: 'GC 9/8/2018 15:07:50'! +test03readFromWhenTheInitilValueIsMinusInfinityTheResultIsNegativeInfinity -!LargeNegativeIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 22:26'! -testReplaceFromToWithStartingAt + self assertThat: '-Infinity' isEqualTo: Float negativeInfinity! ! - | lni20 lni7 | - lni20 := LargeNegativeInteger new: 20. - 1 to: 20 do: [:i | lni20 digitAt: i put: i]. - lni7 := LargeNegativeInteger new: 7. - 1 to: 7 do: [:i | lni7 digitAt: i put: 11 - i]. - lni20 replaceFrom: 6 to: 10 with: lni7 startingAt: 2. - "unmodified digits" - (1 to: 5) , (11 to: 20) do: [:e | | digit | - digit := lni20 digitAt: e. - self assert: e equals: digit]. - "replaced digits" - 6 to: 10 do: [:e | | digit replacementDigit | - digit := lni20 digitAt: e. - replacementDigit := lni7 digitAt: e - 4. - self assert: replacementDigit equals: digit] -! ! +!NumberTest methodsFor: 'test' stamp: 'GC 9/8/2018 15:08:34'! +test04readFromWhenTheInitilValueIsANegativeNumberTheResultIsThatNumberNegated + + self assertThat: '-3' isEqualTo: -3! ! -!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'jmv 9/1/2010 13:47'! -testBitShift +!NumberTest methodsFor: 'test' stamp: 'GC 9/8/2018 15:09:00'! +test05readFromWhenTheInitilValueIsJustANumberTheResultIsThatNumber + + self assertThat: '3' isEqualTo: 3! ! - "Check bitShift from and back to SmallInts" +!NumberTest methodsFor: 'test' stamp: 'GC 9/9/2018 16:32:38'! +test06readFromWhenTheInitialValueIncludesRadixItIsConvertedWithTheIndicatedRadixBase + |radixBase number initualNumber | - 1 to: 257 do: [:i | self should: [((i bitShift: i) bitShift: 0-i) = i]].! ! + radixBase := '2r'. + number := '11110'. + + initualNumber := radixBase, number. + + self assert: initualNumber asNumber equals: 30! ! -!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'jmv 8/21/2016 20:04:20'! -testCompactClassIndex - Smalltalk isSpur ifFalse: [ - self assert: LargePositiveInteger indexIfCompact = 5 ]! ! +!NumberTest methodsFor: 'test' stamp: 'jmv 9/10/2018 10:28:22'! +test07readFromWhenTheInitialValueIncludesAnInvalidRadixItRaisesAnError + |radixBase number initualNumber | + + radixBase := '0r'. + number := '11110'. + + initualNumber := radixBase, number. + + + self should: [ initualNumber asNumber ] raise: Error description: 'Invalid radix'! ! -!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'ul 11/15/2010 11:52'! -testDenormalizedPrintString - "Check that an un-normalized instance behaves reasonably." +!NumberTest methodsFor: 'test' stamp: 'GC 9/9/2018 16:32:50'! +test08readFromWhenTheInitialValueIncludesANegativeRadixItConvertsTheNumberWithTheIndicatedRadixBase + |radixBase number initualNumber | + + radixBase := '-2r'. + number := '11110'. + + initualNumber := radixBase, number. + + self assert: initualNumber asNumber equals: -30! ! - | i i0 | - i := LargePositiveInteger new: 4. - i basicAt: 2 put: 255. - self assert: i size = 4. - self assert: i printString = '65280'. "256*255" - self assert: i normalize = 65280. - self assert: (i normalize isMemberOf: SmallInteger). +!NumberTest methodsFor: 'test' stamp: 'jmv 9/10/2018 10:28:25'! +test09readFromWhenTheInitialValueIsEmptyItRaisesAnError - i0 := LargePositiveInteger new: 0. - self assert: i0 size = 0. - self assert: i0 printString = '0'. - self assert: i0 normalize = 0. - self assert: (i0 normalize isMemberOf: SmallInteger)! ! + self should: [ Number readFrom: '' ] raise: Error description: 'At least one digit expected here'! ! -!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 21:40'! -testDigitAt +!NumberTest methodsFor: 'support' stamp: 'GC 9/8/2018 14:45:07'! +assert: expected is: actual + ^ self + assert: (expected == actual) + description: (self comparingStringBetween: expected and: actual)! ! - | lpi | - lpi := 114605103402541699037609980192546360895434064385. - 1 to: 20 do: [:i | | digit | - digit := lpi digitAt: i. - self assert: i equals: digit] -! ! +!NumberTest methodsFor: 'support' stamp: 'GC 9/8/2018 15:06:11'! +assertThat: aNumber isEqualTo: anExpectedNumber -!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 21:35'! -testDigitAtPut + | result | + result := self subject: aNumber. + + self assert: result equals: anExpectedNumber! ! - | lpi | - lpi := LargePositiveInteger new: 20. - 1 to: 20 do: [:i | lpi digitAt: i put: i]. - self assert: 114605103402541699037609980192546360895434064385equals: lpi -! ! +!NumberTest methodsFor: 'support' stamp: 'GC 9/8/2018 14:48:11'! +subject: aString -!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 21:39'! -testDigitLength + | aStream | + aStream := ReadStream on: aString. - | lpi | - lpi := 114605103402541699037609980192546360895434064385. - self assert: 20 equals: lpi digitLength -! ! + ^ Number readFrom: aStream! ! -!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'ul 11/15/2010 11:52'! -testEmptyTemplate +!SmallIntegerTest methodsFor: 'testing - Class Methods' stamp: 'sd 6/5/2005 08:59'! +testBasicNew - "Check that an uninitialized instance behaves reasonably." + self should: [SmallInteger basicNew] raise: TestResult error. ! ! - | i | - i := LargePositiveInteger new: 4. - self assert: i size = 4. - self assert: i printString = '0'. - self assert: i normalize = 0. - self assert: (i normalize isMemberOf: SmallInteger)! ! +!SmallIntegerTest methodsFor: 'testing - Class Methods' stamp: 'jmv 1/4/2017 08:16:27'! +testMaxVal -!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'nice 3/21/2014 18:38'! -testLargeSqrtFloor - "This test fails if a careless implementation naivly factors out the power of two (remove the trailing zeroes up to lowBit). - This was the case in a previous Squeak 4.x implementation." + Smalltalk wordSize = 4 + ifTrue: [ + self assert: (SmallInteger maxVal = 16r3FFFFFFF) ] + ifFalse: [ + self assert: (SmallInteger maxVal = 16rFFFFFFFFFFFFFFF) ]! ! - | large root | - large := (SmallInteger maxVal << 100 + 1) << 100. - root := large sqrtFloor. - self assert: root squared <= large. - self assert: (root+1) squared > large.! ! +!SmallIntegerTest methodsFor: 'testing - Class Methods' stamp: 'jmv 1/4/2017 08:17:27'! +testMinVal -!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'sd 6/5/2005 08:52'! -testMultDicAddSub - "self run: #testMultDicAddSub" + Smalltalk wordSize = 4 + ifTrue: [ + self assert: (SmallInteger minVal = -16r40000000) ] + ifFalse: [ + self assert: (SmallInteger minVal = -16r1000000000000000) ]! ! - | n f f1 | - n := 100. - f := 100 factorial. - f1 := f*(n+1). - n timesRepeat: [f1 := f1 - f]. - self assert: (f1 = f). +!SmallIntegerTest methodsFor: 'testing - Class Methods' stamp: 'sd 6/5/2005 08:59'! +testNew - n timesRepeat: [f1 := f1 + f]. - self assert: (f1 // f = (n+1)). - self assert: (f1 negated = (Number readFrom: '-' , f1 printString)).! ! + self should: [SmallInteger new] raise: TestResult error. ! ! -!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'jmv 9/1/2010 13:48'! -testNormalize - "self run: #testNormalize" - "Check normalization and conversion to/from SmallInts" +!SmallIntegerTest methodsFor: 'testing - arithmetic' stamp: 'sd 6/5/2005 08:59'! +testDivide - self assert: ((SmallInteger maxVal + 1 - 1) = SmallInteger maxVal). - self assert: (SmallInteger maxVal + 3 - 6) = (SmallInteger maxVal-3). - self should: ((SmallInteger minVal - 1 + 1) = SmallInteger minVal). - self assert: (SmallInteger minVal - 3 + 6) = (SmallInteger minVal+3).! ! + self assert: 2 / 1 = 2. + self assert: (3 / 2) isFraction. + self assert: 4 / 2 = 2. + self should: [ 1 / 0 ] raise: ZeroDivide.! ! -!LargePositiveIntegerTest methodsFor: 'tests' stamp: 'dtl 7/22/2014 21:59'! -testReplaceFromToWithStartingAt +!SmallIntegerTest methodsFor: 'testing - basic' stamp: 'jmv 5/7/2012 21:35'! +testEven + + self assert: (SmallInteger minVal even). + self deny: (SmallInteger maxVal even). + + self deny: ((SmallInteger minVal + 1) even). + self assert: ((SmallInteger maxVal - 1) even). + + self deny: (1 even). + self deny: (-1 even). + + self assert: (2 even). + self assert: (-2 even). + + self assert: (0 even)! ! - | lpi20 lpi7 | - lpi20 := LargePositiveInteger new: 20. - 1 to: 20 do: [:i | lpi20 digitAt: i put: i]. - lpi7 := LargePositiveInteger new: 7. - 1 to: 7 do: [:i | lpi7 digitAt: i put: 11 - i]. - lpi20 replaceFrom: 6 to: 10 with: lpi7 startingAt: 2. - "unmodified digits" - (1 to: 5) , (11 to: 20) do: [:e | | digit | - digit := lpi20 digitAt: e. - self assert: e equals: digit]. - "replaced digits" - 6 to: 10 do: [:e | | digit replacementDigit | - digit := lpi20 digitAt: e. - replacementDigit := lpi7 digitAt: e - 4. - self assert: replacementDigit equals: digit] -! ! +!SmallIntegerTest methodsFor: 'testing - basic' stamp: 'jmv 5/7/2012 21:35'! +testOdd + + self deny: (SmallInteger minVal odd). + self assert: (SmallInteger maxVal odd). + + self assert: ((SmallInteger minVal + 1) odd). + self deny: ((SmallInteger maxVal - 1) odd). + + self assert: (1 odd). + self assert: (-1 odd). + + self deny: (2 odd). + self deny: (-2 odd). + + self deny: (0 odd)! ! -!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/26/2009 21:57'! -testFractionPart +!SmallIntegerTest methodsFor: 'testing - printing' stamp: 'jmv 1/9/2014 23:41'! +testPrintPaddedWith - self - assert: 2 fractionPart = 0; - assert: (1/2) fractionPart = (1/2); - assert: (4/3) fractionPart = (1/3); - assert: 2.0 fractionPart = 0.0; - assert: 0.5 fractionPart = 0.5; - assert: 2.5 fractionPart = 0.5 -! ! + self assert: (123 printStringBase: 2 length: 10 padded: true) = '0001111011'. + self assert: (123 printStringBase: 8 length: 10 padded: true) = '0000000173'. + self assert: (123 printStringBase: 10 length: 10 padded: true) = '0000000123'. + self assert: (123 printStringBase: 16 length: 10 padded: true) = '000000007B'! ! -!NumberTest methodsFor: 'tests' stamp: 'jmv 11/21/2018 17:38:59'! -testHash1 - "Hash should be the same for equivalent instances of various Number classes" +!SmallIntegerTest methodsFor: 'testing - printing' stamp: 'jmv 1/4/2017 08:22:13'! +testPrintString + self assert: 1 printString = '1'. + self assert: -1 printString = '-1'. + Smalltalk wordSize = 4 + ifTrue: [ + self assert: SmallInteger minVal printString = '-1073741824'. + self assert: SmallInteger maxVal printString = '1073741823' ] + ifFalse: [ + self assert: SmallInteger minVal printString = '-1152921504606846976' . + self assert: SmallInteger maxVal printString = '1152921504606846975' ]. + self assert: 12345 printString = '12345'. + self assert: -54321 printString = '-54321'. - | boxedFloat float hash largeInteger smallInteger | - largeInteger := (LargePositiveInteger new: 4) - digitAt: 1 put: 1; - digitAt: 2 put: 2; - digitAt: 3 put: 3; - digitAt: 4 put: 4; - yourself. - smallInteger := largeInteger normalize. - float := smallInteger asFloat. - boxedFloat := BoxedFloat64 new - basicAt: 1 put: (float basicAt: 1); - basicAt: 2 put: (float basicAt: 2); yourself. - - hash := largeInteger hash. - self assert: smallInteger hash = hash. - self assert: float hash = hash. - self assert: boxedFloat hash = hash! ! + self assert: 0 decimalDigitLength = 1. + self assert: 4 decimalDigitLength = 1. + self assert: 12 decimalDigitLength = 2. + self assert: 123 decimalDigitLength = 3. + self assert: 1234 decimalDigitLength = 4. + self assert: 56789 decimalDigitLength = 5. + self assert: 657483 decimalDigitLength = 6. + self assert: 6571483 decimalDigitLength = 7. + self assert: 65174383 decimalDigitLength = 8. + self assert: 625744831 decimalDigitLength = 9. + self assert: 1000001111 decimalDigitLength = 10. + Smalltalk wordSize = 4 + ifTrue: [ + self assert: SmallInteger maxVal decimalDigitLength = 10 ] + ifFalse: [ + self assert: SmallInteger maxVal decimalDigitLength = 19 ]! ! -!NumberTest methodsFor: 'tests' stamp: 'jmv 11/21/2018 17:39:36'! -testHash2 - "Hash should be the same for equivalent instances of various Number classes" +!SmallIntegerTest methodsFor: 'tests - zero behavior' stamp: 'jmv 7/2/2019 11:50:44'! +testZeroRaisedToNegativePower + "this is a test related to http://bugs.squeak.org/view.php?id=6781" - | boxedFloat float hash largeInteger smallIntIn64ButLargeIntIn32Bits | - largeInteger := (LargePositiveInteger new: 4) - digitAt: 1 put: 0; - digitAt: 2 put: 0; - digitAt: 3 put: 0; - digitAt: 4 put: 64; - yourself. - smallIntIn64ButLargeIntIn32Bits := largeInteger normalize. - float := smallIntIn64ButLargeIntIn32Bits asFloat. - boxedFloat := BoxedFloat64 new - basicAt: 1 put: (float basicAt: 1); - basicAt: 2 put: (float basicAt: 2); yourself. - - hash := largeInteger hash. - self assert: smallIntIn64ButLargeIntIn32Bits hash = hash. - self assert: float hash = hash. - self assert: boxedFloat hash = hash! ! + self should: [0 raisedToInteger: -1] raise: ZeroDivide. + self should: [0 raisedTo: -1] raise: ZeroDivide. + self should: [0 raisedTo: -1.0] raise: ZeroDivide. -!NumberTest methodsFor: 'tests' stamp: 'jmv 11/21/2018 17:39:51'! -testHash3 - "Hash should be the same for equivalent instances of various Number classes" + self should: [-0 raisedToInteger: -1] raise: ZeroDivide. + self should: [-0 raisedTo: -1] raise: ZeroDivide. + self should: [-0 raisedTo: -1.0] raise: ZeroDivide.! ! - | boxedFloat float hash largeInteger smallIntIn64ButLargeIntIn32Bits | - largeInteger := (LargePositiveInteger new: 4) - digitAt: 1 put: 1; - digitAt: 2 put: 2; - digitAt: 3 put: 3; - digitAt: 4 put: 80; - yourself. - smallIntIn64ButLargeIntIn32Bits := largeInteger normalize. - float := smallIntIn64ButLargeIntIn32Bits asFloat. - boxedFloat := BoxedFloat64 new - basicAt: 1 put: (float basicAt: 1); - basicAt: 2 put: (float basicAt: 2); yourself. - - hash := largeInteger hash. - self assert: smallIntIn64ButLargeIntIn32Bits hash = hash. - self assert: float hash = hash. - self assert: boxedFloat hash = hash! ! +!RandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 18:33'! +byteBitCounts -!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/26/2009 21:55'! -testIntegerPart + | tablePower answer | + tablePower _ 8. + answer _ ByteArray new: (1 bitShift: tablePower). + 0 to: tablePower - 1 do: + [:eachPowerIndex | + | powerOfTwo | + powerOfTwo _ 1 bitShift: eachPowerIndex. + 1 + powerOfTwo to: answer size by: powerOfTwo * 2 do: + [:eachPivot | + 0 to: powerOfTwo - 1 do: + [:eachIndex | + answer + at: eachPivot + eachIndex + put: (answer at: eachPivot + eachIndex) + 1 + ] + ] + ]. + ^answer! ! - self - assert: 2 integerPart = 2; - assert: (1/2) integerPart = 0; - assert: (4/3) integerPart = 1; - assert: 2.0 integerPart = 2.0; - assert: 0.5 integerPart = 0.0; - assert: 2.5 integerPart = 2.0 -! ! +!RandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 18:16'! +nSamplesByDefault -!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/23/2009 20:49'! -testOne + ^1000! ! - self - assert: Integer one = 1; - assert: Float one = 1.0; - assert: Fraction one = 1! ! +!RandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 17:59'! +rng -!NumberTest methodsFor: 'tests' stamp: 'jmv 1/9/2014 21:23'! -testPrintShowingDecimalPlaces + ^self rngClass new! ! - self assert: (String streamContents: [ :s | 111.2 printOn: s fractionDigits: 2]) = '111.20'. - self assert: (String streamContents: [ :s | 111.2 printOn: s fractionDigits: 0]) = '111'. - self assert: (String streamContents: [ :s | 111 printOn: s fractionDigits: 0]) = '111'. - self assert: (String streamContents: [ :s | 111111111111111 printOn: s fractionDigits: 2]) = '111111111111111.00'. - self assert: (String streamContents: [ :s | 10 printOn: s fractionDigits: 20]) ='10.00000000000000000000'. - self assert: (String streamContents: [ :s | 0.98 printOn: s fractionDigits: 2]) = '0.98'. - self assert: (String streamContents: [ :s | -0.98 printOn: s fractionDigits: 2]) = '-0.98'. - self assert: (String streamContents: [ :s | 2.567 printOn: s fractionDigits: 2]) = '2.57'. - self assert: (String streamContents: [ :s | -2.567 printOn: s fractionDigits: 2]) = '-2.57'! ! +!RandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 18:01'! +rngClass -!NumberTest methodsFor: 'tests' stamp: 'jmv 12/21/2018 12:00:50'! -testPrintShowingDecimalPlaces2 - "This tests problems related to Float>>rounded and Float>>roundTo:: - - Float>>#rounded is inexact - - Float>>#roundTo: might overflow" + self subclassResponsibility! ! - "This number is represented exactly asFloat, it should print exactly" - self assert: 5000000000000001.0 asTrueFraction = 5000000000000001. - self assert: 5000000000000001 highBit = 53. - self assert: (5000000000000001.0 printStringFractionDigits: 0) = '5000000000000001'. - - "50000000000001.25 asTrueFraction = (200000000000005/4). - 200000000000005 highBit = 48, 4 isPowerOfTwo, - So this number is also represented exactly as Float, it should print exactly. - Beware: (50000000000001.25 / 0.01) rounded exhibit the same problem as above." - self assert: (String streamContents: [ :s | 50000000000001.25 printOn: s fractionDigits: 2]) = '50000000000001.25'. +!RandomTest methodsFor: 'tests' stamp: 'ul 2/27/2015 13:53'! +testNext + "Generate some float values, and see if they are in the [0,1) interval. Also check that the smallest and the largest values are small/large enough." - "Since 4 isPowerOfTwo, this number is also represented exactly as Float, it should print exactly" - self assert: 50000000000001.25 asTrueFraction = (200000000000005/4). - self assert: 200000000000005 highBit = 48. - self assert: (50000000000001.25 printStringFractionDigits: 2) = '50000000000001.25'. - - "This number is close to fmax" - self shouldnt: [String streamContents: [ :s | 1.0e306 printOn: s fractionDigits: 3]] raise: Error.! ! + | random min max | + min := Float infinity. + max := Float negativeInfinity. + random := Random seed: 112629. + 100000 timesRepeat: [ + | next | + next := random next. + next < min ifTrue: [ min := next ]. + next > max ifTrue: [ max := next ]. + self assert: next >= 0.0 description: [ 'Generated value ', next asString, ' should be non-negative.' ]. + self assert: next < 1.0 description: [ 'Generated value ', next asString, ' should be less than 1.0.' ] ]. + self assert: max > 0.9999 description: 'The largest generated value should be greater than 0.9999.'. + self assert: min < 0.0001 description: 'The smallest generated value should be less than 0.0001.'! ! -!NumberTest methodsFor: 'tests' stamp: 'jmv 1/9/2014 21:22'! -testPrintShowingDecimalPlaces3 - "This problem were reported at http://bugs.squeak.org/view.php?id=7028 - unfortunate inversion of left / right padding" - self assert: (String streamContents: [ :s | 1.009 printOn: s fractionDigits: 3]) = '1.009'. - self assert: (String streamContents: [ :s | 35.900 printOn: s fractionDigits: 3]) = '35.900'. - self assert: (String streamContents: [ :s | -0.097 printOn: s fractionDigits: 3]) = '-0.097'.! ! +!RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 02:32:34'! +testNextBits + "Test randomBits: returns integers in the correct range." + | random | + random _ self rng. + 0 to: 10 do: [:n| 100 timesRepeat: [self assert: ((random nextBits: n) between: 0 and: 2^n - 1)]]. + 0 to: 100 do: [:n| self assert: ((random nextBits: n) between: 0 and: 2^n - 1)]! ! -!NumberTest methodsFor: 'tests' stamp: 'nice 12/6/2007 21:24'! -testRaisedTo - "this is a test related to http://bugs.squeak.org/view.php?id=6781" - - self should: [0 raisedTo: -1] raise: ZeroDivide. - self should: [0 raisedTo: -1.0] raise: ZeroDivide.! ! +!RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 02:27:56'! +testNextBitsInvalid + "Requesting a negative amount of random bits should raise an error." + | random | + random _ self rng. + self should: [random nextBits: -1] raise: Error. + self should: [random nextBits: -100] raise: Error! ! -!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/25/2009 16:41'! -testRaisedToInteger +!RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 02:38:58'! +testNextInteger + "Test nextInteger: returns integers in the correct range." + | random n | + random _ self rng. + 1 to: 5 do: [:i| 100 timesRepeat: [self assert: ((random nextInteger: i) between: 1 and: i)]]. + n _ 1<<1000. + self assert: ((random nextInteger: n) between: 1 and: n)! ! - self - assert: (2 raisedToInteger: 0) = 1; - assert: (2 raisedToInteger: 1) = 2; - assert: (2 raisedToInteger: 4) = 16; - assert: (0 raisedToInteger: 0) = 1; - assert: (0 raisedToInteger: 2) = 0; - assert: (2 raisedToInteger: -1) = (1/2); - assert: (2 raisedToInteger: -4) = (1/16). - - self - assert: (-3 raisedTo: 0) = 1; - assert: (-3 raisedTo: 1) = -3; - assert: (-3 raisedTo: 2) = 9; - assert: (-3 raisedTo: 3) = -27; - assert: (-3 raisedTo: -2) = (1/9); - assert: (-3 raisedTo: -3) = (-1/27). - - self should: [ 0 raisedTo: -1 ] raise: ZeroDivide! ! +!RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 02:36:52'! +testNextIntegerInvalid + | random | + random _ self rng. + self should: [random nextInteger: -1] raise: Error. + self should: [random nextInteger: -100] raise: Error. + self should: [random nextInteger: 0] raise: Error! ! -!NumberTest methodsFor: 'tests' stamp: 'jmv 4/5/2019 17:38:36'! -testRaisedToIntegerWithFloats +!RandomTest methodsFor: 'tests' stamp: 'sqr 3/5/2016 18:38'! +testRandomLargeInteger1 - self - assert: (2.0 raisedToInteger: 0) = 1.0; - assert: (2.0 raisedToInteger: 1) = 2.0; - assert: (2.0 raisedToInteger: 4) = 16.0; - assert: (0.0 raisedToInteger: 0) = 1.0; - assert: (0.0 raisedToInteger: 2) = 0.0; - assert: (2.0 raisedToInteger: -1) = 0.5; - assert: (2.0 raisedToInteger: -4) = 0.0625; - assert: (Float e raisedToInteger: -746) = 0.0; - assert: (Float e raisedToInteger: -745) = 0.0 successor; - assert: (Float e raisedToInteger: -744) = 0.0 successor successor. - self - assert: (-3.0 raisedToInteger: 0) = 1.0; - assert: (-3.0 raisedToInteger: 1) = -3.0; - assert: (-3.0 raisedToInteger: 2) = 9.0; - assert: (-3.0 raisedToInteger: 3) = -27.0; - assert: (-2.0 raisedToInteger: -2) = 0.25; - assert: (-2.0 raisedToInteger: -3) = -0.125; - assert: (Float e negated raisedToInteger: -746) = 0.0; - assert: (Float e negated raisedToInteger: -745) = -0.0 predecessor; - assert: (Float e negated raisedToInteger: -744) = 0.0 successor successor. - - self should: [ 0.0 raisedToInteger: -1 ] raise: ZeroDivide! ! + | random nSamples highBound odds | + random _ self rng. + nSamples _ self nSamplesByDefault. + highBound _ 1 << 64. + odds _ 0. + nSamples timesRepeat: [odds _ highBound atRandom: random :: bitAnd: 1 :: + odds]. + self assert: (odds * 2 - nSamples * 5) abs < nSamples "10% max deviation"! ! -!NumberTest methodsFor: 'tests' stamp: 'sd 6/5/2005 08:56'! -testReadFrom - - self assert: 1.0e-14 = (Number readFrom: '1.0e-14'). - self assert: 2r1e26 = (Number readFrom: '2r1e26').! ! +!RandomTest methodsFor: 'tests' stamp: 'sqr 3/5/2016 18:47'! +testRandomLargeInteger2 -!NumberTest methodsFor: 'tests' stamp: 'GabrielOmarCotelli 5/23/2009 19:26'! -testReciprocal + | random nSamples bitCounts bitsPerRandom highBound ones | + random _ self rng. + nSamples _ self nSamplesByDefault. + bitCounts _ self byteBitCounts. + bitsPerRandom _ 1000. + highBound _ 1 << bitsPerRandom. + ones _ 0. + nSamples timesRepeat: + [ + | next | + next _ highBound atRandom: random. + 1 to: next basicSize do: + [:eachIndex | ones _ bitCounts at: (next basicAt: eachIndex) + 1 :: + ones]. + ]. + self assert: ones - (nSamples * bitsPerRandom / 2) abs / 10 < nSamples "1% max deviation"! ! - self - assert: 1 reciprocal = 1; - assert: 2 reciprocal = (1/2); - assert: -1 reciprocal = -1; - assert: -3 reciprocal = (-1/3). - - self should: [ 0 reciprocal ] raise: ZeroDivide! ! +!RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 03:13:26'! +testSeedAndRepeatability + | random seed a b c | + random := self rng. + seed _ ((1 << 100) negated to: 1 << 100) atRandom. + random seed: seed. + a _ random next. + b _ random next. + c _ random nextBits: 100. + random seed: seed. + self assert: random next = a. + self assert: random next = b. + self assert: (random nextBits: 100) = c! ! -!NumberTest methodsFor: 'tests' stamp: 'sqr 6/26/2019 09:46:32'! -testZeroDivideHandler - "Test for user-defined ZeroDivide behavior" +!RandomTest methodsFor: 'tests' stamp: 'sqr 3/5/2016 18:17'! +testSetAtRandom - [ - self assert: 1 / 0 = Float infinity. - self assert: -1 / 0 = Float negativeInfinity. - self assert: 1.0 / 0 = Float infinity. - self assert: -1.0 / 0 = Float negativeInfinity. - self assert: 1 / 0.0 = Float infinity. - self assert: -1 / 0.0 = Float negativeInfinity. - self assert: 1.0 / 0.0 = Float infinity. - self assert: -1.0 / 0.0 = Float negativeInfinity. - ] on: ZeroDivide - do: [:ex | ex resume: ex receiver sign * Float infinity ] -! ! + | random set nSamples sum | + random _ self rng. + set _ Set with: 0 with: 1. + nSamples _ self nSamplesByDefault. + sum _ 0. + nSamples timesRepeat: [sum _ set atRandom: random :: + sum]. + self assert: (sum / nSamples - 0.5) abs < 0.1! ! -!NumberTest methodsFor: 'test' stamp: 'GC 9/8/2018 14:51:43'! -test01readFromWhenTheInitilValueIsNaNTheResultIsNaN +!RandomTest methodsFor: 'tests' stamp: 'sqr 3/5/2016 20:51'! +testSimpleBuckets + "This is a poor test, see Knuth's TAOCP" - |initialValue nan result | - - nan := Float nan. - initialValue := 'NaN'. - result := self subject: initialValue. - - self assert: result is: nan! ! + | nbuckets buckets nSamples random slot | + nbuckets _ 1000. + buckets _ Array new: nbuckets. + buckets atAllPut: 0. + nSamples _ 1000. + random _ self rng. + nSamples * nbuckets timesRepeat: + [ + slot := (random next * nbuckets) floor + 1. + buckets at: slot put: (buckets at: slot) + 1 + ]. + buckets do: + [:each | + "max ~17% deviation" + self assert: (each - nSamples * 6) abs < nSamples + ]! ! -!NumberTest methodsFor: 'test' stamp: 'GC 9/8/2018 15:07:25'! -test02readFromWhenTheInitilValueIsInfinityTheResultIsInfinity - - self assertThat: 'Infinity' isEqualTo: Float infinity! ! +!RandomTest class methodsFor: 'testing' stamp: 'sqr 3/5/2016 17:54'! +isAbstract -!NumberTest methodsFor: 'test' stamp: 'GC 9/8/2018 15:07:50'! -test03readFromWhenTheInitilValueIsMinusInfinityTheResultIsNegativeInfinity + ^self subclasses notEmpty! ! - self assertThat: '-Infinity' isEqualTo: Float negativeInfinity! ! +!LaggedFibonacciRandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 18:50'! +nSamplesByDefault -!NumberTest methodsFor: 'test' stamp: 'GC 9/8/2018 15:08:34'! -test04readFromWhenTheInitilValueIsANegativeNumberTheResultIsThatNumberNegated - - self assertThat: '-3' isEqualTo: -3! ! + ^self rng majorLag * 100! ! -!NumberTest methodsFor: 'test' stamp: 'GC 9/8/2018 15:09:00'! -test05readFromWhenTheInitilValueIsJustANumberTheResultIsThatNumber - - self assertThat: '3' isEqualTo: 3! ! +!LaggedFibonacciRandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 18:00'! +rngClass -!NumberTest methodsFor: 'test' stamp: 'GC 9/9/2018 16:32:38'! -test06readFromWhenTheInitialValueIncludesRadixItIsConvertedWithTheIndicatedRadixBase - |radixBase number initualNumber | - - radixBase := '2r'. - number := '11110'. - - initualNumber := radixBase, number. - - self assert: initualNumber asNumber equals: 30! ! + ^LaggedFibonacciRandom! ! -!NumberTest methodsFor: 'test' stamp: 'jmv 9/10/2018 10:28:22'! -test07readFromWhenTheInitialValueIncludesAnInvalidRadixItRaisesAnError - |radixBase number initualNumber | - - radixBase := '0r'. - number := '11110'. - - initualNumber := radixBase, number. - - - self should: [ initualNumber asNumber ] raise: Error description: 'Invalid radix'! ! +!ParkMiller88RandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 19:58'! +rngClass -!NumberTest methodsFor: 'test' stamp: 'GC 9/9/2018 16:32:50'! -test08readFromWhenTheInitialValueIncludesANegativeRadixItConvertsTheNumberWithTheIndicatedRadixBase - |radixBase number initualNumber | - - radixBase := '-2r'. - number := '11110'. - - initualNumber := radixBase, number. - - self assert: initualNumber asNumber equals: -30! ! + ^ParkMiller88Random! ! -!NumberTest methodsFor: 'test' stamp: 'jmv 9/10/2018 10:28:25'! -test09readFromWhenTheInitialValueIsEmptyItRaisesAnError - - self should: [ Number readFrom: '' ] raise: Error description: 'At least one digit expected here'! ! +!ParkMiller88RandomTest methodsFor: 'tests' stamp: 'sqr 3/5/2016 20:06'! +testParkMillerCorrectness + "The correctness test suggested by the authors" -!NumberTest methodsFor: 'support' stamp: 'GC 9/8/2018 14:45:07'! -assert: expected is: actual - ^ self - assert: (expected == actual) - description: (self comparingStringBetween: expected and: actual)! ! + | random next | + random _ self rng seed: 1. + 10000 timesRepeat: [next _ random next]. + self assert: next * 16r7FFFFFFF = 1043618065.0! ! -!NumberTest methodsFor: 'support' stamp: 'GC 9/8/2018 15:06:11'! -assertThat: aNumber isEqualTo: anExpectedNumber +!ParkMiller88RandomTest methodsFor: 'tests' stamp: 'sqr 3/5/2016 18:48'! +testParkMillerInitialValues - | result | - result := self subject: aNumber. - - self assert: result equals: anExpectedNumber! ! + | nSamples random samples | + nSamples _ self nSamplesByDefault. + random _ self rng. + samples _ 1 to: nSamples :: collect: [:each | random next]. + self assert: (samples average - 0.5) abs < 0.1. + self assert: samples size * 10 > nSamples! ! -!NumberTest methodsFor: 'support' stamp: 'GC 9/8/2018 14:48:11'! -subject: aString +!ParkMiller88RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 03:25:04'! +testParkMillerSeedCornerCases + "Test the insernal state of the Park-Miller generator is correctly set, including corner cases." + | random m | + m _ 2147483647. + {1. 2. (m-1) atRandom. m-1. m-2} + do: [:each| + random _ self rng seed: each. + self assert: (random instVarNamed: #seed) = each]! ! - | aStream | - aStream := ReadStream on: aString. +!ParkMiller88RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 03:25:14'! +testParkMillerSeedRange + "Test the insernal state of the Park-Miller generator is correctly set, even for arbitrary user-provided seeds." + | random m | + m _ 2147483647. + {1. 1000. 10000000000000000000000. -100. 0. -1. m. m-1. m-2. m+1} + do: [:each| + random _ self rng seed: each. + self assert: ((random instVarNamed: #seed) between: 1 and: m - 1)]! ! - ^ Number readFrom: aStream! ! +!ParkMiller93RandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 19:58'! +rngClass -!SmallIntegerTest methodsFor: 'testing - Class Methods' stamp: 'sd 6/5/2005 08:59'! -testBasicNew + ^ParkMiller93Random! ! - self should: [SmallInteger basicNew] raise: TestResult error. ! ! +!CharacterSetTest methodsFor: 'testing includes' stamp: 'HAW 6/12/2019 17:32:08'! +testIncludesReturnsFalseForCharacterNotIncluded -!SmallIntegerTest methodsFor: 'testing - Class Methods' stamp: 'jmv 1/4/2017 08:16:27'! -testMaxVal + self deny: ((CharacterSet with: $a) includes: $b)! ! - Smalltalk wordSize = 4 - ifTrue: [ - self assert: (SmallInteger maxVal = 16r3FFFFFFF) ] - ifFalse: [ - self assert: (SmallInteger maxVal = 16rFFFFFFFFFFFFFFF) ]! ! +!CharacterSetTest methodsFor: 'testing includes' stamp: 'HAW 6/12/2019 17:31:45'! +testIncludesReturnsFalseForObjectsThatAreNotCharacters -!SmallIntegerTest methodsFor: 'testing - Class Methods' stamp: 'jmv 1/4/2017 08:17:27'! -testMinVal + self deny: ((CharacterSet with: $a) includes: 1)! ! - Smalltalk wordSize = 4 - ifTrue: [ - self assert: (SmallInteger minVal = -16r40000000) ] - ifFalse: [ - self assert: (SmallInteger minVal = -16r1000000000000000) ]! ! +!CharacterSetTest methodsFor: 'testing includes' stamp: 'HAW 6/12/2019 17:32:24'! +testIncludesReturnsTrueForCharacterIncluded -!SmallIntegerTest methodsFor: 'testing - Class Methods' stamp: 'sd 6/5/2005 08:59'! -testNew + self assert: ((CharacterSet with: $a) includes: $a)! ! - self should: [SmallInteger new] raise: TestResult error. ! ! +!CharacterTest methodsFor: 'testing' stamp: 'jmv 10/6/2010 22:08'! +testCaseConversion + " + self new testCaseConversion + " + self assert: ('año Comé tomá Camión' collect: [ :c | c asLowercase ]) = 'año comé tomá camión'. + self assert:('año Comé tomá Camión' collect: [ :c | c asUppercase ]) = 'AÑO COMÉ TOMÁ CAMIÓN'! ! -!SmallIntegerTest methodsFor: 'testing - arithmetic' stamp: 'sd 6/5/2005 08:59'! -testDivide +!CharacterTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:10:55'! +testIsCharacter + self assert: ($a is: #Character). + self assert: ($X is: #Character). + self assert: (Character cr is: #Character).! ! - self assert: 2 / 1 = 2. - self assert: (3 / 2) isFraction. - self assert: 4 / 2 = 2. - self should: [ 1 / 0 ] raise: ZeroDivide.! ! +!CharacterTest methodsFor: 'testing' stamp: 'jmv 10/6/2010 22:05'! +testSorting + " + self new testSorting + " + self assert: $a < $á. + self deny: $a < $Á. + self assert: $A < $á. + self assert: $A < $Á. + self assert: $á < $b. + self deny: $á < $B. + self assert: $Á < $b. + self assert: $Á < $B.! ! -!SmallIntegerTest methodsFor: 'testing - basic' stamp: 'jmv 5/7/2012 21:35'! -testEven - - self assert: (SmallInteger minVal even). - self deny: (SmallInteger maxVal even). - - self deny: ((SmallInteger minVal + 1) even). - self assert: ((SmallInteger maxVal - 1) even). - - self deny: (1 even). - self deny: (-1 even). - - self assert: (2 even). - self assert: (-2 even). - - self assert: (0 even)! ! +!CharacterTest methodsFor: 'testing' stamp: 'jmv 10/6/2010 22:10'! +testTestingMethods + " + self new testTestingMethods + " + self assert: + ('año Comé tomá Camión' allSatisfy: [ :c | + c = $ or: [ c isLetter ]]). + self assert: + ('año comé tomá camión' allSatisfy: [ :c | + c = $ or: [ c isLowercase ]]). + self assert: + ('AÑO COMÉ TOMÁ CAMIÓN' allSatisfy: [ :c | + c = $ or: [ c isUppercase ]]). + self assert: + ('AaÀàÁáÂâÃãÄäÅåEeÈèÉéÊêËëIiÌìÍíÎîÏïOoÒòÓóÔôÕõÖöUuÙùÚúÛûÜü' allSatisfy: [ :c | + c isVowel ]).! ! -!SmallIntegerTest methodsFor: 'testing - basic' stamp: 'jmv 5/7/2012 21:35'! -testOdd - - self deny: (SmallInteger minVal odd). - self assert: (SmallInteger maxVal odd). - - self assert: ((SmallInteger minVal + 1) odd). - self deny: ((SmallInteger maxVal - 1) odd). - - self assert: (1 odd). - self assert: (-1 odd). - - self deny: (2 odd). - self deny: (-2 odd). - - self deny: (0 odd)! ! +!CharacterTest methodsFor: 'UTF-8 conversion' stamp: 'jmv 5/26/2022 12:31:12'! +testFromUtf8 + " + CharacterTest new testFromUtf8 + " + Character utf8BytesAndCodePointAt: 1 in: (ByteArray readHexFrom: '24') into: nil into: [ :codePoint | self assert: codePoint hex = '16r24' ]. + Character utf8BytesAndCodePointAt: 1 in: (ByteArray readHexFrom: 'C2A2') into: nil into: [ :codePoint | self assert: codePoint hex = '16rA2' ]. + Character utf8BytesAndCodePointAt: 1 in: (ByteArray readHexFrom: 'E282AC') into: nil into: [ :codePoint | self assert: codePoint hex = '16r20AC' ]. + Character utf8BytesAndCodePointAt: 1 in: (ByteArray readHexFrom: 'F0A4ADA2') into: nil into: [ :codePoint | self assert: codePoint hex = '16r24B62' ].! ! -!SmallIntegerTest methodsFor: 'testing - printing' stamp: 'jmv 1/9/2014 23:41'! -testPrintPaddedWith +!CharacterTest methodsFor: 'UTF-8 conversion' stamp: 'jmv 5/5/2022 09:34:34'! +testSomeLatinCharsFromUtf8 + " + CharacterTest new testSomeLatinCharsFromUtf8 + " + | bytes string | + bytes _ ByteArray readHexFrom: 'C3A1C3A5C3A6C3B1C386C2A5C3BC'. + string _ String streamContents: [ :strm | | s byteIndex n | + s _ bytes size. + byteIndex _ 1. + [ byteIndex <= s ] whileTrue: [ + n _ Character utf8BytesAndCodePointAt: byteIndex in: bytes + into: nil + into: [ :codePoint | + strm nextPut: (Character codePoint: codePoint) ]. + byteIndex _ byteIndex + n + ]]. + self assert: string = 'áåæñÆ¥ü'! ! - self assert: (123 printStringBase: 2 length: 10 padded: true) = '0001111011'. - self assert: (123 printStringBase: 8 length: 10 padded: true) = '0000000173'. - self assert: (123 printStringBase: 10 length: 10 padded: true) = '0000000123'. - self assert: (123 printStringBase: 16 length: 10 padded: true) = '000000007B'! ! +!CharacterTest methodsFor: 'UTF-8 conversion' stamp: 'jmv 9/4/2016 13:11:55'! +testSomeLatinCharsToUtf8 + " + CharacterTest new testSomeLatinCharsToUtf8 + " + | characters bytes | + characters _ 'áåæñÆ¥ü' readStream. + bytes _ ByteArray streamContents: [ :strm | + [ characters atEnd ] whileFalse: [ + Character + evaluate: [ :byte | strm nextPut: byte ] + withUtf8BytesOfUnicodeCodePoint: characters next codePoint ]]. + self assert: bytes hex = 'C3A1C3A5C3A6C3B1C386C2A5C3BC'! ! -!SmallIntegerTest methodsFor: 'testing - printing' stamp: 'jmv 1/4/2017 08:22:13'! -testPrintString - self assert: 1 printString = '1'. - self assert: -1 printString = '-1'. - Smalltalk wordSize = 4 - ifTrue: [ - self assert: SmallInteger minVal printString = '-1073741824'. - self assert: SmallInteger maxVal printString = '1073741823' ] - ifFalse: [ - self assert: SmallInteger minVal printString = '-1152921504606846976' . - self assert: SmallInteger maxVal printString = '1152921504606846975' ]. - self assert: 12345 printString = '12345'. - self assert: -54321 printString = '-54321'. +!CharacterTest methodsFor: 'UTF-8 conversion' stamp: 'jmv 2/20/2013 20:09'! +testToUtf8 + " + CharacterTest new testToUtf8 + " + self assert: (Character utf8BytesOfUnicodeCodePoint: 16r0024) hex = '24'. + self assert: (Character utf8BytesOfUnicodeCodePoint: 16r00A2) hex = 'C2A2'. + self assert: (Character utf8BytesOfUnicodeCodePoint: 16r20AC) hex = 'E282AC'. + self assert: (Character utf8BytesOfUnicodeCodePoint: 16r024B62) hex = 'F0A4ADA2'! ! - self assert: 0 decimalDigitLength = 1. - self assert: 4 decimalDigitLength = 1. - self assert: 12 decimalDigitLength = 2. - self assert: 123 decimalDigitLength = 3. - self assert: 1234 decimalDigitLength = 4. - self assert: 56789 decimalDigitLength = 5. - self assert: 657483 decimalDigitLength = 6. - self assert: 6571483 decimalDigitLength = 7. - self assert: 65174383 decimalDigitLength = 8. - self assert: 625744831 decimalDigitLength = 9. - self assert: 1000001111 decimalDigitLength = 10. - Smalltalk wordSize = 4 - ifTrue: [ - self assert: SmallInteger maxVal decimalDigitLength = 10 ] - ifFalse: [ - self assert: SmallInteger maxVal decimalDigitLength = 19 ]! ! +!StringTest methodsFor: 'UTF-8 conversion' stamp: 'jmv 5/26/2022 12:00:49'! +testAsUtf8 + " + StringTest new testAsUtf8 + " + self assert: 'A¢¤' asUtf8Bytes hex = '41C2A2E282AC'! ! -!SmallIntegerTest methodsFor: 'tests - zero behavior' stamp: 'jmv 7/2/2019 11:50:44'! -testZeroRaisedToNegativePower - "this is a test related to http://bugs.squeak.org/view.php?id=6781" +!StringTest methodsFor: 'UTF-8 conversion' stamp: 'jmv 5/26/2022 11:59:35'! +testAsUtf8WithNCRs + " + StringTest new testAsUtf8WithNCRs + " + | stringWithDecimalNCRs stringWithHexNCRs utf8 | + utf8 _ ByteArray readHexFrom: ('CE BC 20 CE A8 20 CF 89 20 54 68 65 20 64 65 63 6F 6D 70 6F 73 69 74 69 6F 6E 20 6D 61 70 70 69 6E 67 20 69 73 20 3C EC B8 A0 2C 20 E1 86 B8 3E 2C 20 61 6E 64 20 6E 6F 74 20 3C E1 84 8E 2C 20 E1 85 B3 2C 20 31 31 42 38 3E 2E 0A 3C 70 3E 54 68 65 20 74 69 74 6C 65 20 73 61 79 73 20 E2 80 AB D7 A4 D7 A2 D7 99 D7 9C D7 95 D7 AA 20 D7 94 D7 91 D7 99 D7 A0 D7 90 D7 95 D7 9D 2C 20 57 33 43 E2 80 AC 20 69 6E 20 48 65 62 72 65 77 3C 2F 70 3E 0A 61 62 63 E0 A4 95 E0 A4 96 E0 A5 80 E5 9C 8B E9 9A 9B F0 90 8E 84 F0 90 8E 94 F0 90 8E 98' reject: [ :char | char isSeparator ]). - self should: [0 raisedToInteger: -1] raise: ZeroDivide. - self should: [0 raisedTo: -1] raise: ZeroDivide. - self should: [0 raisedTo: -1.0] raise: ZeroDivide. + stringWithDecimalNCRs _ String fromUtf8Bytes: utf8 hex: false trimLastNull: false. + stringWithHexNCRs _ String fromUtf8Bytes: utf8 hex: true trimLastNull: false. - self should: [-0 raisedToInteger: -1] raise: ZeroDivide. - self should: [-0 raisedTo: -1] raise: ZeroDivide. - self should: [-0 raisedTo: -1.0] raise: ZeroDivide.! ! + self assert: stringWithDecimalNCRs = 'μ Ψ ˜ The decomposition mapping is <츠, ᆸ>, and not <ᄎ, ᅳ, 11B8>. +

The title says ‫פעילות הבינאום, W3C‬ in Hebrew

+abcकखी國際𐎄𐎔𐎘'. -!RandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 18:33'! -byteBitCounts + self assert: (stringWithDecimalNCRs asUtf8Bytes: true) = utf8. - | tablePower answer | - tablePower _ 8. - answer _ ByteArray new: (1 bitShift: tablePower). - 0 to: tablePower - 1 do: - [:eachPowerIndex | - | powerOfTwo | - powerOfTwo _ 1 bitShift: eachPowerIndex. - 1 + powerOfTwo to: answer size by: powerOfTwo * 2 do: - [:eachPivot | - 0 to: powerOfTwo - 1 do: - [:eachIndex | - answer - at: eachPivot + eachIndex - put: (answer at: eachPivot + eachIndex) + 1 - ] - ] - ]. - ^answer! ! + self assert: stringWithHexNCRs = 'μ Ψ ˜ The decomposition mapping is <츠, ᆸ>, and not <ᄎ, ᅳ, 11B8>. +

The title says ‫פעילות הבינאום, W3C‬ in Hebrew

+abcकखी國際𐎄𐎔𐎘'. -!RandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 18:16'! -nSamplesByDefault + self assert: (stringWithHexNCRs asUtf8Bytes: true) = utf8! ! - ^1000! ! +!StringTest methodsFor: 'tests - converting' stamp: 'jmv 9/19/2016 09:55:39'! +testBase64 -!RandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 17:59'! -rng + self + assert: 'SGVsbG8gV29ybGQ=' base64Decoded = 'Hello World' asByteArray; + assert: 'Hello World' asByteArray base64Encoded = 'SGVsbG8gV29ybGQ='; + assert: (String new: 100 withAll: $x) asByteArray base64Encoded = +'eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4 +eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eA==' ! ! - ^self rngClass new! ! +!StringTest methodsFor: 'testing' stamp: 'HAW 8/3/2018 10:42:26'! +testAfterBlanksEndsWith -!RandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 18:01'! -rngClass + self assert: (' abc' afterBlanksEndsWith: 'abc'). + self assert: ('abc' afterBlanksEndsWith: 'abc'). + + self deny: (' ab' afterBlanksEndsWith: 'abc'). + self deny: (' ab' afterBlanksEndsWith: 'a'). + self deny: ('' afterBlanksEndsWith: 'abc'). + self deny: (' a a bc' afterBlanksEndsWith: 'a bc').! ! - self subclassResponsibility! ! +!StringTest methodsFor: 'testing' stamp: 'jmv 10/6/2010 22:08'! +testCaseConversion + " + self new testCaseConversion + " + self assert: ('año Comé tomá Camión' asLowercase) = 'año comé tomá camión'. + self assert: ('año Comé tomá Camión' asUppercase) = 'AÑO COMÉ TOMÁ CAMIÓN'! ! -!RandomTest methodsFor: 'tests' stamp: 'ul 2/27/2015 13:53'! -testNext - "Generate some float values, and see if they are in the [0,1) interval. Also check that the smallest and the largest values are small/large enough." +!StringTest methodsFor: 'testing' stamp: 'jmv 9/1/2009 14:12'! +testEncompassParagraph1 - | random min max | - min := Float infinity. - max := Float negativeInfinity. - random := Random seed: 112629. - 100000 timesRepeat: [ - | next | - next := random next. - next < min ifTrue: [ min := next ]. - next > max ifTrue: [ max := next ]. - self assert: next >= 0.0 description: [ 'Generated value ', next asString, ' should be non-negative.' ]. - self assert: next < 1.0 description: [ 'Generated value ', next asString, ' should be less than 1.0.' ] ]. - self assert: max > 0.9999 description: 'The largest generated value should be greater than 0.9999.'. - self assert: min < 0.0001 description: 'The smallest generated value should be less than 0.0001.'! ! + self assert: ('a' encompassParagraph: (1 to: 0)) = (1 to: 1). + self assert: ('a' encompassParagraph: (1 to: 1)) = (1 to: 1). + self assert: ('a' encompassParagraph: (2 to: 1)) = (1 to: 1).! ! -!RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 02:32:34'! -testNextBits - "Test randomBits: returns integers in the correct range." - | random | - random _ self rng. - 0 to: 10 do: [:n| 100 timesRepeat: [self assert: ((random nextBits: n) between: 0 and: 2^n - 1)]]. - 0 to: 100 do: [:n| self assert: ((random nextBits: n) between: 0 and: 2^n - 1)]! ! +!StringTest methodsFor: 'testing' stamp: 'jmv 9/1/2009 14:13'! +testEncompassParagraph2 -!RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 02:27:56'! -testNextBitsInvalid - "Requesting a negative amount of random bits should raise an error." - | random | - random _ self rng. - self should: [random nextBits: -1] raise: Error. - self should: [random nextBits: -100] raise: Error! ! + self assert: ('ab' encompassParagraph: (1 to: 0)) = (1 to: 2). + self assert: ('ab' encompassParagraph: (1 to: 1)) = (1 to: 2). + self assert: ('ab' encompassParagraph: (1 to: 2)) = (1 to: 2). + self assert: ('ab' encompassParagraph: (2 to: 1)) = (1 to: 2). + self assert: ('ab' encompassParagraph: (2 to: 2)) = (1 to: 2). + self assert: ('ab' encompassParagraph: (3 to: 2)) = (1 to: 2).! ! -!RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 02:38:58'! -testNextInteger - "Test nextInteger: returns integers in the correct range." - | random n | - random _ self rng. - 1 to: 5 do: [:i| 100 timesRepeat: [self assert: ((random nextInteger: i) between: 1 and: i)]]. - n _ 1<<1000. - self assert: ((random nextInteger: n) between: 1 and: n)! ! +!StringTest methodsFor: 'testing' stamp: 'jmv 9/1/2009 14:14'! +testEncompassParagraph3 -!RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 02:36:52'! -testNextIntegerInvalid - | random | - random _ self rng. - self should: [random nextInteger: -1] raise: Error. - self should: [random nextInteger: -100] raise: Error. - self should: [random nextInteger: 0] raise: Error! ! +self assert: ('a +' encompassParagraph: (1 to: 0)) = (1 to: 2). +self assert: ('a +' encompassParagraph: (1 to: 1)) = (1 to: 2). +self assert: ('a +' encompassParagraph: (1 to: 2)) = (1 to: 2). +self assert: ('a +' encompassParagraph: (2 to: 1)) = (1 to: 2). +self assert: ('a +' encompassParagraph: (2 to: 2)) = (1 to: 2). +self assert: ('a +' encompassParagraph: (3 to: 2)) = (3 to: 2). -!RandomTest methodsFor: 'tests' stamp: 'sqr 3/5/2016 18:38'! -testRandomLargeInteger1 +self assert: ('a +zcxv' encompassParagraph: (1 to: 0)) = (1 to: 2). +self assert: ('a +zcxv' encompassParagraph: (1 to: 1)) = (1 to: 2). +self assert: ('a +zxcv' encompassParagraph: (1 to: 2)) = (1 to: 2). +self assert: ('a +zxcv' encompassParagraph: (2 to: 1)) = (1 to: 2). +self assert: ('a +zxcv' encompassParagraph: (2 to: 2)) = (1 to: 2). +self assert: ('a +zxcv' encompassParagraph: (3 to: 2)) = (3 to: 6).! ! - | random nSamples highBound odds | - random _ self rng. - nSamples _ self nSamplesByDefault. - highBound _ 1 << 64. - odds _ 0. - nSamples timesRepeat: [odds _ highBound atRandom: random :: bitAnd: 1 :: + odds]. - self assert: (odds * 2 - nSamples * 5) abs < nSamples "10% max deviation"! ! +!StringTest methodsFor: 'testing' stamp: 'jmv 9/1/2009 14:17'! +testEncompassParagraph4 -!RandomTest methodsFor: 'tests' stamp: 'sqr 3/5/2016 18:47'! -testRandomLargeInteger2 +self assert: (' +b' encompassParagraph: (1 to: 0)) = (1 to: 1). +self assert: (' +b' encompassParagraph: (1 to: 1)) = (1 to: 1). +self assert: (' +b' encompassParagraph: (1 to: 2)) = (1 to: 2). +self assert: (' +b' encompassParagraph: (2 to: 1)) = (2 to: 2). +self assert: (' +b' encompassParagraph: (2 to: 2)) = (2 to: 2). +self assert: (' +b' encompassParagraph: (3 to: 2)) = (2 to: 2).! ! - | random nSamples bitCounts bitsPerRandom highBound ones | - random _ self rng. - nSamples _ self nSamplesByDefault. - bitCounts _ self byteBitCounts. - bitsPerRandom _ 1000. - highBound _ 1 << bitsPerRandom. - ones _ 0. - nSamples timesRepeat: - [ - | next | - next _ highBound atRandom: random. - 1 to: next basicSize do: - [:eachIndex | ones _ bitCounts at: (next basicAt: eachIndex) + 1 :: + ones]. - ]. - self assert: ones - (nSamples * bitsPerRandom / 2) abs / 10 < nSamples "1% max deviation"! ! +!StringTest methodsFor: 'testing' stamp: 'jmv 9/1/2009 14:22'! +testEncompassParagraph5 -!RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 03:13:26'! -testSeedAndRepeatability - | random seed a b c | - random := self rng. - seed _ ((1 << 100) negated to: 1 << 100) atRandom. - random seed: seed. - a _ random next. - b _ random next. - c _ random nextBits: 100. - random seed: seed. - self assert: random next = a. - self assert: random next = b. - self assert: (random nextBits: 100) = c! ! +self assert: ('a +b' encompassParagraph: (1 to: 0)) = (1 to: 2). +self assert: ('a +b' encompassParagraph: (1 to: 1)) = (1 to: 2). +self assert: ('a +b' encompassParagraph: (1 to: 2)) = (1 to: 2). +self assert: ('a +b' encompassParagraph: (1 to: 3)) = (1 to: 3). +self assert: ('a +b' encompassParagraph: (2 to: 1)) = (1 to: 2). +self assert: ('a +b' encompassParagraph: (2 to: 2)) = (1 to: 2). +self assert: ('a +b' encompassParagraph: (2 to: 3)) = (1 to: 3). +self assert: ('a +b' encompassParagraph: (3 to: 2)) = (3 to: 3). +self assert: ('a +b' encompassParagraph: (3 to: 3)) = (3 to: 3). +self assert: ('a +b' encompassParagraph: (4 to: 3)) = (3 to: 3).! ! -!RandomTest methodsFor: 'tests' stamp: 'sqr 3/5/2016 18:17'! -testSetAtRandom +!StringTest methodsFor: 'testing' stamp: 'HAW 12/29/2020 13:29:16'! +testFindSelector - | random set nSamples sum | - random _ self rng. - set _ Set with: 0 with: 1. - nSamples _ self nSamplesByDefault. - sum _ 0. - nSamples timesRepeat: [sum _ set atRandom: random :: + sum]. - self assert: (sum / nSamples - 0.5) abs < 0.1! ! - -!RandomTest methodsFor: 'tests' stamp: 'sqr 3/5/2016 20:51'! -testSimpleBuckets - "This is a poor test, see Knuth's TAOCP" + self assert: #printOn: equals: '"self printOn:' findSelector. + self assert: #printOn: equals: 'self printOn:"' findSelector. + self assert: #printOn: equals: '"self printOn:"' findSelector. + self assert: #printOn: equals: 'self printOn:' findSelector. +! ! - | nbuckets buckets nSamples random slot | - nbuckets _ 1000. - buckets _ Array new: nbuckets. - buckets atAllPut: 0. - nSamples _ 1000. - random _ self rng. - nSamples * nbuckets timesRepeat: - [ - slot := (random next * nbuckets) floor + 1. - buckets at: slot put: (buckets at: slot) + 1 - ]. - buckets do: - [:each | - "max ~17% deviation" - self assert: (each - nSamples * 6) abs < nSamples - ]! ! +!StringTest methodsFor: 'testing' stamp: 'jmv 6/6/2022 16:47:18'! +testFirstNonSeparator -!RandomTest class methodsFor: 'testing' stamp: 'sqr 3/5/2016 17:54'! -isAbstract + self assert: 1 equals: 'abc' firstNonSeparator. + self assert: 2 equals: ' abc' firstNonSeparator. + self assert: 0 equals: '' firstNonSeparator ! ! - ^self subclasses notEmpty! ! +!StringTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:11:49'! +testIsString + self assert: ('Hello World' is: #String). + self assert: ('' is: #String).! ! -!LaggedFibonacciRandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 18:50'! -nSamplesByDefault +!StringTest methodsFor: 'testing' stamp: 'jmv 6/6/2022 16:46:49'! +testLastNonSeparator - ^self rng majorLag * 100! ! + self assert: 3 equals: 'abc' lastNonSeparator. + self assert: 3 equals: 'abc ' lastNonSeparator. + self assert: 4 equals: ' abc ' lastNonSeparator. + self assert: 0 equals: '' lastNonSeparator ! ! -!LaggedFibonacciRandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 18:00'! -rngClass +!StringTest methodsFor: 'testing' stamp: 'jmv 12/17/2012 10:51'! +testLineSeparators + " + Test that #newLineCharacter is considered a line separator and not a line terminator. + This means that the last line never ends with a #newLineCharacter (although it might be empty!!) + StringTest new testLineSeparators + " + | justAnLf linesBounds | + linesBounds _ OrderedCollection new. + justAnLf _ ' +'. + justAnLf lineIndicesDo: [ :start :endWithoutDelimiters :end | + linesBounds add: { start . endWithoutDelimiters. end }. + ]. - ^LaggedFibonacciRandom! ! + self assert: linesBounds size = 2 description: 'There should be two lines.'. -!ParkMiller88RandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 19:58'! -rngClass + self assert: linesBounds first first = 1 description: 'First line starts at position 1'. + self assert: linesBounds first second = (linesBounds first first-1) description: 'First line is empty'. + self assert: linesBounds first third = (linesBounds first second+1) description: 'First line is terminated by ab Lf'. - ^ParkMiller88Random! ! + self assert: linesBounds second first = ( linesBounds first third+1) description: 'Second line starts after end of first line'. + self assert: linesBounds second second = (linesBounds second first-1) description: 'Second line is empty'. + self assert: linesBounds second third = (linesBounds second second+0) description: 'Second line is not terminated by ab Lf'.! ! -!ParkMiller88RandomTest methodsFor: 'tests' stamp: 'sqr 3/5/2016 20:06'! -testParkMillerCorrectness - "The correctness test suggested by the authors" +!StringTest methodsFor: 'testing' stamp: 'jmv 10/6/2010 22:03'! +testSorting +" +self new testSorting +" - | random next | - random _ self rng seed: 1. - 10000 timesRepeat: [next _ random next]. - self assert: next * 16r7FFFFFFF = 1043618065.0! ! + self assert: 'a' < 'á'. + self assert: ('a' < 'Á') not. + self assert: 'A' < 'á'. + self assert: 'A' < 'Á'. + self assert: 'á' < 'b'. + self assert: ('á' < 'B') not. + self assert: 'Á' < 'b'. + self assert: 'Á' < 'B'. -!ParkMiller88RandomTest methodsFor: 'tests' stamp: 'sqr 3/5/2016 18:48'! -testParkMillerInitialValues + self assert: ('a' caseSensitiveLessOrEqual: 'á'). + self deny: ('a' caseSensitiveLessOrEqual: 'Á'). + self assert: ('A' caseSensitiveLessOrEqual: 'á'). + self assert: ('A' caseSensitiveLessOrEqual: 'Á'). + self assert: ('á' caseSensitiveLessOrEqual: 'b'). + self deny: ('á' caseSensitiveLessOrEqual: 'B'). + self assert: ('Á' caseSensitiveLessOrEqual: 'b'). + self assert: ('Á' caseSensitiveLessOrEqual: 'B'). - | nSamples random samples | - nSamples _ self nSamplesByDefault. - random _ self rng. - samples _ 1 to: nSamples :: collect: [:each | random next]. - self assert: (samples average - 0.5) abs < 0.1. - self assert: samples size * 10 > nSamples! ! + self assert: ('a' caseInsensitiveLessOrEqual: 'á'). + self assert: ('a' caseInsensitiveLessOrEqual: 'Á'). + self assert: ('A' caseInsensitiveLessOrEqual: 'á'). + self assert: ('A' caseInsensitiveLessOrEqual: 'Á'). + self assert: ('á' caseInsensitiveLessOrEqual: 'b'). + self assert: ('á' caseInsensitiveLessOrEqual: 'B'). + self assert: ('Á' caseInsensitiveLessOrEqual: 'b'). + self assert: ('Á' caseInsensitiveLessOrEqual: 'B').! ! -!ParkMiller88RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 03:25:04'! -testParkMillerSeedCornerCases - "Test the insernal state of the Park-Miller generator is correctly set, including corner cases." - | random m | - m _ 2147483647. - {1. 2. (m-1) atRandom. m-1. m-2} - do: [:each| - random _ self rng seed: each. - self assert: (random instVarNamed: #seed) = each]! ! +!StringTest methodsFor: 'testing' stamp: 'HAW 8/3/2018 11:00:28'! +testWithBlanksTrimmed -!ParkMiller88RandomTest methodsFor: 'tests' stamp: 'len 6/7/2019 03:25:14'! -testParkMillerSeedRange - "Test the insernal state of the Park-Miller generator is correctly set, even for arbitrary user-provided seeds." - | random m | - m _ 2147483647. - {1. 1000. 10000000000000000000000. -100. 0. -1. m. m-1. m-2. m+1} - do: [:each| - random _ self rng seed: each. - self assert: ((random instVarNamed: #seed) between: 1 and: m - 1)]! ! + self assert: 'abc' equals: ' abc' withBlanksTrimmed. + self assert: 'abc' equals: 'abc ' withBlanksTrimmed. + self assert: 'abc' equals: ' abc ' withBlanksTrimmed. + self assert: 'a b c' equals: ' a b c ' withBlanksTrimmed. + self assert: '' equals: '' withBlanksTrimmed. + ! ! -!ParkMiller93RandomTest methodsFor: 'setup' stamp: 'sqr 3/5/2016 19:58'! -rngClass +!StringTest methodsFor: 'testing' stamp: 'HAW 8/2/2018 20:35:28'! +testWithoutLeadingBlanks - ^ParkMiller93Random! ! + self assert: 'abc' equals: ' abc' withoutLeadingBlanks. + self assert: 'abc' equals: 'abc' withoutLeadingBlanks. + self assert: '' withoutLeadingBlanks isEmpty +! ! -!DateAndTimeTest methodsFor: 'tests' stamp: 'jmv 6/5/2014 14:29'! -testCreation - " - self new testCreation - " - | d | - d _ (DateAndTime julianDayNumber: 2456814) date. - self assert: d yearNumber = 2014. - self assert: d monthIndex = 6. - self assert: d dayOfMonth = 5. - - d _ (DateAndTime fromSeconds: 3579379200) date. - self assert: d yearNumber = 2014. - self assert: d monthIndex = 6. - self assert: d dayOfMonth = 5. - - d _ DateAndTime fromSeconds: 3579431284. - self assert: d yearNumber = 2014. - self assert: d monthIndex = 6. - self assert: d dayOfMonth = 5. - self assert: d hour = 14. - self assert: d minute = 28. - self assert: d second = 4. - self assert: d nanoSecond = 0! ! +!StringTest methodsFor: 'testing' stamp: 'HAW 6/8/2019 18:18:47'! +testWithoutSeparators -!DateAndTimeTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 14:53:59'! -testDayOfWeek + self assert: 'abc' equals: 'abc' withoutSeparators. + self assert: 'abc' equals: ' a b c ' withoutSeparators! ! - self assert: '13 May 2017 ' asDate dayOfWeek = 6. - self assert: '13 May 2017 ' asDate dayOfWeekName = #Saturday! ! +!StringTest methodsFor: 'testing' stamp: 'HAW 8/2/2018 20:35:32'! +testWithoutTrailingBlanks -!DateAndTimeTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 19:22:53'! -testInvalidOperations + self assert: 'abc' equals: 'abc ' withoutTrailingBlanks. + self assert: 'abc' equals: 'abc' withoutTrailingBlanks. + self assert: '' withoutTrailingBlanks isEmpty +! ! - self should: [ DateAndTime tomorrow - Week current ] raise: Error. - self should: [ DateAndTime tomorrow - Date today ] raise: Error! ! +!StringTest methodsFor: 'tests - grammar' stamp: 'LC 7/5/2020 16:47:10'! +testArticle + self + assert: 'euphemism' withArticle equals: 'a euphemism'; + assert: 'European' withArticle equals: 'a European'; + assert: 'Euclidean space' withArticle equals: 'a Euclidean space'; + assert: 'university' withArticle equals: 'a university'; + assert: 'anagram' withArticle equals: 'an anagram'; + assert: 'apple' withArticle equals: 'an apple'; + assert: 'Ukranian' withArticle equals: 'a Ukranian'; + assert: 'Argentine' withArticle equals: 'an Argentine'; + assert: 'user' withArticle equals: 'a user'! ! -!DateAndTimeTest methodsFor: 'tests' stamp: 'jpb 8/2/2019 23:33:37'! -testIsDateAndTime - self assert: (DateAndTime now is: #DateAndTime).! ! +!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 19:59:47'! +testIsNotValidBinarySelectorIfItContainsACharacterNotAllowed -!DateAndTimeTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 19:19:21'! -testLessDateAndTime + self deny: #'(' isValidSelector! ! - self assert: DateAndTime today - DateAndTime yesterday = 1 days. - self assert: DateAndTime today - DateAndTime tomorrow = -1 days. - self assert: DateAndTime tomorrow - DateAndTime yesterday = 2 days.! ! +!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 20:01:07'! +testIsNotValidKeywordSelectorIfItContainsSeparators -!DateAndTimeTest methodsFor: 'tests' stamp: 'jmv 6/5/2014 14:22'! -testOperations - " - self new testOperations - " - | d dt | - dt _ DateAndTime now. + self deny: #'between: and:' isValidSelector! ! - d _ 1 hours. - self assert: dt < (dt + d). - self assert: dt - d < dt. - self assert: dt + d - d = dt. +!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 19:52:35'! +testIsNotValidUnarySelectorIfItContainsCharactersUsedInBinarySelectors - d _ 1 minutes. - self assert: dt < (dt + d). - self assert: dt - d < dt. - self assert: dt + d - d = dt. + self deny: #'a+b' isValidSelector! ! - d _ 1 seconds. - self assert: dt < (dt + d). - self assert: dt - d < dt. - self assert: dt + d - d = dt. +!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 19:51:29'! +testIsNotValidUnarySelectorIfItStartsWithALetterAndContainsSeparators - d _ -1 hours. - self assert: dt < (dt - d). - self assert: dt + d < dt. - self assert: dt + d - d = dt. + self deny: #'with spaces' isValidSelector! ! - d _ -1 minutes. - self assert: dt < (dt - d). - self assert: dt + d < dt. - self assert: dt + d - d = dt. +!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 19:53:43'! +testIsValidBinarySelectorIfItContainsAnAllowedCharacterOrSequenceOfCharacters - d _ -1 seconds. - self assert: dt < (dt - d). - self assert: dt + d < dt. - self assert: dt + d - d = dt.! ! - -!DateAndTimeTest methodsFor: 'tests' stamp: 'jmv 4/27/2016 15:04'! -testToByDo - " - DateAndTimeTest new testToByDo - " - | end last start step | - start _ DateAndTime midnight. - end _ DateAndTime midnight + 2 hours. - step _ 15 minutes. - start to: end by: step do: [ :time | last _ time ]. - self assert: last = end! ! - -!DateTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 15:03:35'! -testCreation - - | date | - date _ '2014/6/30' asDate. - self assert: date yearNumber = 2014. - self assert: date monthIndex = 6. - self assert: date dayOfMonth = 30. + self + assert: #+ isValidSelector; + assert: #+-+ isValidSelector! ! - date _ '70/12/30' asDate. - self assert: date yearNumber = 1970. - self assert: date monthIndex = 12. - self assert: date dayOfMonth = 30. +!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 20:00:35'! +testIsValidKeywordSelectorIfItContainsKeywordsWithColons - date _ '12/30/70' asDate. - self assert: date yearNumber = 1970. - self assert: date monthIndex = 12. - self assert: date dayOfMonth = 30. + self + assert: #includes: isValidSelector; + assert: #between:and: isValidSelector! ! - date _ '30/12/70' asDate. - self assert: date yearNumber = 1970. - self assert: date monthIndex = 12. - self assert: date dayOfMonth = 30. +!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 19:50:31'! +testIsValidUnarySelectorIfItStartsWithALetterAndDoesNotContainSeparators - "Quite ambiguous, actually" - date _ '4/5/6' asDate. - self assert: date yearNumber = 2006. - self assert: date monthIndex = 4. - self assert: date dayOfMonth = 5. + self assert: #t234 isValidSelector! ! - date _ '15 April 1982' asDate. - self assert: date yearNumber = 1982. - self assert: date monthIndex = 4. - self assert: date dayOfMonth = 15.! ! +!UnicodeStringsTest methodsFor: 'testing' stamp: 'jmv 6/2/2022 15:14:24'! +test01 -!DateTest methodsFor: 'test operations' stamp: 'jmv 5/13/2017 19:23:12'! -testInvalidOperations + | asciiString asciiUtf32String asciiUtf8String latinString latinUtf32String latinUtf8String | + asciiString _ 'Hello world'. + latinString _ '¡Tomá agüita, Ñandú!!'. + asciiUtf8String _ asciiString asUtf8String. + latinUtf8String _ latinString asUtf8String. + asciiUtf32String _ asciiString asUtf32String. + latinUtf32String _ latinString asUtf32String. - self should: [ Date today - DateAndTime tomorrow ] raise: Error. - self should: [ Date today - Week current ] raise: Error.! ! + self assert: asciiString hash = asciiUtf8String hash. + self assert: asciiString hash = asciiUtf32String hash. + self assert: asciiString = asciiUtf8String. + self assert: asciiString = asciiUtf32String. + self assert: asciiUtf8String = asciiString. + self assert: asciiUtf8String = asciiUtf32String. + self assert: asciiUtf32String = asciiString. + self assert: asciiUtf32String = asciiUtf8String. -!DateTest methodsFor: 'test operations' stamp: 'jmv 5/13/2017 19:16:42'! -testLessDate + self assert: latinString hash = latinUtf8String hash. + self assert: latinString hash = latinUtf32String hash. + self assert: latinString = latinUtf8String. + self assert: latinString = latinUtf32String. + self assert: latinUtf8String = latinString. + self assert: latinUtf8String = latinUtf32String. + self assert: latinUtf32String = latinString. + self assert: latinUtf32String = latinUtf8String.! ! - self assert: Date today - Date yesterday = 1 days. - self assert: Date today - Date tomorrow = -1 days. - self assert: Date tomorrow start - Date yesterday start = 2 days.! ! +!UnicodeSymbolsTest methodsFor: 'testing' stamp: 'jmv 6/3/2022 11:37:33'! +test01AsciiSymbolFirst + "Try a few things with pure ASCII. + Do #asSymbol before doing #asUtf8Symbol. The symbol created will be instance of Symbol." + + | str symbol utf8 utf8Symbol | + str _ 'Stuff', Random next mantissaPart printString. + symbol _ str asSymbol. + utf8 _ str asUtf8String. + utf8Symbol _ utf8 asSymbol. -!DateTest methodsFor: 'test operations' stamp: 'jmv 5/13/2017 14:25:42'! -testLessDuration + self assert: str = str. + self assert: str == str. + self assert: symbol = symbol. + self assert: symbol == symbol. + self assert: utf8 = utf8. + self assert: utf8 == utf8. + self assert: utf8Symbol = utf8Symbol. + self assert: utf8Symbol == utf8Symbol. - self assert: '13 May 2017' asDate - 3 days = '10 May 2017' asDate! ! + self assert: str = symbol. + self assert: symbol = str. + self assert: utf8 = utf8Symbol. + self assert: utf8Symbol = utf8. -!DurationTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 14:56:00'! -testPrintString + self assert: str = utf8. + self assert: utf8 = str. + self assert: symbol = utf8Symbol. + self assert: utf8Symbol = symbol. - self assert: (Duration days: 2 hours: 3 minutes: 16 seconds: 43) printString = '2:03:16:43' ! ! + self assert: str = utf8Symbol. + self assert: utf8Symbol = str. + self assert: symbol = utf8. + self assert: utf8 = symbol. -!MonthTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 14:33:22'! -testCreation + self assert: utf8Symbol == symbol. + self assert: symbol == utf8Symbol.! ! - self assert: 'July 1998' asMonth yearNumber = 1998. - self assert: 'July 1998' asMonth monthIndex = 7. - self assert: 'July 1998' asMonth monthName = #July. +!UnicodeSymbolsTest methodsFor: 'testing' stamp: 'jmv 6/3/2022 11:37:42'! +test02LatinSymbolFirst + "Try a few things with pure ASCII. + Do #asSymbol before doing #asUtf8Symbol. The symbol created will be instance of Symbol." + + | str symbol utf8 utf8Symbol | + str _ '¡Tomá agüita, Ñandú!!', Random next mantissaPart printString. + symbol _ str asSymbol. + utf8 _ str asUtf8String. + utf8Symbol _ utf8 asSymbol. - self assert: '1998/7' asMonth yearNumber = 1998. - self assert: '1998/7' asMonth monthIndex = 7. - self assert: '1998/7' asMonth monthName = #July.! ! + self assert: str = str. + self assert: str == str. + self assert: symbol = symbol. + self assert: symbol == symbol. + self assert: utf8 = utf8. + self assert: utf8 == utf8. + self assert: utf8Symbol = utf8Symbol. + self assert: utf8Symbol == utf8Symbol. -!MonthTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 14:55:20'! -testPrintString + self assert: str = symbol. + self assert: symbol = str. + self assert: utf8 = utf8Symbol. + self assert: utf8Symbol = utf8. - self assert: 'July 1998' asMonth printString = 'July 1998'. - self assert: '1998/7' asMonth printString = 'July 1998'. -! ! + self assert: str = utf8. + self assert: utf8 = str. + self assert: symbol = utf8Symbol. + self assert: utf8Symbol = symbol. -!TimeTest methodsFor: 'tests' stamp: 'jmv 6/5/2014 14:32'! -testCreation - " - self new testCreation - " - | t | - - t _ Time seconds: 52262. - self assert: t hour = 14. - self assert: t minute = 31. - self assert: t second = 2. + self assert: str = utf8Symbol. + self assert: utf8Symbol = str. + self assert: symbol = utf8. + self assert: utf8 = symbol. - t _ Time seconds: 52262 nanoSeconds: 414712000. - self assert: t hour = 14. - self assert: t minute = 31. - self assert: t second = 2. - self assert: t nanoSecond = 414712000! ! + self assert: utf8Symbol == symbol. + self assert: symbol == utf8Symbol.! ! -!TimeTest methodsFor: 'tests' stamp: 'jmv 6/5/2014 14:34'! -testEqual - " - self new testEqual - " - | t1 t2 | +!UnicodeSymbolsTest methodsFor: 'testing' stamp: 'jmv 6/3/2022 11:38:22'! +test03AsciiUtf8SymbolFirst + "Try a few things with pure ASCII. + Do #asSymbol before doing #asUtf8Symbol. The symbol created will be instance of Symbol." - t1 _ Time seconds: 52262. - t2 _ Time seconds: 52262 nanoSeconds: 0. - self assert: t1 = t2. - t2 _ Time seconds: 52262 nanoSeconds: 1234. - self deny: t1 = t2. - t2 _ Time seconds: 52263 nanoSeconds: 0. - self deny: t1 = t2.! ! + | str symbol utf8 utf8Symbol | + str _ 'Stuff', Random next mantissaPart printString. + utf8 _ str asUtf8String. + utf8Symbol _ utf8 asSymbol. + symbol _ str asSymbol. -!TimeTest methodsFor: 'tests' stamp: 'jmv 11/11/2014 09:26'! -testTimePartsArePositive - self assert: (Time afterMidnight: -10 minutes) minute > 0. - self assert: (Time afterMidnight: -10 minutes) hour = 23. - self assert: (Time afterMidnight: -10 minutes) minute = 50.! ! + self assert: str = str. + self assert: str == str. + self assert: symbol = symbol. + self assert: symbol == symbol. + self assert: utf8 = utf8. + self assert: utf8 == utf8. + self assert: utf8Symbol = utf8Symbol. + self assert: utf8Symbol == utf8Symbol. -!TimeTest methodsFor: 'Tests' stamp: 'jmv 5/27/2014 22:46'! -testSqueakInquiries - | timewords | + self assert: str = symbol. + self assert: symbol = str. + self assert: utf8 = utf8Symbol. + self assert: utf8Symbol = utf8. - timewords := #(0.5 30 62 130 4000 10000 60000 86401) - collect: [ :ss | Time humanWordsForSecondsAgo: ss ]. - self assert: - timewords = #('a second ago' '30 seconds ago' 'a minute ago' '2 minutes ago' - 'an hour ago' '2 hours ago' '16 hours ago' 'yesterday').! ! + self assert: str = utf8. + self assert: utf8 = str. + self assert: symbol = utf8Symbol. + self assert: utf8Symbol = symbol. -!TimespanTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:42:40'! -testIsTimespan - self assert: (Timespan current is: #Timespan).! ! + self assert: str = utf8Symbol. + self assert: utf8Symbol = str. + self assert: symbol = utf8. + self assert: utf8 = symbol. -!WeekTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 15:29:29'! -testCreation + self assert: utf8Symbol == symbol. + self assert: symbol == utf8Symbol.! ! - | week | - week _ '2008-W52' asWeek. - self assert: week yearNumber = 2008. - self assert: week weekNumber = 52. - self assert: week start = '2008-12-22' asDate start. +!UnicodeSymbolsTest methodsFor: 'testing' stamp: 'jmv 6/3/2022 11:38:36'! +test04LatinUtf8SymbolFirst + "Try a few things with pure ASCII. + Do #asSymbol before doing #asUtf8Symbol. The symbol created will be instance of Symbol." + + | str symbol utf8 utf8Symbol | + str _ '¡Tomá agüita, Ñandú!!', Random next mantissaPart printString. + utf8 _ str asUtf8String. + utf8Symbol _ utf8 asSymbol. + symbol _ str asSymbol. - self should: [ '2008-W53' asWeek ] raise: Error. - self should: [ '2009-W54' asWeek ] raise: Error. + self assert: str = str. + self assert: str == str. + self assert: symbol = symbol. + self assert: symbol == symbol. + self assert: utf8 = utf8. + self assert: utf8 == utf8. + self assert: utf8Symbol = utf8Symbol. + self assert: utf8Symbol == utf8Symbol. - week _ '2009-W01' asWeek. - self assert: week yearNumber = 2009. - self assert: week weekNumber = 1. - self assert: week start = '2008-12-29' asDate start. + self assert: str = symbol. + self assert: symbol = str. + self assert: utf8 = utf8Symbol. + self assert: utf8Symbol = utf8. - week _ '2009-W02' asWeek. - self assert: week yearNumber = 2009. - self assert: week weekNumber = 2. - self assert: week start = '2009-1-5' asDate start. + self assert: str = utf8. + self assert: utf8 = str. + self assert: symbol = utf8Symbol. + self assert: utf8Symbol = symbol. - week _ '2009-W52' asWeek. - self assert: week yearNumber = 2009. - self assert: week weekNumber = 52. - self assert: week start = '2009-12-21' asDate start. + self assert: str = utf8Symbol. + self assert: utf8Symbol = str. + self assert: symbol = utf8. + self assert: utf8 = symbol. - week _ '2009-W53' asWeek. - self assert: week yearNumber = 2009. - self assert: week weekNumber = 53. - self assert: week start = '2009-12-28' asDate start. + self assert: utf8Symbol == symbol. + self assert: symbol == utf8Symbol.! ! - week _ '2010-W01' asWeek. - self assert: week yearNumber = 2010. - self assert: week weekNumber = 1. - self assert: week start = '2010-1-4' asDate start. +!UnicodeTest methodsFor: 'set up' stamp: 'jmv 5/31/2016 11:24'! +setUp + " + self new setUp + " - week _ '2010-W02' asWeek. - self assert: week yearNumber = 2010. - self assert: week weekNumber = 2. - self assert: week start = '2010-1-11' asDate start.! ! + bytesOfExample1 := #[16r61 16r62 16r63 16r20 16rC3 16rA0 16rC3 16rA8 16rE2 + 16r82 16rAC 16r20 16rCE 16rB1 16rCE 16rB2 16rCE 16rB3]. + + "see UnicodeNotes.md" + + "write the bytes of an UFT8 encoded string in binary mode to a file" + self class fileName asFileEntry forceWriteStreamDo: [ :stream | + stream binary. + stream nextPutAll: bytesOfExample1 ]! ! -!WeekTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 15:28:58'! -testIncluding +!UnicodeTest methodsFor: 'testing' stamp: 'jmv 10/3/2015 20:03'! +test1ReadBinary + + "see UnicodeNotes.md" + " + self new setUp test1ReadBinary + " + | content | + content := self class fileName asFileEntry binaryContents. + self assert: content = bytesOfExample1! ! - | week | - week _ Week including: '12 May 2017 ' asDate start. - self assert: week = '2017-W19' asWeek. - self assert: week start dayOfWeekName = #Monday. +!UnicodeTest methodsFor: 'testing' stamp: 'jmv 10/3/2015 20:04'! +test2ReadWithOutBinary + + "see UnicodeNotes.md" + " + self new setUp test2ReadWithOutBinary + " + | content | + content := self class fileName asFileEntry textContents. + self deny: content = bytesOfExample1! ! - week _ Week including: '12 May 2017 ' asDate. - self assert: week = '2017-W19' asWeek. - self assert: week start dayOfWeekName = #Monday. +!UnicodeTest methodsFor: 'testing' stamp: 'jmv 5/26/2022 12:01:13'! +test3ReadUtf8 + + "see UnicodeNotes.md" + " + self new setUp test3ReadUtf8 + " + | content byteArray | + byteArray _ self class fileName asFileEntry binaryContents. + content := String fromUtf8Bytes: byteArray. + self assert: content = 'abc àè¤ ˆ‰Š'! ! - week _ Week including: '2010/1/3' asDate start. - self assert: week = '2009W53' asWeek. - self assert: week start dayOfWeekName = #Monday. +!UnicodeTest methodsFor: 'testing' stamp: 'jmv 5/26/2022 12:00:15'! +test4BackConversion + + "see UnicodeNotes.md" + + " + self new setUp test4BackConversion + " + | contentInternalString contentByteArray | - week _ Week including: '2010/1/3' asDate. - self assert: week = '2009W53' asWeek. - self assert: week start dayOfWeekName = #Monday. + contentInternalString := String fromUtf8Bytes: self class fileName asFileEntry binaryContents. + contentByteArray := self class fileName asFileEntry binaryContents. - self should: [ Week including: (Year including: Date today) ] raise: Error! ! + self assert: contentByteArray = (contentInternalString asUtf8Bytes: true)! ! -!WeekTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 19:22:16'! -testInvalidOperations +!UnicodeTest methodsFor: 'testing' stamp: 'jmv 5/26/2022 12:00:29'! +test5ReadWriteUtf8 + + "see UnicodeNotes.md" + + " + self new setUp test5ReadWriteUtf8 + " + | content byteArray byteArray2 | - self should: [ Week current - Date tomorrow ] raise: Error. - self should: [ Week current - DateAndTime tomorrow ] raise: Error.! ! + "read UTF8 Unicode file into internal string with NCRs" + "for NCR see http://en.wikipedia.org/wiki/Numeric_character_reference" + + byteArray := self class fileName asFileEntry binaryContents. + content := String fromUtf8Bytes: byteArray. + "NCRs were added to 'content' as needed" -!WeekTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 14:55:27'! -testPrintString + "write internal string back to UTF8 file with NCRs converted back to UTF8 chars" + self class fileName2 asFileEntry forceWriteStreamDo: [ :stream | + stream binary. + stream nextPutAll: (content asUtf8Bytes: true). "true means: convert NCRs back to UTF8" + ]. - { - '2008-W52'. - '2009-W01'. - '2009-W02'. - '2009-W52'. - '2009-W53'. - '2010-W01'. - '2010-W02'. - } do: [ :string | - self assert: string asWeek printString = string ]! ! + "compare the two versions: what is in file 'fileName' with what is in file 'fileName2'" + byteArray := self class fileName asFileEntry binaryContents. + byteArray2 := self class fileName2 asFileEntry binaryContents. + self assert: byteArray = byteArray2! ! -!WeekTest methodsFor: 'test class methods' stamp: 'jmv 5/13/2017 14:58:57'! -testWeekDayNames +!UnicodeTest class methodsFor: 'as yet unclassified' stamp: 'hjh 2/12/2013 19:25'! +fileName + ^'UTF8abc-test.txt'! ! - self assert: (Week indexOfDay: #Sunday) = 7. - self assert: (Week nameOfDay: 7) = #Sunday! ! +!UnicodeTest class methodsFor: 'as yet unclassified' stamp: 'hjh 2/12/2013 21:35'! +fileName2 + ^'UTF8abc-test2.txt'! ! -!YearTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 15:19:06'! +!DateAndTimeTest methodsFor: 'tests' stamp: 'jmv 6/5/2014 14:29'! testCreation + " + self new testCreation + " + | d | + d _ (DateAndTime julianDayNumber: 2456814) date. + self assert: d yearNumber = 2014. + self assert: d monthIndex = 6. + self assert: d dayOfMonth = 5. + + d _ (DateAndTime fromSeconds: 3579379200) date. + self assert: d yearNumber = 2014. + self assert: d monthIndex = 6. + self assert: d dayOfMonth = 5. + + d _ DateAndTime fromSeconds: 3579431284. + self assert: d yearNumber = 2014. + self assert: d monthIndex = 6. + self assert: d dayOfMonth = 5. + self assert: d hour = 14. + self assert: d minute = 28. + self assert: d second = 4. + self assert: d nanoSecond = 0! ! - self assert: (Year yearNumber: 1998) yearNumber = 1998. - self assert: '2008' asYear yearNumber = 2008. - self assert: '2008' asYear start = '2008/01/01' asDate start! ! - -!YearTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 15:17:42'! -testIncluding - - self assert: (Year including: '12 May 2017 ' asDate start) yearNumber = 2017. - self assert: (Year including: (Week including: '12 May 2017 ' asDate start)) yearNumber = 2017! ! +!DateAndTimeTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 14:53:59'! +testDayOfWeek -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:03:52'! -test01withPropertiesDoIfSelectorEvaluatesFirstBlockWhenMethodHasProperties + self assert: '13 May 2017 ' asDate dayOfWeek = 6. + self assert: '13 May 2017 ' asDate dayOfWeekName = #Saturday! ! - | thisMethod propertyName methodProperties | - - propertyName := #testProperty. - thisMethod := self class>>thisContext selector. - thisMethod propertyValueAt: propertyName put: true. +!DateAndTimeTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 19:22:53'! +testInvalidOperations - thisMethod - withPropertiesDo: [ :properties | methodProperties := properties ] - ifSelector: [ self fail ]. - - "I don't assert inside the block because if no block is evaluated the test passes - Hernan" - self assert: (methodProperties at: propertyName)! ! + self should: [ DateAndTime tomorrow - Week current ] raise: Error. + self should: [ DateAndTime tomorrow - Date today ] raise: Error! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:04:31'! -test02removePropertiesRestoresPenultimalLiteralToSelector +!DateAndTimeTest methodsFor: 'tests' stamp: 'jpb 8/2/2019 23:33:37'! +testIsDateAndTime + self assert: (DateAndTime now is: #DateAndTime).! ! - | thisMethod propertyName | - - propertyName := #testProperty. - thisMethod := self class>>thisContext selector. - thisMethod propertyValueAt: propertyName put: true. - thisMethod removeProperties. +!DateAndTimeTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 19:19:21'! +testLessDateAndTime - self assert: thisMethod penultimateLiteral equals: thisContext selector. - ! ! + self assert: DateAndTime today - DateAndTime yesterday = 1 days. + self assert: DateAndTime today - DateAndTime tomorrow = -1 days. + self assert: DateAndTime tomorrow - DateAndTime yesterday = 2 days.! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:04:52'! -test03removePropertiesKeepsSelectorIfMethodDoesNotHaveProperties +!DateAndTimeTest methodsFor: 'tests' stamp: 'jmv 6/5/2014 14:22'! +testOperations + " + self new testOperations + " + | d dt | + dt _ DateAndTime now. - | thisMethod | - - thisMethod := self class>>thisContext selector. - "I have to remove it twice because when running with live typing methods always have method properties - Hernan" - thisMethod removeProperties. - thisMethod removeProperties. + d _ 1 hours. + self assert: dt < (dt + d). + self assert: dt - d < dt. + self assert: dt + d - d = dt. - self assert: thisMethod penultimateLiteral equals: thisContext selector. - ! ! + d _ 1 minutes. + self assert: dt < (dt + d). + self assert: dt - d < dt. + self assert: dt + d - d = dt. -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:05:22'! -test04withPropertiesDoIfSelectorEvaluatesSecondBlockWhenMethodHasNoProperties + d _ 1 seconds. + self assert: dt < (dt + d). + self assert: dt - d < dt. + self assert: dt + d - d = dt. - | thisMethod methodSelector | - - thisMethod := self class>>thisContext selector. - thisMethod removeProperties. - - thisMethod - withPropertiesDo: [ :properties | self fail ] - ifSelector: [ :selector | methodSelector := selector ]. - - "I don't assert inside the block because if no block is evaluated the test passes - Hernan" - self assert: methodSelector equals: thisContext selector! ! + d _ -1 hours. + self assert: dt < (dt - d). + self assert: dt + d < dt. + self assert: dt + d - d = dt. -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:05:40'! -test05hasLiteralSuchThatTravelsListeralsWhenMethodHasProperties + d _ -1 minutes. + self assert: dt < (dt - d). + self assert: dt + d < dt. + self assert: dt + d - d = dt. - | thisMethod | - - thisMethod := self class>>thisContext selector. - thisMethod propertyValueAt: #testProperty put: true. - - self assert: (thisMethod hasLiteralSuchThat: [ :aLiteral | aLiteral = #class ]). - - ! ! + d _ -1 seconds. + self assert: dt < (dt - d). + self assert: dt + d < dt. + self assert: dt + d - d = dt.! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:05:54'! -test06hasLiteralSuchThatTravelsListeralsWhenMethodHasNoProperties +!DateAndTimeTest methodsFor: 'tests' stamp: 'jmv 4/27/2016 15:04'! +testToByDo + " + DateAndTimeTest new testToByDo + " + | end last start step | + start _ DateAndTime midnight. + end _ DateAndTime midnight + 2 hours. + step _ 15 minutes. + start to: end by: step do: [ :time | last _ time ]. + self assert: last = end! ! - | thisMethod | - - thisMethod := self class>>thisContext selector. - thisMethod removeProperties. - - self assert: (thisMethod hasLiteralSuchThat: [ :aLiteral | aLiteral = #class ]). - - ! ! +!DateTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 15:03:35'! +testCreation -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:06:51'! -test0701withPropertiesDoReturnsNilIfMethodHasNoProperties + | date | + date _ '2014/6/30' asDate. + self assert: date yearNumber = 2014. + self assert: date monthIndex = 6. + self assert: date dayOfMonth = 30. - | thisMethod | - - thisMethod := self class>>thisContext selector. - thisMethod removeProperties. + date _ '70/12/30' asDate. + self assert: date yearNumber = 1970. + self assert: date monthIndex = 12. + self assert: date dayOfMonth = 30. - self assert: (thisMethod withPropertiesDo: [ :properties | self fail ]) isNil! ! + date _ '12/30/70' asDate. + self assert: date yearNumber = 1970. + self assert: date monthIndex = 12. + self assert: date dayOfMonth = 30. -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:07:21'! -test07withPropertiesDoEvaluatesBlockOnlyWhenMethodHasProperties + date _ '30/12/70' asDate. + self assert: date yearNumber = 1970. + self assert: date monthIndex = 12. + self assert: date dayOfMonth = 30. - | thisMethod propertyName methodProperties | - - propertyName := #testProperty. - thisMethod := self class>>thisContext selector. - thisMethod propertyValueAt: propertyName put: true. + "Quite ambiguous, actually" + date _ '4/5/6' asDate. + self assert: date yearNumber = 2006. + self assert: date monthIndex = 4. + self assert: date dayOfMonth = 5. - thisMethod withPropertiesDo: [ :properties | methodProperties := properties ]. - - "I don't assert inside the block because if no block is evaluated the test passes - Hernan" - self assert: (methodProperties at: propertyName)! ! + date _ '15 April 1982' asDate. + self assert: date yearNumber = 1982. + self assert: date monthIndex = 4. + self assert: date dayOfMonth = 15.! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:07:47'! -test08hasLiteralThoroughReturnTrueWhenMethodHasPropertiesAndHasLiteral +!DateTest methodsFor: 'test operations' stamp: 'jmv 5/13/2017 19:23:12'! +testInvalidOperations - | thisMethod | - - thisMethod := self class>>thisContext selector. - thisMethod propertyValueAt: #testProperty put: true. - - self assert: (thisMethod hasLiteralThorough: #class). - - ! ! + self should: [ Date today - DateAndTime tomorrow ] raise: Error. + self should: [ Date today - Week current ] raise: Error.! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:08:08'! -test09hasLiteralThoroughReturnFalseWhenMethodHasPropertiesAndHasNoLiteral +!DateTest methodsFor: 'test operations' stamp: 'jmv 5/13/2017 19:16:42'! +testLessDate - | thisMethod | - - thisMethod := self class>>thisContext selector. - thisMethod propertyValueAt: #testProperty put: true. - - self deny: (thisMethod hasLiteralThorough: 'abc' asSymbol). - - ! ! + self assert: Date today - Date yesterday = 1 days. + self assert: Date today - Date tomorrow = -1 days. + self assert: Date tomorrow start - Date yesterday start = 2 days.! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:08:21'! -test10hasLiteralThoroughReturnTrueWhenMethodHasNoPropertiesAndHasLiteral +!DateTest methodsFor: 'test operations' stamp: 'jmv 5/13/2017 14:25:42'! +testLessDuration - | thisMethod | - - thisMethod := self class>>thisContext selector. - thisMethod removeProperties. - - self assert: (thisMethod hasLiteralThorough: #class). - - ! ! + self assert: '13 May 2017' asDate - 3 days = '10 May 2017' asDate! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:08:34'! -test11hasLiteralThoroughReturnFalseWhenMethodHasNoPropertiesAndHasNoLiteral +!DurationTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 14:56:00'! +testPrintString - | thisMethod | - - thisMethod := self class>>thisContext selector. - thisMethod removeProperties. - - self deny: (thisMethod hasLiteralThorough: 'abc' asSymbol). - - ! ! + self assert: (Duration days: 2 hours: 3 minutes: 16 seconds: 43) printString = '2:03:16:43' ! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:08:51'! -test12pragmaAtReturnsPragmaIfExist +!MonthTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 14:33:22'! +testCreation - - - | thisMethod | - - thisMethod := self class>>thisContext selector. - - self assert: (thisMethod pragmaAt: #test) key equals: #test! ! + self assert: 'July 1998' asMonth yearNumber = 1998. + self assert: 'July 1998' asMonth monthIndex = 7. + self assert: 'July 1998' asMonth monthName = #July. -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:09:07'! -test13pragmaAtReturnsNilIfPragmaDoesNotExist + self assert: '1998/7' asMonth yearNumber = 1998. + self assert: '1998/7' asMonth monthIndex = 7. + self assert: '1998/7' asMonth monthName = #July.! ! - | thisMethod | - - thisMethod := self class>>thisContext selector. - - self assert: (thisMethod pragmaAt: #test) isNil! ! +!MonthTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 14:55:20'! +testPrintString -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:09:26'! -test14pragmasReturnsCollectionOfMethodPragmas + self assert: 'July 1998' asMonth printString = 'July 1998'. + self assert: '1998/7' asMonth printString = 'July 1998'. +! ! - - - | thisMethod pragmas | - - thisMethod := self class>>thisContext selector. - pragmas := thisMethod pragmas. +!TimeTest methodsFor: 'tests' stamp: 'jmv 6/5/2014 14:32'! +testCreation + " + self new testCreation + " + | t | - self assert: pragmas size equals: 1. - self assert: pragmas first key equals: #test! ! + t _ Time seconds: 52262. + self assert: t hour = 14. + self assert: t minute = 31. + self assert: t second = 2. -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:09:49'! -test15pragmasReturnsEmptyCollectionWhenMethodHasNoProperties + t _ Time seconds: 52262 nanoSeconds: 414712000. + self assert: t hour = 14. + self assert: t minute = 31. + self assert: t second = 2. + self assert: t nanoSecond = 414712000! ! - | thisMethod pragmas | - - thisMethod := self class>>thisContext selector. - thisMethod removeProperties. - pragmas := thisMethod pragmas. +!TimeTest methodsFor: 'tests' stamp: 'jmv 6/5/2014 14:34'! +testEqual + " + self new testEqual + " + | t1 t2 | - self assert: pragmas isEmpty ! ! - -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:14:18'! -test16propertiesReturnsAnNewAdditionalMethodStateWhenNoPropertiesHasBeenSet - - | thisMethod properties | - - thisMethod := self class>>thisContext selector. - thisMethod removeProperties. - - properties := thisMethod properties. - - self assert: properties isEmpty. - self assert: properties selector equals: thisContext selector. - self deny: properties == thisMethod properties ! ! + t1 _ Time seconds: 52262. + t2 _ Time seconds: 52262 nanoSeconds: 0. + self assert: t1 = t2. + t2 _ Time seconds: 52262 nanoSeconds: 1234. + self deny: t1 = t2. + t2 _ Time seconds: 52263 nanoSeconds: 0. + self deny: t1 = t2.! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:14:35'! -test17propertiesReturnsTheAlreadySetAdditionalMethodStateWhenHasProperties +!TimeTest methodsFor: 'tests' stamp: 'jmv 11/11/2014 09:26'! +testTimePartsArePositive + self assert: (Time afterMidnight: -10 minutes) minute > 0. + self assert: (Time afterMidnight: -10 minutes) hour = 23. + self assert: (Time afterMidnight: -10 minutes) minute = 50.! ! - | propertyName thisMethod properties | +!TimeTest methodsFor: 'Tests' stamp: 'jmv 5/27/2014 22:46'! +testSqueakInquiries + | timewords | + + timewords := #(0.5 30 62 130 4000 10000 60000 86401) + collect: [ :ss | Time humanWordsForSecondsAgo: ss ]. + self assert: + timewords = #('a second ago' '30 seconds ago' 'a minute ago' '2 minutes ago' + 'an hour ago' '2 hours ago' '16 hours ago' 'yesterday').! ! + +!TimespanTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:42:40'! +testIsTimespan + self assert: (Timespan current is: #Timespan).! ! + +!WeekTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 15:29:29'! +testCreation + + | week | + week _ '2008-W52' asWeek. + self assert: week yearNumber = 2008. + self assert: week weekNumber = 52. + self assert: week start = '2008-12-22' asDate start. + + self should: [ '2008-W53' asWeek ] raise: Error. + self should: [ '2009-W54' asWeek ] raise: Error. + + week _ '2009-W01' asWeek. + self assert: week yearNumber = 2009. + self assert: week weekNumber = 1. + self assert: week start = '2008-12-29' asDate start. + + week _ '2009-W02' asWeek. + self assert: week yearNumber = 2009. + self assert: week weekNumber = 2. + self assert: week start = '2009-1-5' asDate start. + + week _ '2009-W52' asWeek. + self assert: week yearNumber = 2009. + self assert: week weekNumber = 52. + self assert: week start = '2009-12-21' asDate start. + + week _ '2009-W53' asWeek. + self assert: week yearNumber = 2009. + self assert: week weekNumber = 53. + self assert: week start = '2009-12-28' asDate start. + + week _ '2010-W01' asWeek. + self assert: week yearNumber = 2010. + self assert: week weekNumber = 1. + self assert: week start = '2010-1-4' asDate start. + + week _ '2010-W02' asWeek. + self assert: week yearNumber = 2010. + self assert: week weekNumber = 2. + self assert: week start = '2010-1-11' asDate start.! ! + +!WeekTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 15:28:58'! +testIncluding + + | week | + week _ Week including: '12 May 2017 ' asDate start. + self assert: week = '2017-W19' asWeek. + self assert: week start dayOfWeekName = #Monday. + + week _ Week including: '12 May 2017 ' asDate. + self assert: week = '2017-W19' asWeek. + self assert: week start dayOfWeekName = #Monday. + + week _ Week including: '2010/1/3' asDate start. + self assert: week = '2009W53' asWeek. + self assert: week start dayOfWeekName = #Monday. + + week _ Week including: '2010/1/3' asDate. + self assert: week = '2009W53' asWeek. + self assert: week start dayOfWeekName = #Monday. + + self should: [ Week including: (Year including: Date today) ] raise: Error! ! + +!WeekTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 19:22:16'! +testInvalidOperations + + self should: [ Week current - Date tomorrow ] raise: Error. + self should: [ Week current - DateAndTime tomorrow ] raise: Error.! ! + +!WeekTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 14:55:27'! +testPrintString + + { + '2008-W52'. + '2009-W01'. + '2009-W02'. + '2009-W52'. + '2009-W53'. + '2010-W01'. + '2010-W02'. + } do: [ :string | + self assert: string asWeek printString = string ]! ! + +!WeekTest methodsFor: 'test class methods' stamp: 'jmv 5/13/2017 14:58:57'! +testWeekDayNames + + self assert: (Week indexOfDay: #Sunday) = 7. + self assert: (Week nameOfDay: 7) = #Sunday! ! + +!YearTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 15:19:06'! +testCreation + + self assert: (Year yearNumber: 1998) yearNumber = 1998. + self assert: '2008' asYear yearNumber = 2008. + self assert: '2008' asYear start = '2008/01/01' asDate start! ! + +!YearTest methodsFor: 'tests' stamp: 'jmv 5/13/2017 15:17:42'! +testIncluding + + self assert: (Year including: '12 May 2017 ' asDate start) yearNumber = 2017. + self assert: (Year including: (Week including: '12 May 2017 ' asDate start)) yearNumber = 2017! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:03:52'! +test01withPropertiesDoIfSelectorEvaluatesFirstBlockWhenMethodHasProperties + + | thisMethod propertyName methodProperties | propertyName := #testProperty. thisMethod := self class>>thisContext selector. thisMethod propertyValueAt: propertyName put: true. + + thisMethod + withPropertiesDo: [ :properties | methodProperties := properties ] + ifSelector: [ self fail ]. - properties := thisMethod properties. - self assert: (properties includesKey: propertyName). - self assert: properties selector equals: thisContext selector. - ! ! + "I don't assert inside the block because if no block is evaluated the test passes - Hernan" + self assert: (methodProperties at: propertyName)! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:17:28'! -test18propertyKeysAndValuesDoIteratesOverProperties +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:04:31'! +test02removePropertiesRestoresPenultimalLiteralToSelector - | propertyName thisMethod properties | + | thisMethod propertyName | propertyName := #testProperty. thisMethod := self class>>thisContext selector. thisMethod propertyValueAt: propertyName put: true. - - properties := OrderedCollection new. - thisMethod propertyKeysAndValuesDo: [ :key :value | properties add: key -> value ]. - - self assert: properties size equals: 1. - self assert: properties first equals: propertyName -> true! ! + thisMethod removeProperties. -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:20:11'! -test19propertyKeysAndValuesDoDoesNotEvaluateBlockWhenMethodHasNoProperties + self assert: thisMethod penultimateLiteral equals: thisContext selector. + ! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:04:52'! +test03removePropertiesKeepsSelectorIfMethodDoesNotHaveProperties | thisMethod | thisMethod := self class>>thisContext selector. + "I have to remove it twice because when running with live typing methods always have method properties - Hernan" + thisMethod removeProperties. thisMethod removeProperties. - - thisMethod propertyKeysAndValuesDo: [ :key :value | self fail ]! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 16:58:44'! -test20propertyValueAtReturnsPropertyValueWhenSetted + self assert: thisMethod penultimateLiteral equals: thisContext selector. + ! ! - | propertyName propertyValue thisMethod | +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:05:22'! +test04withPropertiesDoIfSelectorEvaluatesSecondBlockWhenMethodHasNoProperties + + | thisMethod methodSelector | - propertyName := #testProperty. - propertyValue := 1. thisMethod := self class>>thisContext selector. - thisMethod propertyValueAt: propertyName put: propertyValue. + thisMethod removeProperties. - self assert: (thisMethod propertyValueAt: propertyName) equals: propertyValue ! ! + thisMethod + withPropertiesDo: [ :properties | self fail ] + ifSelector: [ :selector | methodSelector := selector ]. + + "I don't assert inside the block because if no block is evaluated the test passes - Hernan" + self assert: methodSelector equals: thisContext selector! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 16:56:20'! -test21propertyValueAtReturnsNilWhenPropertyIsNotFound +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:05:40'! +test05hasLiteralSuchThatTravelsListeralsWhenMethodHasProperties | thisMethod | thisMethod := self class>>thisContext selector. - thisMethod propertyValueAt: #testProperty put: 1. + thisMethod propertyValueAt: #testProperty put: true. - self assert: (thisMethod propertyValueAt: #abc) isNil! ! + self assert: (thisMethod hasLiteralSuchThat: [ :aLiteral | aLiteral = #class ]). + + ! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 16:55:00'! -test22propertyValueAtReturnsNilWhenMethodHasNoProperties +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:05:54'! +test06hasLiteralSuchThatTravelsListeralsWhenMethodHasNoProperties | thisMethod | thisMethod := self class>>thisContext selector. thisMethod removeProperties. - self assert: (thisMethod propertyValueAt: #testProperty) isNil! ! + self assert: (thisMethod hasLiteralSuchThat: [ :aLiteral | aLiteral = #class ]). + + ! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 16:58:18'! -test23propertyValueAtIfAbsetReturnsPropertyValueWhenFound +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:06:51'! +test0701withPropertiesDoReturnsNilIfMethodHasNoProperties - | propertyName propertyValue thisMethod | + | thisMethod | - propertyName := #testProperty. - propertyValue := 1. thisMethod := self class>>thisContext selector. - thisMethod propertyValueAt: propertyName put: propertyValue. - - self assert: (thisMethod propertyValueAt: propertyName ifAbsent: [ self fail ]) equals: propertyValue ! ! + thisMethod removeProperties. -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 16:59:33'! -test24propertyValueAtIfAbsetEvaluatesIfAbsentBlockWhenNotFound + self assert: (thisMethod withPropertiesDo: [ :properties | self fail ]) isNil! ! - | propertyName propertyValue thisMethod | +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:07:21'! +test07withPropertiesDoEvaluatesBlockOnlyWhenMethodHasProperties + + | thisMethod propertyName methodProperties | propertyName := #testProperty. - propertyValue := 1. thisMethod := self class>>thisContext selector. - thisMethod propertyValueAt: propertyName put: propertyValue. + thisMethod propertyValueAt: propertyName put: true. + + thisMethod withPropertiesDo: [ :properties | methodProperties := properties ]. - self assert: (thisMethod propertyValueAt: #abc ifAbsent: [ propertyValue + 1]) equals: propertyValue + 1 ! ! + "I don't assert inside the block because if no block is evaluated the test passes - Hernan" + self assert: (methodProperties at: propertyName)! ! -!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/7/2019 15:39:17'! -test25propertyValueAtIfAbsetEvaluatesIfAbsentBlockWhenMethodHasNoProperties +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:07:47'! +test08hasLiteralThoroughReturnTrueWhenMethodHasPropertiesAndHasLiteral | thisMethod | thisMethod := self class>>thisContext selector. - thisMethod removeProperties. + thisMethod propertyValueAt: #testProperty put: true. - self assert: (thisMethod propertyValueAt: #testProperty ifAbsent: [ 1 ]) equals: 1! ! + self assert: (thisMethod hasLiteralThorough: #class). + + ! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:08:08'! +test09hasLiteralThoroughReturnFalseWhenMethodHasPropertiesAndHasNoLiteral + + | thisMethod | + + thisMethod := self class>>thisContext selector. + thisMethod propertyValueAt: #testProperty put: true. + + self deny: (thisMethod hasLiteralThorough: 'abc' asSymbol). + + ! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:08:21'! +test10hasLiteralThoroughReturnTrueWhenMethodHasNoPropertiesAndHasLiteral + + | thisMethod | + + thisMethod := self class>>thisContext selector. + thisMethod removeProperties. + + self assert: (thisMethod hasLiteralThorough: #class). + + ! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:08:34'! +test11hasLiteralThoroughReturnFalseWhenMethodHasNoPropertiesAndHasNoLiteral + + | thisMethod | + + thisMethod := self class>>thisContext selector. + thisMethod removeProperties. + + self deny: (thisMethod hasLiteralThorough: 'abc' asSymbol). + + ! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:08:51'! +test12pragmaAtReturnsPragmaIfExist + + + + | thisMethod | + + thisMethod := self class>>thisContext selector. + + self assert: (thisMethod pragmaAt: #test) key equals: #test! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:09:07'! +test13pragmaAtReturnsNilIfPragmaDoesNotExist + + | thisMethod | + + thisMethod := self class>>thisContext selector. + + self assert: (thisMethod pragmaAt: #test) isNil! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:09:26'! +test14pragmasReturnsCollectionOfMethodPragmas + + + + | thisMethod pragmas | + + thisMethod := self class>>thisContext selector. + pragmas := thisMethod pragmas. + + self assert: pragmas size equals: 1. + self assert: pragmas first key equals: #test! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:09:49'! +test15pragmasReturnsEmptyCollectionWhenMethodHasNoProperties + + | thisMethod pragmas | + + thisMethod := self class>>thisContext selector. + thisMethod removeProperties. + pragmas := thisMethod pragmas. + + self assert: pragmas isEmpty ! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:14:18'! +test16propertiesReturnsAnNewAdditionalMethodStateWhenNoPropertiesHasBeenSet + + | thisMethod properties | + + thisMethod := self class>>thisContext selector. + thisMethod removeProperties. + + properties := thisMethod properties. + + self assert: properties isEmpty. + self assert: properties selector equals: thisContext selector. + self deny: properties == thisMethod properties ! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:14:35'! +test17propertiesReturnsTheAlreadySetAdditionalMethodStateWhenHasProperties + + | propertyName thisMethod properties | + + propertyName := #testProperty. + thisMethod := self class>>thisContext selector. + thisMethod propertyValueAt: propertyName put: true. + + properties := thisMethod properties. + self assert: (properties includesKey: propertyName). + self assert: properties selector equals: thisContext selector. + ! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:17:28'! +test18propertyKeysAndValuesDoIteratesOverProperties + + | propertyName thisMethod properties | + + propertyName := #testProperty. + thisMethod := self class>>thisContext selector. + thisMethod propertyValueAt: propertyName put: true. + + properties := OrderedCollection new. + thisMethod propertyKeysAndValuesDo: [ :key :value | properties add: key -> value ]. + + self assert: properties size equals: 1. + self assert: properties first equals: propertyName -> true! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 07:20:11'! +test19propertyKeysAndValuesDoDoesNotEvaluateBlockWhenMethodHasNoProperties + + | thisMethod | + + thisMethod := self class>>thisContext selector. + thisMethod removeProperties. + + thisMethod propertyKeysAndValuesDo: [ :key :value | self fail ]! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 16:58:44'! +test20propertyValueAtReturnsPropertyValueWhenSetted + + | propertyName propertyValue thisMethod | + + propertyName := #testProperty. + propertyValue := 1. + thisMethod := self class>>thisContext selector. + thisMethod propertyValueAt: propertyName put: propertyValue. + + self assert: (thisMethod propertyValueAt: propertyName) equals: propertyValue ! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 16:56:20'! +test21propertyValueAtReturnsNilWhenPropertyIsNotFound + + | thisMethod | + + thisMethod := self class>>thisContext selector. + thisMethod propertyValueAt: #testProperty put: 1. + + self assert: (thisMethod propertyValueAt: #abc) isNil! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 16:55:00'! +test22propertyValueAtReturnsNilWhenMethodHasNoProperties + + | thisMethod | + + thisMethod := self class>>thisContext selector. + thisMethod removeProperties. + + self assert: (thisMethod propertyValueAt: #testProperty) isNil! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 16:58:18'! +test23propertyValueAtIfAbsetReturnsPropertyValueWhenFound + + | propertyName propertyValue thisMethod | + + propertyName := #testProperty. + propertyValue := 1. + thisMethod := self class>>thisContext selector. + thisMethod propertyValueAt: propertyName put: propertyValue. + + self assert: (thisMethod propertyValueAt: propertyName ifAbsent: [ self fail ]) equals: propertyValue ! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/3/2019 16:59:33'! +test24propertyValueAtIfAbsetEvaluatesIfAbsentBlockWhenNotFound + + | propertyName propertyValue thisMethod | + + propertyName := #testProperty. + propertyValue := 1. + thisMethod := self class>>thisContext selector. + thisMethod propertyValueAt: propertyName put: propertyValue. + + self assert: (thisMethod propertyValueAt: #abc ifAbsent: [ propertyValue + 1]) equals: propertyValue + 1 ! ! + +!CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/7/2019 15:39:17'! +test25propertyValueAtIfAbsetEvaluatesIfAbsentBlockWhenMethodHasNoProperties + + | thisMethod | + + thisMethod := self class>>thisContext selector. + thisMethod removeProperties. + + self assert: (thisMethod propertyValueAt: #testProperty ifAbsent: [ 1 ]) equals: 1! ! !CompiledMethodTest methodsFor: 'tests - properties' stamp: 'HAW 1/7/2019 15:44:05'! test26propertyValueAtPutCreatesPropertiesWithNewOne @@ -12116,16517 +12365,17952 @@ testWaitTimeoutMSecs self assert: (Semaphore new signal waitTimeoutMSecs: 50) == false. ! ! -!ArrayTest methodsFor: 'test - insert:ShiftingRight:' stamp: 'HAW 12/20/2018 14:41:00'! -testCanNotInsertShiftingRightWhenInsertionPointIsBiggerThanSize - - | arrayToInsertTo invalidIndex | - - arrayToInsertTo := #(1 2 3) copy. - invalidIndex := arrayToInsertTo size + 1. - - self - should: [ arrayToInsertTo insert: 0 shiftingRightAt: invalidIndex ] - raise: Error - MessageNotUnderstood - withExceptionDo: [ :anError | - self assert: anError messageText equals: (Object errorDescriptionForSubcriptBounds: invalidIndex). - self assert: arrayToInsertTo equals: #(1 2 3) ].! ! - -!ArrayTest methodsFor: 'test - insert:ShiftingRight:' stamp: 'HAW 12/20/2018 14:39:47'! -testCanNotInsertShiftingRightWhenInsertionPointIsLessThanOne - - | arrayToInsertTo invalidIndex | - - arrayToInsertTo := #(1 2 3) copy. - invalidIndex := 0. - - self - should: [ arrayToInsertTo insert: 0 shiftingRightAt: invalidIndex ] - raise: Error - MessageNotUnderstood - withExceptionDo: [ :anError | - self assert: anError messageText equals: (Object errorDescriptionForSubcriptBounds: invalidIndex). - self assert: arrayToInsertTo equals: #(1 2 3) ].! ! +!BinarySearchTest methodsFor: 'testing' stamp: 'sqr 5/25/2016 14:36'! +testquickFindFirst -!ArrayTest methodsFor: 'test - insert:ShiftingRight:' stamp: 'HAW 12/20/2018 14:27:08'! -testInsertShiftingRightLoosesLastElementAndKeepsPreviousOnes + | collection | + collection := 1000 to: 2100. + collection withIndexDo: + [:eachElement :eachIndex | + self assert: (collection quickFindFirst: [:one | one >= eachElement]) = eachIndex. + self assert: (collection quickFindFirst: [:one | one >= (eachElement - 0.5)]) = eachIndex + ]. + self assert: (collection quickFindFirst: [:one | one > 2101]) = 0! ! - self assert: (#(1 3 4 5) copy insert: 2 shiftingRightAt: 2) equals: #(1 2 3 4)! ! +!BinarySearchTest methodsFor: 'testing' stamp: 'sqr 5/25/2016 14:36'! +testquickFindLast -!ArrayTest methodsFor: 'test - insert:ShiftingRight:' stamp: 'HAW 12/20/2018 14:27:21'! -testInsertShiftingRightReplacesElementWhenSizeIsOne + | collection | + collection := 1000 to: 2100. + collection withIndexDo: + [:eachElement :eachIndex | + self assert: (collection quickFindLast: [:one | one <= eachElement]) = eachIndex. + self assert: (collection quickFindLast: [:one | one <= (eachElement + 0.5)]) = eachIndex + ]. + self assert: (collection quickFindLast: [:one | one < 0]) = 0! ! - self assert: (#(1) copy insert: 2 shiftingRightAt: 1) equals: #(2)! ! +!BinarySearchTest methodsFor: 'testing' stamp: 'sqr 5/25/2016 14:46'! +testquickIndexOf -!ArrayTest methodsFor: 'test - insert:ShiftingRight:' stamp: 'HAW 12/20/2018 14:28:20'! -testInsertShiftingRightReplacesLastElementWhenInsertingAtLastIndex + | collection | + collection := 1000 to: 2100. + collection withIndexDo: + [:eachElement :eachIndex | + self assert: (collection quickIndexOf: eachElement) = eachIndex + ]. + self assert: (collection quickIndexOf: 999) = 0. + self assert: (collection quickIndexOf: 2101) = 0! ! - self assert: (#(1 3 4 5) copy insert: 2 shiftingRightAt: 4) equals: #(1 3 4 2)! ! +!BinarySearchTest methodsFor: 'testing' stamp: 'sqr 5/25/2016 15:01'! +testquickIndexOfWithSemistableOrder -!ArrayTest methodsFor: 'test - testing' stamp: 'jpb 8/2/2019 22:59:46'! -testIsArray - self assert: (#(1 2 3) is: #Array). - self assert: (#() is: #Array).! ! + | collection | + collection := SortedCollection + sortBlock: [:x :y | x key <= y key]. + 1 to: 1000 do: [:each | collection add: each -> each]. + 1 to: 50 do: [:each | collection add: 42 -> each]. + self assert: (collection quickIndexOf: 42 -> 6) = 48! ! -!ArrayTest methodsFor: 'test - testing' stamp: 'jpb 8/2/2019 23:09:00'! -testIsCollection - self assert: (#(1 2 3) is: #Collection). - self assert: (#() is: #Collection).! ! +!CollectTest methodsFor: 'testing' stamp: 'jmv 11/30/2014 11:34'! +testIdentitySet + " + CollectTest new testIdentitySet + " + | col result | + col _ #(1 2 3 1.0 2.0 3.0) asIdentitySet. + result _ col collect: [ :elem | elem yourself ]. + self assert: result class = IdentitySet. + self assert: result = #(1 2 3 1.0 2.0 3.0) asIdentitySet. + self assert: result = col! ! -!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:46:01'! -testAntepenultimateIfAbsentReturnsAntepenultimateIfExists +!CollectTest methodsFor: 'testing' stamp: 'jmv 11/30/2014 10:51'! +testOrderedCollection + " + CollectTest new testOrderedCollection + " + | col result | + col _ #(1 2 3 4 5) asOrderedCollection. + result _ col collect: [ :elem | elem * 2 ]. + self assert: result class = OrderedCollection. + self assert: result = #(2 4 6 8 10) asOrderedCollection! ! - self assert: 1 equals: (#(1 2 3) antepenultimateIfAbsent: [ self fail ])! ! +!CollectTest methodsFor: 'testing' stamp: 'jmv 11/30/2014 11:34'! +testSet + " + CollectTest new testSet + " + | col result | + col _ #(1 2 3 1.0 2.0 3.0) asSet. + result _ col collect: [ :elem | elem yourself ]. + self assert: result class = Set. + self assert: result = #(1 2 3) asSet. + self assert: result = col! ! -!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:47:18'! -testAntepenultimateIfAbsentValuesIfAbsentBlockWhenNoAntepenultimate +!CollectTest methodsFor: 'testing' stamp: 'jmv 11/30/2014 11:01'! +testSortedCollection + " + CollectTest new testSortedCollection + " + | col result | + col _ #(1 2 3 4 5) asSortedCollection: [ :a :b | a > b ]. + result _ col collect: [ :elem | elem * 2 ]. + self assert: result class = OrderedCollection. + self assert: result = #(10 8 6 4 2) asOrderedCollection! ! - self assert: 0 equals: (#(1 2) antepenultimateIfAbsent: [ 0 ])! ! +!CollectionTest methodsFor: 'groupBy tests' stamp: 'HAW 7/5/2018 15:14:11'! +testGroupByHavingSelectsTheResultOfGroupBy -!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:48:13'! -testAntepenultimateReturnsAntepenultimateIfExists + | collectionToGroupBy groupedByEven | + + collectionToGroupBy := OrderedCollection with: 1 with: 2 with: 3 with: 4 with: 5. + groupedByEven := collectionToGroupBy groupBy: [ :anInteger | anInteger even ] having: [ :group | group size > 2 ]. + + self assert: 1 equals: (groupedByEven size). + self assert: (collectionToGroupBy select: [ :anInteger | anInteger odd ]) equals: (groupedByEven at: false) ! ! - self assert: 1 equals: #(1 2 3) antepenultimate! ! +!CollectionTest methodsFor: 'groupBy tests' stamp: 'HAW 7/5/2018 15:15:41'! +testGroupByReturnsADictionaryThatGroupsACollectionByThePluggableKey -!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:49:10'! -testAntepenultimateSignalsErrorWhenCollectionIsNotBigEnough + | collectionToGroupBy groupedByEven | + + collectionToGroupBy := OrderedCollection with: 1 with: 2 with: 3 with: 4 with: 5. + groupedByEven := collectionToGroupBy groupBy: [ :anInteger | anInteger even ]. + + self assert: 2 equals: groupedByEven size. + self assert: (collectionToGroupBy select: [ :anInteger | anInteger even ]) equals: (groupedByEven at: true). + self assert:(collectionToGroupBy select: [ :anInteger | anInteger odd ]) equals: (groupedByEven at: false).! ! - self - should: [ #(1 2) antepenultimate ] - raise: Error - withMessageText: Collection collectionTooSmallDescription! ! +!CollectionTest methodsFor: 'average tests' stamp: 'HAW 11/17/2018 11:45:15'! +testAverageFailsWhenTheCollectionIsEmpty -!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/4/2020 00:37:18'! -testLastIfEmptyReturnsLastWhenExist + self + should: [ #() average: [ :each | each ] ] + raise: Error + description: Collection emptyCollectionDescription! ! - self assert: 1 equals: (#(1) lastIfEmpty: [ self fail ])! ! +!CollectionTest methodsFor: 'average tests' stamp: 'HAW 11/17/2018 11:45:19'! +testAverageIfEmptyCalculatesItAsUsualWhenTheCollectionIsNotEmpty -!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/4/2020 00:38:24'! -testLastIfEmptyValuesEmptyBlockWhenEmpty + | someNumbers | + + someNumbers _ #(1 5). - self assert: 1 equals: (#() lastIfEmpty: [ 1 ])! ! + self + assert: (someNumbers average: [ :each | each ] ifEmpty: [ self fail ]) + equals: someNumbers average! ! -!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/4/2020 00:43:47'! -testLastSignalsErrorWhenEmpty +!CollectionTest methodsFor: 'average tests' stamp: 'HAW 11/17/2018 11:45:22'! +testAverageIfEmptyEvaluatesEmptyBlockWhenTheCollectionIsEmpty - self - should: [ #() last ] - raise: Error - withMessageText: Collection emptyCollectionDescription! ! + | emptyBlock | + + emptyBlock _ [ 0 ]. -!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:37:15'! -testPenultimateIfAbsentReturnsPenultimateIfExists + self + assert: (#() average: [ :each | each asInteger ] ifEmpty: emptyBlock) + equals: emptyBlock value! ! - self assert: 2 equals: (#(2 3) penultimateIfAbsent: [ self fail ])! ! +!CollectionTest methodsFor: 'average tests' stamp: 'jmv 1/6/2021 11:57:27'! +testsAverageWorksWithABlock -!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:41:03'! -testPenultimateIfAbsentValuesIfAbsentBlockWhenNoPenultimate + self assert: ({ '1' . '2' . '3' } average: [ :each | each asNumber ]) equals: 2! ! - self assert: 2 equals: (#(1) penultimateIfAbsent: [ 2 ])! ! +!CollectionTest methodsFor: 'as comma separated tests' stamp: 'HAW 3/6/2019 15:11:08'! +assertAsCommaSeparated: aCollection equals: expectedString + + self + assert: (String streamContents: [ :stream | aCollection asCommaSeparated: [ :elem | stream print: elem + 1] on: stream ]) + equals: expectedString! ! -!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:41:31'! -testPenultimateReturnsPenultimateIfExists +!CollectionTest methodsFor: 'as comma separated tests' stamp: 'HAW 3/6/2019 15:12:31'! +testAsCommaSeparatedOnWorksAsCommaStringAnd - self assert: 2 equals: #(2 3) penultimate! ! + self assertAsCommaSeparated: #() equals: ''. + self assertAsCommaSeparated: #(1) equals: '2'. + self assertAsCommaSeparated: #(1 2) equals: '2 and 3'. + self assertAsCommaSeparated: #(1 2 3) equals: '2, 3 and 4'.! ! -!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:43:44'! -testPenultimateSignalsErrorWhenCollectionIsNotBigEnough +!CollectionTest methodsFor: 'as comma separated tests' stamp: 'HAW 3/6/2019 15:11:51'! +testAsCommaStringAndDoesNotAddAnythingWhenEmpty - self - should: [ #(1) penultimate ] - raise: Error - withMessageText: Collection collectionTooSmallDescription! ! + self assert: #() asCommaStringAnd isEmpty ! ! -!Float32ArrayTest methodsFor: 'Tests' stamp: 'jmv 9/3/2020 18:39:55'! -testIsType - self assert: (#[1.2 2.4 3.6 ] is: #Collection). - self assert: (#[1.2 2.4 3.6] asFloat32Array is: #Float32Array).! ! +!CollectionTest methodsFor: 'as comma separated tests' stamp: 'HAW 3/6/2019 15:11:59'! +testAsCommaStringAndDoesNotAddAnythingWhenHasOneElement -!Float32ArrayTest methodsFor: 'Tests' stamp: 'jmv 9/3/2020 18:39:53'! -testZeroArrayDividend + self assert: #(1) asCommaStringAnd equals: '1' ! ! - self assert: #[1.2 2.4 0.0 ] asFloat32Array / #[1.2 1.2 1.2 ] asFloat32Array = #[1.0 2.0 0.0 ] asFloat32Array ! ! +!CollectionTest methodsFor: 'as comma separated tests' stamp: 'HAW 3/6/2019 15:12:06'! +testAsCommaStringAndSeparatesWithAndWhenTwoOneElements -!Float32ArrayTest methodsFor: 'Tests' stamp: 'jmv 9/3/2020 18:40:16'! -testZeroArrayDivisor + self assert: #(1 2) asCommaStringAnd equals: '1 and 2' ! ! - "Test implicit exception" - self should: [ #[1.2 2.4 3.6 ] asFloat32Array / #[1.0 1.0 0.0 ] asFloat32Array] raise: ZeroDivide. +!CollectionTest methodsFor: 'as comma separated tests' stamp: 'HAW 3/6/2019 15:12:21'! +testAsCommaStringAndSeparatesWithCommaButLastOneWithAndWhenMoreThanTwoElements - "Test explicit alternative value" - self assert: (#[1.0 2.0 3.141592 0.0] asFloat32Array divideBy: #[1.0 1.0 0.0 0.0 ] asFloat32Array ifDivisorZero: -100 ifBothZero: -200) = - #[1.0 2.0 -100.0 -200.0 ] asFloat32Array. + self assert: #(1 2 3) asCommaStringAnd equals: '1, 2 and 3' ! ! - "Test explicit exceptions" - self should: [ - #[1.0 2.0 3.141592] asFloat32Array - divideBy: #[1.0 1.0 0.0] - ifDivisorZero: [ZeroDivide signal ] - ifBothZero: [DomainError signal ]] - raise: ZeroDivide. - self should: [ - #[0.0 2.0 3.141592] asFloat32Array - divideBy: #[0.0 1.0 1.0] - ifDivisorZero: [ZeroDivide signal ] - ifBothZero: [DomainError signal ]] - raise: DomainError. +!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/16/2019 00:08:43'! +testItMaintainsTheSameCollectionSpecies - "Test non local returns in blocks" - self assert: self divideByArrayOne = #[0.0 2.0 3.141592] asFloat32Array. - self assert: self divideByArrayZero = #divisionByZero. - self assert: self divideByArrayIndeterminate = #indeterminateResult.! ! + self assert: (OrderedCollection with: 1 with: 2) equals: (OrderedCollection with: 1 with: #(2)) flatten! ! -!Float32ArrayTest methodsFor: 'Tests' stamp: 'jmv 9/3/2020 18:39:33'! -testZeroDividend +!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/15/2019 23:31:15'! +testWhenCollectionContainsASingleLevelOfElementsItReturnsTheSameCollection - self assert: #[1.2 2.4 3.6 0.0 ] asFloat32Array / 1.2 = #[1.0 2.0 3.0 0.0 ] asFloat32Array ! ! + self assert: #(1 2 3) equals: #(1 2 3) flatten! ! -!Float32ArrayTest methodsFor: 'Tests' stamp: 'jmv 9/3/2020 18:39:30'! -testZeroDivisor +!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/16/2019 00:01:02'! +testWhenCollectionContainsMoreThanTwoLevelsltReturnsTheElementsOfAllNestedCollections - "Test implicit exception" - self should: [ #[1.2 2.4 3.6 ] asFloat32Array / 0.0] raise: ZeroDivide. + self assert: #(1 2 3 4 5) equals: #(1 #(2 3) #(4 #(5))) flatten! ! - "Test explicit alternative value" - self assert: (#[1.0 2.0 3.141592 0.0] asFloat32Array divideBy: 0.0 ifDivisorZero: -100 ifBothZero: -200) = - #[-100.0 -100.0 -100.0 -200.0 ] asFloat32Array. +!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/16/2019 00:03:22'! +testWhenCollectionContainsStringCollectionsItDoesNotFlattenTheStrings - "Test explicit exceptions" - self should: [ - #[1.0 2.0 3.141592] asFloat32Array - divideBy: 0.0 - ifDivisorZero: [ZeroDivide signal ] - ifBothZero: [DomainError signal ]] - raise: ZeroDivide. - self should: [ - #[0.0 2.0 3.141592] asFloat32Array - divideBy: 0.0 - ifDivisorZero: [ZeroDivide signal ] - ifBothZero: [DomainError signal ]] - raise: DomainError. + self assert: #('string1' 'string2' 'string3') equals: #('string1' #('string2' 'string3')) flatten! ! - "Test non local returns in blocks" - self assert: self divideByScalarOne = #[0.0 2.0 3.141592] asFloat32Array. - self assert: self divideByScalarZero = #divisionByZero. - self assert: self divideByScalarIndeterminate = #indeterminateResult.! ! +!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/16/2019 00:02:07'! +testWhenCollectionContainsStringsItReturnsTheSameCollection -!Float32ArrayTest methodsFor: 'Aux' stamp: 'jmv 9/3/2020 18:40:09'! -divideByArrayIndeterminate - "An example for testing. Uses a method to test behavior of non-local return." - ^#[0.0 2.0 3.141592] asFloat32Array - divideBy: #[0.0 2.0 3.141592] asFloat32Array - ifDivisorZero: [^ #divisionByZero] - ifBothZero: [^ #indeterminateResult]! ! + self assert: #('string1' 'string2' 'string3') equals: #('string1' 'string2' 'string3') flatten! ! -!Float32ArrayTest methodsFor: 'Aux' stamp: 'jmv 9/3/2020 18:40:13'! -divideByArrayOne - "An example for testing. Uses a method to test behavior of non-local return." - ^#[0.0 2.0 3.141592] asFloat32Array - divideBy: #[1.0 1.0 1.0] asFloat32Array - ifDivisorZero: [^ #divisionByZero] - ifBothZero: [^ #indeterminateResult]! ! +!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/16/2019 00:03:37'! +testWhenCollectionContainsTwoLevelsOfElementsItReturnsTheElementsOfAllNestedCollections + + self assert: #(1 2 3) equals: #(#(1) #(2 3)) flatten + ! ! -!Float32ArrayTest methodsFor: 'Aux' stamp: 'jmv 9/3/2020 18:40:03'! -divideByArrayZero - "An example for testing. Uses a method to test behavior of non-local return." - ^#[1.0 2.0 3.141592] asFloat32Array - divideBy: #[0.0 2.0 3.141592] asFloat32Array - ifDivisorZero: [^ #divisionByZero] - ifBothZero: [^ #indeterminateResult]! ! +!CollectionTest methodsFor: 'flatten tests' stamp: 'GC 5/15/2019 23:24:15'! +testWhenCollectionIsEmptyItReturnsTheSameCollection -!Float32ArrayTest methodsFor: 'Aux' stamp: 'jmv 9/3/2020 18:40:00'! -divideByScalarIndeterminate - "An example for testing. Uses a method to test behavior of non-local return." - ^#[0.0 2.0 3.141592] asFloat32Array - divideBy: 0.0 - ifDivisorZero: [^ #divisionByZero] - ifBothZero: [^ #indeterminateResult]! ! + self assert: #() equals: #() flatten! ! -!Float32ArrayTest methodsFor: 'Aux' stamp: 'jmv 9/3/2020 18:39:00'! -divideByScalarOne - "An example for testing. Uses a method to test behavior of non-local return." - ^#[0.0 2.0 3.141592] asFloat32Array - divideBy: 1.0 - ifDivisorZero: [^ #divisionByZero] - ifBothZero: [^ #indeterminateResult]! ! +!CollectionTest methodsFor: 'misc tests' stamp: 'jpb 8/2/2019 23:18:50'! +testIsCollection + self assert: (Bag new is: #Collection).! ! -!Float32ArrayTest methodsFor: 'Aux' stamp: 'jmv 9/3/2020 18:39:02'! -divideByScalarZero - "An example for testing. Uses a method to test behavior of non-local return." - ^#[1.0 2.0 3.141592] asFloat32Array - divideBy: 0.0 - ifDivisorZero: [^ #divisionByZero] - ifBothZero: [^ #indeterminateResult]! ! +!CollectionTest methodsFor: 'misc tests' stamp: 'jmv 6/12/2019 18:22:57'! +testSetEquality + self assert: Set new = IdentitySet new. + self assert: Set new hash = IdentitySet new hash. + self assert: Dictionary new = IdentityDictionary new. + self assert: Dictionary new hash = IdentityDictionary new hash. + self assert: Dictionary new = OrderedDictionary new. + self assert: Dictionary new hash = OrderedDictionary new hash. + self assert: IdentityDictionary new = OrderedDictionary new. + self assert: IdentityDictionary new hash = OrderedDictionary new hash. -!Float64ArrayTest methodsFor: 'Tests' stamp: 'jpb 8/2/2019 23:07:59'! -testIsCollection - self assert: (#[1.0 2.0 3.141592 0.0] is: #Collection). - self assert: (#[-100.0 -100.0 -100.0 -200.0 ] is: #Collection).! ! + self deny: Set new = Dictionary new! ! -!Float64ArrayTest methodsFor: 'Tests' stamp: 'jmv 7/9/2018 09:38:50'! -testZeroArrayDividend +!DictionaryTest methodsFor: 'tests' stamp: 'jpb 8/2/2019 23:17:49'! +testIsCollection + self assert: (Dictionary new is: #Collection)! ! - self assert: #[1.2 2.4 0.0 ] / #[1.2 1.2 1.2 ] = #[1.0 2.0 0.0 ] ! ! +!DictionaryTest methodsFor: 'tests' stamp: 'HAW 4/4/2019 08:18:05'! +testKeyNotFoundSignalTheRightMessage -!Float64ArrayTest methodsFor: 'Tests' stamp: 'jmv 7/9/2018 09:51:49'! -testZeroArrayDivisor + self + should: [ Dictionary new errorKeyNotFound ] + raise: Error + withMessageText: Dictionary keyNotFoundErrorDescription ! ! - "Test implicit exception" - self should: [ #[1.2 2.4 3.6 ] / #[1.0 1.0 0.0 ]] raise: ZeroDivide. +!IntervalTest methodsFor: 'testing' stamp: 'jmv 12/18/2018 10:56:31'! +testAt + " + IntervalTest new testAt + " + self assert: (2 to: 5 by: 2) first = 2. + self assert: ((2 to: 5 by: 2) at: 1) = 2. + self assert: ((2 to: 5 by: 2) at: 2) = 4. + self assert: (2 to: 5 by: 2) last = 4. - "Test explicit alternative value" - self assert: (#[1.0 2.0 3.141592 0.0] copy divideBy: #[1.0 1.0 0.0 0.0 ] ifDivisorZero: -100 ifBothZero: -200) = - #[1.0 2.0 -100.0 -200.0 ]. + self assert: (0 to: 2.4 by: 0.1) first = 0. + self assert: ((0 to: 2.4 by: 0.1) at: 1) = 0. + self assert: (((0 to: 2.4 by: 0.1) at: 2) isWithin: 1 floatsFrom: 0.1). + self assert: (((0 to: 2.4 by: 0.1) at: 3) isWithin: 1 floatsFrom: 0.2). + self assert: (((0 to: 2.4 by: 0.1) at: 23) isWithin: 1 floatsFrom: 2.2). + self assert: ((0 to: 2.4 by: 0.1) at: 24) = 2.3. + self assert: ((0 to: 2.4 by: 0.1) at: 25) = 2.4. + self assert: (0 to: 2.4 by: 0.1) last = 2.4.! ! - "Test explicit exceptions" - self should: [ - #[1.0 2.0 3.141592] copy - divideBy: #[1.0 1.0 0.0] - ifDivisorZero: [ZeroDivide signal ] - ifBothZero: [DomainError signal ]] - raise: ZeroDivide. - self should: [ - #[0.0 2.0 3.141592] copy - divideBy: #[0.0 1.0 1.0] - ifDivisorZero: [ZeroDivide signal ] - ifBothZero: [DomainError signal ]] - raise: DomainError. +!IntervalTest methodsFor: 'testing' stamp: 'jmv 12/18/2018 10:56:59'! +testFloatInterval + " + IntervalTest new testFloatInterval + " + + self assert: (0 to: 2.4 by: 0.1) size = 25. + self assert: (0 to: 2.4 by: 0.1) first = 0. + self assert: (0 to: 2.4 by: 0.1) last = 2.4. - "Test non local returns in blocks" - self assert: self divideByArrayOne = #[0.0 2.0 3.141592]. - self assert: self divideByArrayZero = #divisionByZero. - self assert: self divideByArrayIndeterminate = #indeterminateResult.! ! + 2 to: 200 do: [ :n | + self assert: (0.0 to: 1.0 count: n) size = n. + self assert: (0.0 to: 1.0 count: n) first = 0.0. + self assert: ((0.0 to: 1.0 count: n) last isWithin: 1 floatsFrom: 1.0)]. + 2 to: 200 do: [ :n | + self assert: (1.0 to: 0.0 count: n) size = n. + self assert: (1.0 to: 0.0 count: n) first = 1.0. + self assert: ((1.0 to: 0.0 count: n) last isWithin: 1 floatsFrom: 0.0)].! ! -!Float64ArrayTest methodsFor: 'Tests' stamp: 'jmv 7/9/2018 09:39:14'! -testZeroDividend +!IntervalTest methodsFor: 'testing' stamp: 'HAW 3/17/2019 07:20:11'! +testFloatToByDo + " + IntervalTest new testFloatToByDo + " + | interval toByDo | - self assert: #[1.2 2.4 3.6 0.0 ] / 1.2 = #[1.0 2.0 3.0 0.0 ] ! ! + "See comment at #to:by:do:" + self shouldFail: [ + interval _ 0 to: 2.4 by: 0.1. + toByDo _ Array streamContents: [ :strm | + 0 to: 2.4 by: 0.1 do: [ :each | + strm nextPut: each ]]. + self assert: toByDo size = interval size. + 1 to: toByDo size do: [ :i | + self assert: (toByDo at: i) = (interval at: i) ]]! ! -!Float64ArrayTest methodsFor: 'Tests' stamp: 'jmv 7/9/2018 09:53:42'! -testZeroDivisor +!IntervalTest methodsFor: 'testing' stamp: 'jmv 3/27/2016 17:18'! +testIntegerInterval + " + IntervalTest new testIntegerInterval + " + | z | + self assert: (2 to: 5 by: 2) size = 2. + self assert: (2 to: 5 by: 2) last = 4. + z _ 0. + (2 to: 5 by: 2) do: [ :i | z _ i ]. + self assert: z = 4! ! - "Test implicit exception" - | | - self should: [ #[1.2 2.4 3.6 ] / 0.0] raise: ZeroDivide. +!IntervalTest methodsFor: 'testing' stamp: 'jmv 4/27/2016 14:29'! +testIntegerToByDo + " + IntervalTest new testIntegerToByDo + " + | interval toByDo | + interval _ 2 to: 5 by: 2. + toByDo _ Array streamContents: [ :strm | + 2 to: 5 by: 2 do: [ :each | + strm nextPut: each ]]. + self assert: toByDo size = interval size. + 1 to: toByDo size do: [ :i | + self assert: (toByDo at: i) = (interval at: i) ]! ! - "Test explicit alternative value" - self assert: (#[1.0 2.0 3.141592 0.0] copy divideBy: 0.0 ifDivisorZero: -100 ifBothZero: -200) = - #[-100.0 -100.0 -100.0 -200.0 ]. +!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:43:33'! +testDoesNotIncludeNumbersOutsideTheInInterval - "Test explicit exceptions" - self should: [ - #[1.0 2.0 3.141592] copy - divideBy: 0.0 - ifDivisorZero: [ZeroDivide signal ] - ifBothZero: [DomainError signal ]] - raise: ZeroDivide. - self should: [ - #[0.0 2.0 3.141592] copy - divideBy: 0.0 - ifDivisorZero: [ZeroDivide signal ] - ifBothZero: [DomainError signal ]] - raise: DomainError. + | from1To10 | + + from1To10 := 1 to: 10. + + self deny: (from1To10 includes: 0). + self deny: (from1To10 includes: 11)! ! - "Test non local returns in blocks" - self assert: self divideByScalarOne = #[0.0 2.0 3.141592]. - self assert: self divideByScalarZero = #divisionByZero. - self assert: self divideByScalarIndeterminate = #indeterminateResult.! ! +!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:35:03'! +testDoesNotIncludeObjectsThatAreNotNumbers -!Float64ArrayTest methodsFor: 'Aux' stamp: 'jmv 7/9/2018 09:52:51'! -divideByArrayIndeterminate - "An example for testing. Uses a method to test behavior of non-local return." - ^#[0.0 2.0 3.141592] copy - divideBy: #[0.0 2.0 3.141592] - ifDivisorZero: [^ #divisionByZero] - ifBothZero: [^ #indeterminateResult]! ! + self deny: ((1 to: 10) includes: $a)! ! -!Float64ArrayTest methodsFor: 'Aux' stamp: 'jmv 7/9/2018 09:52:56'! -divideByArrayOne - "An example for testing. Uses a method to test behavior of non-local return." - ^#[0.0 2.0 3.141592] copy - divideBy: #[1.0 1.0 1.0] - ifDivisorZero: [^ #divisionByZero] - ifBothZero: [^ #indeterminateResult]! ! +!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:53:40'! +testDoesNotIncludedNumbersThatAreInRangeButNotReachedByTheStep -!Float64ArrayTest methodsFor: 'Aux' stamp: 'jmv 7/9/2018 09:53:05'! -divideByArrayZero - "An example for testing. Uses a method to test behavior of non-local return." - ^#[1.0 2.0 3.141592] copy - divideBy: #[0.0 2.0 3.141592] - ifDivisorZero: [^ #divisionByZero] - ifBothZero: [^ #indeterminateResult]! ! + | from1To10By2 | + + from1To10By2 := 1 to: 10 by: 2. + + self deny: (from1To10By2 includes: 0). + self deny: (from1To10By2 includes: 2). + self deny: (from1To10By2 includes: 6). + self deny: (from1To10By2 includes: 10).! ! -!Float64ArrayTest methodsFor: 'Aux' stamp: 'jmv 7/9/2018 09:38:35'! -divideByScalarIndeterminate - "An example for testing. Uses a method to test behavior of non-local return." - ^#[0.0 2.0 3.141592] - divideBy: 0.0 - ifDivisorZero: [^ #divisionByZero] - ifBothZero: [^ #indeterminateResult]! ! +!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:54:48'! +testDoesNotIncludedNumbersThatAreInRangeButNotReachedByTheStepWithReversedIntervals -!Float64ArrayTest methodsFor: 'Aux' stamp: 'jmv 7/9/2018 09:38:39'! -divideByScalarOne - "An example for testing. Uses a method to test behavior of non-local return." - ^#[0.0 2.0 3.141592] - divideBy: 1.0 - ifDivisorZero: [^ #divisionByZero] - ifBothZero: [^ #indeterminateResult]! ! + | from10To1ByMinus2 | + + from10To1ByMinus2 := 10 to: 1 by: -2. + + self deny: (from10To1ByMinus2 includes: 0). + self deny: (from10To1ByMinus2 includes: 1). + self deny: (from10To1ByMinus2 includes: 5). + self deny: (from10To1ByMinus2 includes: 9).! ! -!Float64ArrayTest methodsFor: 'Aux' stamp: 'jmv 7/9/2018 09:38:43'! -divideByScalarZero - "An example for testing. Uses a method to test behavior of non-local return." - ^#[1.0 2.0 3.141592] - divideBy: 0.0 - ifDivisorZero: [^ #divisionByZero] - ifBothZero: [^ #indeterminateResult]! ! +!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:43:03'! +testIncludedNumbersRespectAStepDifferentToOne -!Float64ArrayTest methodsFor: 'as yet unclassified' stamp: 'jmv 7/30/2020 21:58:18'! -testSum - | a | - self assert: ({0.0. 1.0. Float pi. Float e} asFloat64Array + 1) = ({0.0+1. 1.0+1. Float pi+1. Float e+1} asFloat64Array). - a _ {0.0. 1.0. Float pi. Float e} asFloat64Array. - self assert: (a + a) = (a * 2 )! ! + | from1To10By2 | + + from1To10By2 := 1 to: 10 by: 2. + + self assert: (from1To10By2 includes: 1). + self assert: (from1To10By2 includes: 5). + self assert: (from1To10By2 includes: 9).! ! -!ExceptionHandlingConditionTest methodsFor: 'exception handling tests' stamp: 'HAW 3/29/2017 13:50:30'! -testBlockClosuresCanBeUsedAsHandlingCondition +!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:55:55'! +testIncludedNumbersRespectNegativeSteps - self - shouldnt: [ [ Error signal ] on: [:anException | true ] do: [ :anError | ] ] - raise: Error. - - ! ! + | from10To1ByMinus2 | + + from10To1ByMinus2 := 10 to: 1 by: -2. + + self assert: (from10To1ByMinus2 includes: 10). + self assert: (from10To1ByMinus2 includes: 6). + self assert: (from10To1ByMinus2 includes: 2).! ! -!ExceptionHandlingConditionTest methodsFor: 'exception handling tests' stamp: 'HAW 3/29/2017 13:48:37'! -testFilterConditionWorksAsExcpetedWhenHandlingException +!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:43:26'! +testIncludesNumbersInsideTheInterval - self - shouldnt: [ [ Error signal ] on: Error - ZeroDivide do: [ :anError | ] ] - raise: Error. - - self - should: [ [ ZeroDivide signal ] on: Error - ZeroDivide do: [ :anError | self fail ]] - raise: Error. + | from1To10 | + + from1To10 := 1 to: 10. + + self assert: (from1To10 includes: 1). + self assert: (from1To10 includes: 5). + self assert: (from1To10 includes: 10).! ! -! ! +!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:43:21'! +testIncludesNumbersInsideTheIntervalEvenForReversedIntervals -!ExceptionHandlingConditionTest methodsFor: 'exception handling tests' stamp: 'HAW 3/29/2017 13:49:45'! -testOrConditionWorksAsExcpetedWhenHandlingException + | from10To1 | + + from10To1 := 10 to: 1 by: -1. + + self assert: (from10To1 includes: 1). + self assert: (from10To1 includes: 5). + self assert: (from10To1 includes: 10).! ! - self - shouldnt: [ [ Error signal ] on: Error, Notification do: [ :anError | ] ] - raise: Error. - - self - shouldnt: [ [ Notification signal ] on: Error, Notification do: [ :anError | ] ] - raise: Notification +!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 12:01:44'! +testIntervalWithOneNumberAndNegativeStepBiggerThanOneIncludeOnlyThatNumber - ! ! + | from1To1ByMinus2 | + + from1To1ByMinus2 := 1 to: 1 by: -2. + + self assert: (from1To1ByMinus2 includes: 1). + self deny: (from1To1ByMinus2 includes: -1). + self deny: (from1To1ByMinus2 includes: 3).! ! -!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:06'! -testCanCreateFilterConditionWithExceptionTypeAndExceptionType +!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 12:01:54'! +testIntervalWithOneNumberAndNegativeStepIncludeOnlyThatNumber - | condition | + | from1To1ByMinus1 | - condition := Error - ZeroDivide . + from1To1ByMinus1 := 1 to: 1 by: -1. - self assert: (condition handles: Error new). - self deny: (condition handles: ZeroDivide new). - ! ! + self assert: (from1To1ByMinus1 includes: 1). + self deny: (from1To1ByMinus1 includes: 0). + self deny: (from1To1ByMinus1 includes: 2).! ! -!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:15'! -testCanCreateFilterConditionWithExceptionTypeAndFilterCondition +!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 12:00:46'! +testIntervalWithOneNumberAndStepBiggerThanOneIncludesOnlyTheNumber - | condition | + | from1To1By2 | - condition := Error - (ZeroDivide - Halt). + from1To1By2 := 1 to: 1 by: 2. - self assert: (condition handles: Error new). - self deny: (condition handles: ZeroDivide new). - self assert: (condition handles: Halt new). - ! ! + self assert: (from1To1By2 includes: 1). + self deny: (from1To1By2 includes: -1). + self deny: (from1To1By2 includes: 3).! ! -!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:10'! -testCanCreateFilterConditionWithExceptionTypeAndOrCondition +!IntervalTest methodsFor: 'test - includes' stamp: 'HAW 5/2/2020 11:59:06'! +testIntervalWithOneNumberIncludesOnlyTheNumber - | condition | + | from1To1 | - condition := Error - (ZeroDivide, Halt). + from1To1 := 1 to: 1. - self assert: (condition handles: Error new). - self deny: (condition handles: ZeroDivide new). - self deny: (condition handles: Halt new). - ! ! + self assert: (from1To1 includes: 1). + self deny: (from1To1 includes: 0). + self deny: (from1To1 includes: 2).! ! -!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:35'! -testCanCreateFilterConditionWithFilterConditionAndExceptionType +!IntervalTest methodsFor: 'tests - includesAll' stamp: 'HAW 6/11/2022 20:08:15'! +testIncludesAllOfFailsWhenFirstNotIncluded - | condition | - - condition := (Error - Halt) - ZeroDivide. - - self assert: (condition handles: Error new). - self deny: (condition handles: Halt new). - self deny: (condition handles: ZeroDivide new). -! ! + self deny: ((3 to: 9 by: 2) includesAllOf: (1 to: 9 by: 2))! ! -!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:43'! -testCanCreateFilterConditionWithFilterConditionAndFilterCondition +!IntervalTest methodsFor: 'tests - includesAll' stamp: 'HAW 6/11/2022 20:08:18'! +testIncludesAllOfFailsWhenLastNotIncluded - | condition | - - condition := (Error - Halt) - (ZeroDivide - Notification). - - self assert: (condition handles: Error new). - self deny: (condition handles: Halt new). - self deny: (condition handles: ZeroDivide new). - self assert: (condition handles: Notification new). -! ! + self deny: ((1 to: 7 by: 2) includesAllOf: (1 to: 9 by: 2))! ! -!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:39'! -testCanCreateFilterConditionWithFilterConditionAndOrCondition +!IntervalTest methodsFor: 'tests - includesAll' stamp: 'HAW 6/11/2022 20:08:21'! +testIncludesAllOfFailsWithOtherTypeOfCollectionWhenElementNotIncluded - | condition | - - condition := (Error - Halt) - (Notification, ZeroDivide). - - self assert: (condition handles: Error new). - self deny: (condition handles: Halt new). - self deny: (condition handles: Notification new). - self deny: (condition handles: ZeroDivide new). -! ! + self deny: ((1 to: 9 by: 2) includesAllOf: {1. 3. 5. 6. 7. 9})! ! -!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:20'! -testCanCreateFilterConditionWithOrConditionAndExceptionType +!IntervalTest methodsFor: 'tests - includesAll' stamp: 'HAW 6/11/2022 20:08:24'! +testIncludesAllOfIntervalWithIncludedFirstLastAndDifferentIncrement - | condition | - - condition := (Error, Halt) - ZeroDivide. - - self assert: (condition handles: Error new). - self assert: (condition handles: Halt new). - self deny: (condition handles: ZeroDivide new). - ! ! + self assert: ((1 to: 9 by: 2) includesAllOf: (3 to: 7 by: 4))! ! -!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:29'! -testCanCreateFilterConditionWithOrConditionAndFilterCondition +!IntervalTest methodsFor: 'tests - includesAll' stamp: 'HAW 6/11/2022 20:08:27'! +testIncludesAllOfIntervalWithIncludedFirstSameLastAndIncrement - | condition | - - condition := (Error, Halt) - (ZeroDivide - ArithmeticError). - - self assert: (condition handles: Error new). - self assert: (condition handles: Halt new). - self deny: (condition handles: ZeroDivide new). - self assert: (condition handles: ArithmeticError new). - ! ! + self assert: ((1 to: 10 by: 2) includesAllOf: (3 to: 10 by: 2))! ! -!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:25'! -testCanCreateFilterConditionWithOrConditionAndOrCondition +!IntervalTest methodsFor: 'tests - includesAll' stamp: 'HAW 6/11/2022 20:08:29'! +testIncludesAllOfIntervalWithSameFirstIncrementAndIncludedLast - | condition | - - condition := (Error, Halt) - (ArithmeticError, ZeroDivide). - - self assert: (condition handles: Error new). - self assert: (condition handles: Halt new). - self deny: (condition handles: ArithmeticError new). - self deny: (condition handles: ZeroDivide new). - ! ! + self assert: ((1 to: 10 by: 2) includesAllOf: (1 to: 7 by: 2))! ! -!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 15:21:29'! -testCanCreateOrConditionWithExceptionTypeAndExceptionType +!IntervalTest methodsFor: 'tests - includesAll' stamp: 'HAW 6/11/2022 20:08:32'! +testIncludesAllOfIntervalWithSameFirstLastAndIncrement - | handlingCondition | - - handlingCondition := Error, Notification. - - self assert: (handlingCondition handles: Error new). - self assert: (handlingCondition handles: Notification new). - ! ! + self assert: ((1 to: 10 by: 2) includesAllOf: (1 to: 10 by: 2))! ! -!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 17:59:39'! -testCanCreateOrConditionWithExceptionTypeAndFilterCondition - - | handlingCondition | - - handlingCondition := Error, (ArithmeticError - ZeroDivide). - - self assert: (handlingCondition handles: Error new). - self assert: (handlingCondition handles: ArithmeticError new). - self deny: (handlingCondition handles: ZeroDivide new). - - ! ! +!IntervalTest methodsFor: 'tests - includesAll' stamp: 'HAW 6/11/2022 20:08:35'! +testIncludesAllOfOtherTypeOfCollection -!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 15:21:37'! -testCanCreateOrConditionWithExceptionTypeAndOrCondition + self assert: ((1 to: 9 by: 2) includesAllOf: {1. 3. 5. 7. 9})! ! - | handlingCondition | +!OrderedCollectionTest methodsFor: 'tests' stamp: 'jpb 8/2/2019 23:18:24'! +testIsCollection + self assert: (OrderedCollection new is: #Collection).! ! + +!OrderedCollectionTest methodsFor: 'tests' stamp: 'HAW 5/18/2019 17:01:20'! +testStreamContentsWorksAsExpected + + | contents | - handlingCondition := Error, (Notification, UnhandledError). + contents := OrderedCollection streamContents: [ :stream | stream nextPut: 1 ]. - self assert: (handlingCondition handles: Error new). - self assert: (handlingCondition handles: Notification new). - self assert: (handlingCondition handles: UnhandledError new). - ! ! + self assert: (OrderedCollection with: 1) equals: contents! ! -!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 17:56:49'! -testCanCreateOrConditionWithFilterConditionAndExceptionType +!OrderedCollectionTest methodsFor: 'tests' stamp: 'HAW 5/18/2019 17:04:16'! +testWriteStreamOnOrderedCollectionGrowsAsExpected - | condition | + | contents | - condition := (Error - ZeroDivide), ArithmeticError . + contents := OrderedCollection streamContents: [ :stream | + 1 to: 101 do: [ :aNumber | stream nextPut: aNumber ]]. - self assert: (condition handles: Error new). - self deny: (condition handles: ZeroDivide new). - self assert: (condition handles: ArithmeticError new). + 1 to: 101 do: [ :aNumber | self assert: aNumber equals: (contents at: aNumber) ] ! ! -!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 17:56:57'! -testCanCreateOrConditionWithFilterConditionAndFilterCondition +!OrderedDictionaryTest methodsFor: 'tests' stamp: 'jmv 5/25/2018 10:36:59'! +testOrder + | data dict orderingByCollect orderingByDo orderingBySelect aux desiredOrder | - | condition | - - condition := (Error - ZeroDivide), (ArithmeticError - DomainError). - - self assert: (condition handles: Error new). - self deny: (condition handles: ZeroDivide new). - self assert: (condition handles: ArithmeticError new). - self deny: (condition handles: DomainError new). + "Test that #do:, #select: and #collect: iterate in the correct order" + dict _ OrderedDictionary new. + data _ self sampleData. + desiredOrder _ data collect: [ :pair | pair second ]. + data do: [ :pair | + dict at: pair first put: pair second ]. - ! ! + orderingByDo _ Array streamContents: [ :strm | dict do: [ :each | strm nextPut: each ]]. + self assert: orderingByDo = desiredOrder. -!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 17:57:02'! -testCanCreateOrConditionWithFilterConditionAndOrCondition + aux _ dict select: [ :each | true ]. + orderingBySelect _ Array streamContents: [ :strm | aux do: [ :each | strm nextPut: each ]]. + self assert: orderingBySelect = desiredOrder. - | condition | - - condition := (ArithmeticError - ZeroDivide), (Error, Halt). - - self assert: (condition handles: ArithmeticError new). - self deny: (condition handles: ZeroDivide new). - self assert: (condition handles: Error new). - self assert: (condition handles: Halt new). + aux _ dict collect: [ :each | each yourself ]. + orderingByCollect _ Array streamContents: [ :strm | aux do: [ :each | strm nextPut: each ]]. + self assert: orderingByCollect = desiredOrder. - ! ! -!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 15:22:01'! -testCanCreateOrConditionWithOrConditionAndExceptionType - - | handlingCondition | - - handlingCondition := (Error, Halt), Notification. - - self assert: (handlingCondition handles: Error new). - self assert: (handlingCondition handles: Halt new). - self assert: (handlingCondition handles: Notification new). - - ! ! + "Test that order is correct even if different. Also test alternative way to add stuff to dict." + dict _ OrderedDictionary new. + data _ self sampleData reversed. + desiredOrder _ data collect: [ :pair | pair second ]. + data do: [ :pair | + dict add: pair first -> pair second ]. -!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 17:57:09'! -testCanCreateOrConditionWithOrConditionAndFilterCondition + orderingByDo _ Array streamContents: [ :strm | dict do: [ :each | strm nextPut: each ]]. + self assert: orderingByDo = desiredOrder. - | exceptionSet | - - exceptionSet := (Error, Notification), (ArithmeticError - ZeroDivide). + aux _ dict select: [ :each | true ]. + orderingBySelect _ Array streamContents: [ :strm | aux do: [ :each | strm nextPut: each ]]. + self assert: orderingBySelect = desiredOrder. + + aux _ dict collect: [ :each | each yourself ]. + orderingByCollect _ Array streamContents: [ :strm | aux do: [ :each | strm nextPut: each ]]. + self assert: orderingByCollect = desiredOrder. +! ! + +!OrderedDictionaryTest methodsFor: 'tests' stamp: 'jmv 5/25/2018 10:41:04'! +testRemove + | data dict dataToRemove desiredOrder orderingByDo | + + "Test that #do:, #select: and #collect: iterate in the correct order" + dict _ OrderedDictionary new. + data _ self sampleData. + dataToRemove _ self sampleData2. + + data do: [ :pair | + dict at: pair first put: pair second ]. + dataToRemove do: [ :pair | + dict removeKey: pair first ]. + + orderingByDo _ Array streamContents: [ :strm | dict do: [ :each | strm nextPut: each ]]. + + desiredOrder _ OrderedCollection new. + data do: [ :pair | desiredOrder add: pair second ]. + dataToRemove do: [ :pair | desiredOrder remove: pair second ]. - self assert: (exceptionSet handles: Error new). - self assert: (exceptionSet handles: Notification new). - self assert: (exceptionSet handles: ArithmeticError new). - self deny: (exceptionSet handles: ZeroDivide new). + self assert: orderingByDo = desiredOrder asArray.! ! - ! ! +!OrderedDictionaryTest methodsFor: 'aux' stamp: 'jmv 5/25/2018 10:16:25'! +sampleData + ^ { {1. 'uno'}. {6. 'seis'}. {8. 'ocho'}. {7. 'siete'}. {2. 'dos'}. {3. 'tres'}. {4. 'cuatro'}. {5. 'cinco'}}! ! -!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 15:22:06'! -testCanCreateOrConditionWithOrConditionAndOrCondition +!OrderedDictionaryTest methodsFor: 'aux' stamp: 'jmv 5/25/2018 10:16:35'! +sampleData2 + ^ { {1. 'uno'}. {8. 'ocho'}. {3. 'tres'}}! ! - | handlingCondition | +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/25/2019 09:49:41'! +testCombinationsAtATimeDoShouldEvaluateBlockWithEmptyCollection - handlingCondition := (Error, Halt), (Notification, UnhandledError). + | combinationWasEmpty | - self assert: (handlingCondition handles: Error new). - self assert: (handlingCondition handles: Halt new). - self assert: (handlingCondition handles: Notification new). - self assert: (handlingCondition handles: UnhandledError new). - ! ! - -!ExceptionHandlingConditionTest methodsFor: 'environment preconditions' stamp: 'sqr 6/26/2019 11:50:31'! -testExceptionsFollowTheExpectedHierarchy + combinationWasEmpty := false. + 'ab' combinations: 0 atATimeDo: [ :combination | combinationWasEmpty := combination isEmpty ]. + + self assert: combinationWasEmpty! ! - "This test exits because all the others use existing exceptions and assume a subclass relationship - If the relationship is not the assumed one, false positives or negatives could happen" +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/25/2019 09:59:32'! +testCombinationsAtATimeDoWorksAsExpected - self assert: (Error inheritsFrom: Exception). - self assert: (Notification inheritsFrom: Exception). - self assert: (UnhandledError inheritsFrom: Exception). - self assert: (Halt inheritsFrom: Exception). - self assert: (ArithmeticError inheritsFrom: Error). - self assert: (DomainError inheritsFrom: ArithmeticError). - self assert: (ArithmeticMessageError inheritsFrom: Error). - self assert: (NegativePowerError inheritsFrom: ArithmeticMessageError). - self assert: (ZeroDivide inheritsFrom: ArithmeticMessageError)! ! + | combinations | + + combinations := OrderedCollection new. + 'abc' combinations: 2 atATimeDo: [ :combination | combinations add: combination copy]. + + self assert: 3 equals: combinations size. + self assert: (combinations includes: #($a $b)). + self assert: (combinations includes: #($a $c)). + self assert: (combinations includes: #($b $c)).! ! -!ExceptionTests methodsFor: 'private' stamp: 'md 3/25/2003 23:40'! -assertSuccess: anExceptionTester - self should: [ ( anExceptionTester suiteLog first) endsWith: 'succeeded'].! ! +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:33:35'! +testDoSeparatedByDoesNotValueSeparatedBlockForCollectionsOfOneElement -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'dtl 6/1/2004 21:54'! -testDoubleOuterPass - self assertSuccess: (ExceptionTester new runTest: #doubleOuterPassTest ) ! ! + | collectionToTraverse traversedElements | -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'dtl 6/1/2004 21:54'! -testDoublePassOuter - self assertSuccess: (ExceptionTester new runTest: #doublePassOuterTest ) ! ! + collectionToTraverse := OrderedCollection with: 1. + traversedElements := OrderedCollection new. + self shouldntFail: [ collectionToTraverse do: [ :anElement | traversedElements add: anElement ] separatedBy: [ self fail ] ]. -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:43'! -testDoubleResume - self assertSuccess: (ExceptionTester new runTest: #doubleResumeTest ) ! ! + self assert: collectionToTraverse equals: traversedElements! ! -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:44'! -testNonResumableFallOffTheEndHandler - self assertSuccess: (ExceptionTester new runTest: #nonResumableFallOffTheEndHandler ) ! ! +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:38:06'! +testDoSeparatedByDoesNotValueSeparatedBlockOnLastElement -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'SqR 10/10/2015 16:22'! -testResignalAs + | collectionToTraverse traversedElements | - | answer | - answer := [ - [3 zork] - on: ZeroDivide - do: [:ex | ex return: 5] - ] on: Error do: [:ex | ex resignalAs: ZeroDivide]. - self assert: answer == 5! ! + collectionToTraverse := OrderedCollection with: 1 with: 2. + traversedElements := OrderedCollection new. -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'SqR 11/15/2015 11:42'! -testResignalAsUnwinds + self shouldntFail: [ collectionToTraverse do: [ :anElement | traversedElements add: anElement ] separatedBy: [ traversedElements add: $-] ]. - | unwound answer | - unwound := false. - answer := [ - [3 zork] - on: ZeroDivide do: [:ex | self assert: unwound. ex return: 5] - ] on: Error do: [:ex | [ex resignalAs: ZeroDivide] ifCurtailed: [unwound := true]]. - self assert: answer == 5! ! + self assert: (OrderedCollection with: 1 with: $- with: 2) equals: traversedElements! ! -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:44'! -testResumableFallOffTheEndHandler - self assertSuccess: (ExceptionTester new runTest: #resumableFallOffTheEndHandler ) ! ! +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:29:27'! +testDoSeparatedByDoesNothingForEmptyCollection -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:44'! -testSignalFromHandlerActionTest - self assertSuccess: (ExceptionTester new runTest: #signalFromHandlerActionTest ) ! ! + self shouldntFail: [ #() do: [ :anElement | self fail ] separatedBy: [ self fail ] ]! ! -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:48'! -testSimpleEnsure - self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTest ) ! ! +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/21/2020 17:00:14'! +testFirstAvailableReturnsAllObjectsWhenRequestedMoreThanTheSize -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:45'! -testSimpleEnsureTestWithError - self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithError ) ! ! + self assert: #(10 20 30) equals: (#(10 20 30) firstAvailable: 4)! ! -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:46'! -testSimpleEnsureTestWithNotification - self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithNotification ) ! ! +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/21/2020 17:00:43'! +testFirstAvailableReturnsAllObjectsWhenRequestedTheReceiversSize -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:45'! -testSimpleEnsureTestWithUparrow - self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithUparrow ) ! ! + self assert: #(10 20 30) equals: (#(10 20 30) firstAvailable: 3)! ! -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:46'! -testSimpleIsNested - self assertSuccess: (ExceptionTester new runTest: #simpleIsNestedTest ) ! ! +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/21/2020 16:58:40'! +testFirstAvailableReturnsTheFirstRequestedObjectsWhenTheyAreAvailable -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:41'! -testSimpleOuter - self assertSuccess: (ExceptionTester new runTest: #simpleOuterTest ) ! ! + self assert: #(10 20) equals: (#(10 20 30) firstAvailable: 2)! ! -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:42'! -testSimplePass - self assertSuccess: (ExceptionTester new runTest: #simplePassTest ) ! ! +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/21/2020 17:03:20'! +testLastAvailableReturnsAllObjectsWhenRequestedMoreThanTheSize -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:43'! -testSimpleResignalAs - self assertSuccess: (ExceptionTester new runTest: #simpleResignalAsTest ) ! ! + self assert: #(10 20 30) equals: (#(10 20 30) lastAvailable: 4)! ! -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:48'! -testSimpleResume - self assertSuccess: (ExceptionTester new runTest: #simpleResumeTest ) ! ! +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/21/2020 17:02:57'! +testLastAvailableReturnsAllObjectsWhenRequestedTheReceiversSize -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:48'! -testSimpleRetry - self assertSuccess: (ExceptionTester new runTest: #simpleRetryTest ) ! ! + self assert: #(10 20 30) equals: (#(10 20 30) lastAvailable: 3)! ! -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:47'! -testSimpleRetryUsing - self assertSuccess: (ExceptionTester new runTest: #simpleRetryUsingTest ) ! ! +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 5/21/2020 17:02:27'! +testLastAvailableReturnsTheLastRequestedObjectsWhenTheyAreAvailable -!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:48'! -testSimpleReturn - self assertSuccess: (ExceptionTester new runTest: #simpleReturnTest ) ! ! + self assert: #(20 30) equals: (#(10 20 30) lastAvailable: 2)! ! -!ExceptionTests methodsFor: 'testing-outer' stamp: 'SqR 8/28/2014 22:45'! -testHandlerFromAction - "A test ensuring that nested exceptions work as expected." - - | result | - result := [ - [ - [self error: 'trigger error'] on: ZeroDivide do: [ :ex | 'inner' ] - ] on: Error do: [ :ex | 3 / 0 ] - ] on: ZeroDivide do: [ :ex | 'outer' ]. - self assert: result = 'outer'! ! - -!ExceptionTests methodsFor: 'testing-outer' stamp: 'dtl 6/1/2004 21:59'! -testNonResumableOuter - - self should: [ - [Error signal. 4] - on: Error - do: [:ex | ex outer. ex return: 5] - ] raise: Error -! ! - -!ExceptionTests methodsFor: 'testing-outer' stamp: 'dtl 6/1/2004 22:00'! -testNonResumablePass - - self should: [ - [Error signal. 4] - on: Error - do: [:ex | ex pass. ex return: 5] - ] raise: Error -! ! +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:36:00'! +testWithIndexDoSeparatedByDoesNotValueSeparatedBlockForCollectionsOfOneElement -!ExceptionTests methodsFor: 'testing-outer' stamp: 'ul 11/15/2010 11:39'! -testResumableOuter + | collectionToTraverse traversedElements | - | result | - result := [Notification signal. 4] - on: Notification - do: [:ex | ex outer. ex return: 5]. - self assert: result = 5 -! ! + collectionToTraverse := OrderedCollection with: $a. + traversedElements := OrderedCollection new. -!ExceptionTests methodsFor: 'testing-outer' stamp: 'ul 11/15/2010 11:39'! -testResumablePass + self shouldntFail: [ collectionToTraverse withIndexDo: [ :anElement :index | traversedElements add: anElement -> index ] separatedBy: [ self fail ] ]. - | result | - result := [Notification signal. 4] - on: Notification - do: [:ex | ex pass. ex return: 5]. - self assert: result = 4 -! ! + self assert: 1 equals: traversedElements size. + self assert: $a->1 equals: traversedElements first! ! -!ExceptionTests methodsFor: 'testing' stamp: 'brp 10/21/2004 16:42'! -testNoTimeout - self assertSuccess: (ExceptionTester new runTest: #simpleNoTimeoutTest ) ! ! +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:40:01'! +testWithIndexDoSeparatedByDoesNotValueSeparatedBlockOnLastElement -!ExceptionTests methodsFor: 'testing' stamp: 'brp 10/21/2004 16:41'! -testTimeoutWithZeroDuration - self assertSuccess: (ExceptionTester new runTest: #simpleTimeoutWithZeroDurationTest ) ! ! + | collectionToTraverse traversedElements | -!ProgressInitiationExceptionTest methodsFor: 'testing' stamp: 'jmv 5/1/2021 20:11:23'! -test01 - | countStorage | - countStorage _ {0}. - self - should: [ self sampleProgress: countStorage ] - raise: ZeroDivide. - self assert: countStorage first = 5. - ! ! + collectionToTraverse := OrderedCollection with: $a with: $b. + traversedElements := OrderedCollection new. -!ProgressInitiationExceptionTest methodsFor: 'testing' stamp: 'jmv 5/1/2021 20:11:36'! -test02 - | countStorage | - countStorage _ {0}. - self - shouldnt: [ - [self sampleProgress: countStorage] - on: ZeroDivide - do: [ :ex | ex resume] - ] - raise: Error. - self assert: countStorage first = 10. - ! ! + collectionToTraverse + withIndexDo: [ :anElement :index | traversedElements add: anElement -> index ] + separatedBy: [ traversedElements add: $-]. -!ProgressInitiationExceptionTest methodsFor: 'testing' stamp: 'jmv 5/1/2021 20:12:24'! -test03 - | countStorage | - countStorage _ {0}. - self - should: [ - [self sampleProgress: countStorage] - on: ProgressInitiationException - do: [ :ex | ex sendNotificationsTo: [ :min :max :curr | Transcript show: min printString, ' ', max printString, ' ', curr printString; newLine ]] - ] - raise: Error. - self assert: countStorage first = 5. - ! ! + self assert: 3 equals: traversedElements size. + self assert: $a->1 equals: traversedElements first. + self assert: $- equals: traversedElements second. + self assert: $b->2 equals: traversedElements third! ! -!ProgressInitiationExceptionTest methodsFor: 'testing' stamp: 'jmv 5/1/2021 20:15:12'! -test04 - | countStorage | - countStorage _ {0}. - self - shouldnt: [ - [ - [self sampleProgress: countStorage] - on: ZeroDivide - do: [ :ex | ex resume] - ] - on: ProgressInitiationException - do: [ :ex | ex sendNotificationsTo: [ :min :max :curr | Transcript show: min printString, ' ', max printString, ' ', curr printString; newLine ]] - ] - raise: Error. - self assert: countStorage first = 10. - ! ! +!SequenceableCollectionTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:30:18'! +testWithIndexDoSeparatedByDoesNothingForEmptyCollection -!ProgressInitiationExceptionTest methodsFor: 'testing' stamp: 'jmv 5/1/2021 20:15:48'! -test05 - | countStorage | - countStorage _ {0}. - self - shouldnt: [ - [ - [self sampleProgress: countStorage] - on: ProgressInitiationException - do: [ :ex | ex sendNotificationsTo: [ :min :max :curr | Transcript show: min printString, ' ', max printString, ' ', curr printString; newLine ]] - ] - on: ZeroDivide - do: [ :ex | ex resume] - ] - raise: Error. - self assert: countStorage first = 10. - ! ! + self shouldntFail: [ #() withIndexDo: [ :anElement :index | self fail ] separatedBy: [ self fail ] ]! ! -!ProgressInitiationExceptionTest methodsFor: 'aux' stamp: 'jmv 5/1/2021 20:09:48'! -sampleProgress: countStorage -" -self new sampleProgress: {0} -" - | d | - d _ Delay forMilliseconds: 10. - ^'Now here''s some Real Progress' - displayProgressAt: Sensor mousePoint - from: 0 - to: 10 - during: [ :barBlock | - 1 to: 10 do: [ :x | - countStorage at: 1 put: countStorage first + 1. - barBlock value: x. - d wait. - x = 5 ifTrue: [1/0]. "just to make life interesting" - ]. - 'done' - ]. +!TextTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:40:53'! +testIsText + self assert: (Text new is: #Text).! ! -! ! +!WeakIdentitySetTest methodsFor: 'testing' stamp: 'jmv 8/24/2012 08:24'! +test + " + (also tests WeakSet a bit) + WeakIdentitySetTest new test + " + | ary1 ary2 count w wi | + ary1 _ { 3@4 . 4@5 }. + ary2 _ { 13@4 . 14@5 }. + w _ WeakSet new. + w addAll: ary1. + wi _ WeakIdentitySet new. + wi addAll: ary2. + + self assert: w size = 2. + count _ 0. + w do: [ :each | + count _ count + 1. + self assert: each class == Point ]. + self assert: count = 2. + self assert: (w includes: ary1 first). + self assert: (w includes: ary1 second). + self assert: (w includes: 3@4). + self assert: (w includes: 4@5). -!ArrayLiteralTest methodsFor: 'tests' stamp: 'jpb 8/2/2019 23:05:08'! -testIsArray - self assert: ({1. 2. 'hello'. #Number} is: #Array).! ! + self assert: wi size = 2. + count _ 0. + wi do: [ :each | + count _ count + 1. + self assert: each class == Point ]. + self assert: count = 2. + self assert: (wi includes: ary2 first). + self assert: (wi includes: ary2 second). + self deny: (wi includes: 13@4). + self deny: (wi includes: 14@5). -!ArrayLiteralTest methodsFor: 'tests' stamp: 'HAW 10/26/2019 18:24:11'! -testReservedIdentifiers - - self assert: #(nil true false) equals: {nil. true. false}.! ! + "Now make one element in each disappear" + ary1 at: 1 put: 9. + ary2 at: 1 put: 99. + Smalltalk garbageCollect. -!ArrayLiteralTest methodsFor: 'tests' stamp: 'HAW 10/26/2019 18:24:52'! -testSymbols + "A little weird, but yes, elements that disappeared are still counted, but NOT iterated!!" + self assert: w size = 2. + count _ 0. + w do: [ :each | + count _ count + 1 ]. + self assert: count = 1. + self deny: (w includes: ary1 first). + self assert: (w includes: ary1 second). - self assert: #(#nil #true #false #'nil' #'true' #'false') equals: {#nil. #true. #false. #nil. #true. #false}.! ! + self assert: wi size = 2. "A little weird, but yes, elements that disappeared are still counted" + count _ 0. + wi do: [ :each | + count _ count + 1 ]. + self assert: count = 1. + self deny: (wi includes: ary2 first). + self assert: (wi includes: ary2 second).! ! -!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:13'! -test01isAtSuperclassWhenIndexIsInSuperclass +!ArrayTest methodsFor: 'test - insert:ShiftingRight:' stamp: 'HAW 12/20/2018 14:41:00'! +testCanNotInsertShiftingRightWhenInsertionPointIsBiggerThanSize - | classDefinitionNode analyzer | - - classDefinitionNode := self thisClassDefinitionNode. + | arrayToInsertTo invalidIndex | - analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. + arrayToInsertTo := #(1 2 3) copy. + invalidIndex := arrayToInsertTo size + 1. - self assert: (analyzer isAtSuperclass: 1). - self assert: (analyzer isAtSuperclass: self class superclass name size)! ! + self + should: [ arrayToInsertTo insert: 0 shiftingRightAt: invalidIndex ] + raise: Error - MessageNotUnderstood + withExceptionDo: [ :anError | + self assert: anError messageText equals: (Object errorDescriptionForSubcriptBounds: invalidIndex). + self assert: arrayToInsertTo equals: #(1 2 3) ].! ! -!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:19'! -test02isNotAtSuperclassWhenIndexIsOutsideSuperclass +!ArrayTest methodsFor: 'test - insert:ShiftingRight:' stamp: 'HAW 12/20/2018 14:39:47'! +testCanNotInsertShiftingRightWhenInsertionPointIsLessThanOne - | classDefinitionNode analyzer | + | arrayToInsertTo invalidIndex | - classDefinitionNode := self thisClassDefinitionNode. - - analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. + arrayToInsertTo := #(1 2 3) copy. + invalidIndex := 0. - self deny: (analyzer isAtSuperclass: 0). - self deny: (analyzer isAtSuperclass: self class superclass name size + 1). - ! ! + self + should: [ arrayToInsertTo insert: 0 shiftingRightAt: invalidIndex ] + raise: Error - MessageNotUnderstood + withExceptionDo: [ :anError | + self assert: anError messageText equals: (Object errorDescriptionForSubcriptBounds: invalidIndex). + self assert: arrayToInsertTo equals: #(1 2 3) ].! ! -!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:25'! -test03isAtClassNameWhenIndexIsInClassName +!ArrayTest methodsFor: 'test - insert:ShiftingRight:' stamp: 'HAW 12/20/2018 14:27:08'! +testInsertShiftingRightLoosesLastElementAndKeepsPreviousOnes - | classDefinitionNode analyzer | - - classDefinitionNode := self thisClassDefinitionNode. - - analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. - - self assert: (analyzer isAtClassName: (self class definition findString: self class name) - 1). - self assert: (analyzer isAtClassName: (self class definition findString: self class name) + self class name size - 1). -! ! + self assert: (#(1 3 4 5) copy insert: 2 shiftingRightAt: 2) equals: #(1 2 3 4)! ! -!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:29'! -test04isNotAtClassNameWhenIndexIsOutsideClassName +!ArrayTest methodsFor: 'test - insert:ShiftingRight:' stamp: 'HAW 12/20/2018 14:27:21'! +testInsertShiftingRightReplacesElementWhenSizeIsOne - | classDefinitionNode analyzer | - - classDefinitionNode := self thisClassDefinitionNode. - - analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. - - self deny: (analyzer isAtClassName: (self class definition findString: self class name) - 2). - self deny: (analyzer isAtClassName: (self class definition findString: self class name) + self class name size). -! ! + self assert: (#(1) copy insert: 2 shiftingRightAt: 1) equals: #(2)! ! -!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:35'! -test05isAtInstanceVariablesWhenIndexIsInInstanceVariablesString +!ArrayTest methodsFor: 'test - insert:ShiftingRight:' stamp: 'HAW 12/20/2018 14:28:20'! +testInsertShiftingRightReplacesLastElementWhenInsertingAtLastIndex - | classDefinitionNode analyzer | - - classDefinitionNode := self thisClassDefinitionNode. - - analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. - - self assert: (analyzer isAtInstanceVariables: (self class definition findString: 'iv1')). - self assert: (analyzer isAtInstanceVariables: (self class definition findString: 'iv1') + 2). -! ! + self assert: (#(1 3 4 5) copy insert: 2 shiftingRightAt: 4) equals: #(1 3 4 2)! ! -!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:40'! -test06isNotAtInstanceVariablesWhenIndexIsOutsideInstanceVariablesString +!ArrayTest methodsFor: 'test - testing' stamp: 'jpb 8/2/2019 22:59:46'! +testIsArray + self assert: (#(1 2 3) is: #Array). + self assert: (#() is: #Array).! ! - | classDefinitionNode analyzer | - - classDefinitionNode := self thisClassDefinitionNode. - - analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. - - self deny: (analyzer isAtInstanceVariables: (self class definition findString: '''iv1''')). - self deny: (analyzer isAtInstanceVariables: (self class definition findString: '''iv1''') + 4). - - ! ! +!ArrayTest methodsFor: 'test - testing' stamp: 'jpb 8/2/2019 23:09:00'! +testIsCollection + self assert: (#(1 2 3) is: #Collection). + self assert: (#() is: #Collection).! ! -!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:45'! -test07CanAccessSuperclass +!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:46:01'! +testAntepenultimateIfAbsentReturnsAntepenultimateIfExists - | classDefinitionNode analyzer | - - classDefinitionNode := self thisClassDefinitionNode. - - analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. - - self assert: self class superclass equals: analyzer superclass! ! + self assert: 1 equals: (#(1 2 3) antepenultimateIfAbsent: [ self fail ])! ! -!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:50'! -test08isAtCategoryWhenIndexIsInCategoryString +!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:47:18'! +testAntepenultimateIfAbsentValuesIfAbsentBlockWhenNoAntepenultimate - | classDefinitionNode analyzer | - - classDefinitionNode := self thisClassDefinitionNode. - - analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. - - self assert: (analyzer isAtCategory: (self class definition findString: self class category asString)). - self assert: (analyzer isAtCategory: (self class definition findString: self class category asString) + self class category size - 1). - - ! ! + self assert: 0 equals: (#(1 2) antepenultimateIfAbsent: [ 0 ])! ! -!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:55'! -test09isNotAtCategoryWhenIndexIsOutsideCategoryString +!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:48:13'! +testAntepenultimateReturnsAntepenultimateIfExists - | classDefinitionNode analyzer | - - classDefinitionNode := self thisClassDefinitionNode. - - analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. - - self deny: (analyzer isAtCategory: (self class definition findString: self class category asString) - 1). - self deny: (analyzer isAtCategory: (self class definition findString: self class category asString) + self class category size). - - ! ! + self assert: 1 equals: #(1 2 3) antepenultimate! ! -!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 10/11/2019 16:51:32'! -test10InstanceVariablesIsTheSecondParameter +!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:49:10'! +testAntepenultimateSignalsErrorWhenCollectionIsNotBigEnough - | subclassCreationSelectors | - - subclassCreationSelectors := Class organization listAtCategoryNamed: 'subclass creation'. - self assert: subclassCreationSelectors notEmpty. - - subclassCreationSelectors do: [ :aSubclassCreationSelector | - self - assert: (aSubclassCreationSelector keywords at: ClassDefinitionNodeAnalyzer instanceVariableNamesPositionForClassDefinition ) - equals: 'instanceVariableNames:' ]! ! + self + should: [ #(1 2) antepenultimate ] + raise: Error + withMessageText: Collection collectionTooSmallDescription! ! -!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:06:49'! -test11CategoryIsTheFifthParameter +!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/4/2020 00:37:18'! +testLastIfEmptyReturnsLastWhenExist - | subclassCreationSelectors | - - subclassCreationSelectors := Class organization listAtCategoryNamed: 'subclass creation'. - self assert: subclassCreationSelectors notEmpty. - - subclassCreationSelectors do: [ :aSubclassCreationSelector | - self - assert: (aSubclassCreationSelector keywords at: ClassDefinitionNodeAnalyzer categoryPosition) - equals: 'category:' ]! ! + self assert: 1 equals: (#(1) lastIfEmpty: [ self fail ])! ! -!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 18:16:08'! -thisClassDefinitionNode - - ^self class methodNodeFor: self class definition noPattern: true ! ! +!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/4/2020 00:38:24'! +testLastIfEmptyValuesEmptyBlockWhenEmpty -!ClosureCompilerTest methodsFor: 'source' stamp: 'jmv 3/13/2012 11:29'! -closureCases - ^#( -'| n | -n := 1. -^n + n' + self assert: 1 equals: (#() lastIfEmpty: [ 1 ])! ! -'| i | -i := 0. -[i := i + 1. - i <= 10] whileTrue. -^i' +!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/4/2020 00:43:47'! +testLastSignalsErrorWhenEmpty -'[:c :s| | mn | -mn := Compiler new - compile: (c sourceCodeAt: s) - in: c - notifying: nil - ifFail: [self halt]. -mn generate: #(0 0 0 0). -{mn blockExtentsToTempsMap. - mn encoder schematicTempNames}] - value: ArrayLiteralTest - value: #testSymbols' + self + should: [ #() last ] + raise: Error + withMessageText: Collection emptyCollectionDescription! ! -'inject: thisValue into: binaryBlock - | nextValue | - nextValue := thisValue. - self do: [:each | nextValue := binaryBlock value: nextValue value: each]. - ^nextValue' +!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:37:15'! +testPenultimateIfAbsentReturnsPenultimateIfExists -'runBinaryConditionalJumps: assertPrintBar - "CogIA32CompilerTests new runBinaryConditionalJumps: false" - | mask reg1 reg2 reg3 | - mask := 1 << self processor bitsInWord - 1. - self concreteCompilerClass dataRegistersWithAccessorsDo: - [:n :get :set| - n = 0 ifTrue: [reg1 := get]. - n = 1 ifTrue: [reg2 := set]. - n = 2 ifTrue: [reg3 := set]]. - #( (JumpAbove > unsigned) (JumpBelowOrEqual <= unsigned) - (JumpBelow < unsigned) (JumpAboveOrEqual >= unsigned) - (JumpGreater > signed) (JumpLessOrEqual <= signed) - (JumpLess < signed) (JumpGreaterOrEqual >= signed) - (JumpZero = signed) (JumpNonZero ~= signed)) do: - [:triple| - [:opName :relation :signednessOrResult| | opcode jumpNotTaken jumpTaken nop memory bogus | - self resetGen. - opcode := CogRTLOpcodes classPool at: opName. - self gen: CmpRR operand: 2 operand: 1. - jumpTaken := self gen: opcode. - self gen: MoveCqR operand: 0 operand: 0. - jumpNotTaken := self gen: Jump. - jumpTaken jmpTarget: (self gen: MoveCqR operand: 1 operand: 0). - jumpNotTaken jmpTarget: (nop := self gen: Nop). - memory := self generateInstructions. - bogus := false. - self pairs: (-2 to: 2) do: - [:a :b| | taken | - self processor - reset; - perform: reg2 with: a signedIntToLong; - perform: reg3 with: b signedIntToLong. - [self processor singleStepIn: memory. - self processor pc ~= nop address] whileTrue. - taken := (self processor perform: reg1) = 1. - assertPrintBar - ifTrue: - [self assert: taken = (signednessOrResult == #unsigned - ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)] - ifFalse: [a perform: relation with: b])] - ifFalse: - [Transcript - nextPutAll: reg2; nextPut: $(; print: a; nextPutAll: '') ''; nextPutAll: relation; space; - nextPutAll: reg3; nextPut: $(; print: b; nextPutAll: '') = ''; - print: taken; cr; flush. - taken = (signednessOrResult == #unsigned - ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)] - ifFalse: [a perform: relation with: b]) ifFalse: - [bogus := true]]]. - bogus ifTrue: - [self processor printRegistersOn: Transcript. - Transcript show: (self processor disassembleInstructionAt: jumpTaken address In: memory); cr]] - valueWithArguments: triple]' + self assert: 2 equals: (#(2 3) penultimateIfAbsent: [ self fail ])! ! -'mapFromBlockStartsIn: aMethod toTempVarsFrom: schematicTempNamesString constructor: aDecompilerConstructor - | map | - map := aMethod - mapFromBlockKeys: aMethod startpcsToBlockExtents keys asSortedCollection - toSchematicTemps: schematicTempNamesString. - map keysAndValuesDo: - [:startpc :tempNameTupleVector| | subMap tempVector numTemps | - subMap := Dictionary new. - "Find how many temp slots there are (direct & indirect temp vectors) - and for each indirect temp vector find how big it is." - tempNameTupleVector do: - [:tuple| - tuple last isArray - ifTrue: - [subMap at: tuple last first put: tuple last last. - numTemps := tuple last first] - ifFalse: - [numTemps := tuple last]]. - "create the temp vector for this scope level." - tempVector := Array new: numTemps. - "fill it in with any indirect temp vectors" - subMap keysAndValuesDo: - [:index :size| - tempVector at: index put: (Array new: size)]. - "fill it in with temp nodes." - tempNameTupleVector do: - [:tuple| | itv | - tuple last isArray - ifTrue: - [itv := tempVector at: tuple last first. - itv at: tuple last last - put: (aDecompilerConstructor - codeTemp: tuple last last - 1 - named: tuple first)] - ifFalse: - [tempVector - at: tuple last - put: (aDecompilerConstructor - codeTemp: tuple last - 1 - named: tuple first)]]. - "replace any indirect temp vectors with proper RemoteTempVectorNodes" - subMap keysAndValuesDo: - [:index :size| - tempVector - at: index - put: (aDecompilerConstructor - codeRemoteTemp: index - remoteTemps: (tempVector at: index))]. - "and update the entry in the map" - map at: startpc put: tempVector]. - ^map' +!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:41:03'! +testPenultimateIfAbsentValuesIfAbsentBlockWhenNoPenultimate - 'gnuifyFrom: inFileStream to: outFileStream + self assert: 2 equals: (#(1) penultimateIfAbsent: [ 2 ])! ! -"convert interp.c to use GNU features" +!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:41:31'! +testPenultimateReturnsPenultimateIfExists - | inData beforeInterpret inInterpret inInterpretVars beforePrimitiveResponse inPrimitiveResponse | + self assert: 2 equals: #(2 3) penultimate! ! - inData := inFileStream upToEnd withSqueakLineEndings. - inFileStream close. +!ArrayTest methodsFor: 'test - accessing' stamp: 'HAW 5/3/2020 00:43:44'! +testPenultimateSignalsErrorWhenCollectionIsNotBigEnough - "print a header" - outFileStream - nextPutAll: ''/* This file has been post-processed for GNU C */''; - cr; cr; cr. + self + should: [ #(1) penultimate ] + raise: Error + withMessageText: Collection collectionTooSmallDescription! ! - beforeInterpret := true. "whether we are before the beginning of interpret()" - inInterpret := false. "whether we are in the middle of interpret" - inInterpretVars := false. "whether we are in the variables of interpret" - beforePrimitiveResponse := true. "whether we are before the beginning of primitiveResponse()" - inPrimitiveResponse := false. "whether we are inside of primitiveResponse" - ''Gnuifying'' - displayProgressAt: Sensor mousePoint - from: 1 to: (inData occurrencesOf: Character crCharacter) - during: - [:bar | | lineNumber | - lineNumber := 0. - inData linesDo: - [ :inLine | | outLine extraOutLine caseLabel | - bar value: (lineNumber := lineNumber + 1). - outLine := inLine. "print out one line for each input line; by default, print out the line that was input, but some rules modify it" - extraOutLine := nil. "occasionally print a second output line..." - beforeInterpret ifTrue: [ - inLine = ''#include "sq.h"'' ifTrue: [ - outLine := ''#include "sqGnu.h"'' ]. - inLine = ''interpret(void) {'' ifTrue: [ - "reached the beginning of interpret" - beforeInterpret := false. - inInterpret := true. - inInterpretVars := true ] ] - ifFalse: [ - inInterpretVars ifTrue: [ - (inLine findString: ''register struct foo * foo = &fum;'') > 0 ifTrue: [ - outLine := ''register struct foo * foo FOO_REG = &fum;'' ]. - (inLine findString: '' localIP;'') > 0 ifTrue: [ - outLine := '' char* localIP IP_REG;'' ]. - (inLine findString: '' localFP;'') > 0 ifTrue: [ - outLine := '' char* localFP FP_REG;'' ]. - (inLine findString: '' localSP;'') > 0 ifTrue: [ - outLine := '' char* localSP SP_REG;'' ]. - (inLine findString: '' currentBytecode;'') > 0 ifTrue: [ - outLine := '' sqInt currentBytecode CB_REG;'' ]. - inLine isEmpty ifTrue: [ - "reached end of variables" - inInterpretVars := false. - outLine := '' JUMP_TABLE;''. - extraOutLine := inLine ] ] - ifFalse: [ - inInterpret ifTrue: [ - "working inside interpret(); translate the switch statement" - (inLine beginsWith: '' case '') ifTrue: [ - caseLabel := (inLine findTokens: '' :'') second. - outLine := '' CASE('', caseLabel, '')'' ]. - inLine = '' break;'' ifTrue: [ - outLine := '' BREAK;'' ]. - inLine = ''}'' ifTrue: [ - "all finished with interpret()" - inInterpret := false ] ] - ifFalse: [ - beforePrimitiveResponse ifTrue: [ - (inLine beginsWith: ''primitiveResponse('') ifTrue: [ - "into primitiveResponse we go" - beforePrimitiveResponse := false. - inPrimitiveResponse := true. - extraOutLine := '' PRIM_TABLE;'' ] ] - ifFalse: [ - inPrimitiveResponse ifTrue: [ - inLine = '' switch (primitiveIndex) {'' ifTrue: [ - extraOutLine := outLine. - outLine := '' PRIM_DISPATCH;'' ]. - inLine = '' switch (GIV(primitiveIndex)) {'' ifTrue: [ - extraOutLine := outLine. - outLine := '' PRIM_DISPATCH;'' ]. - (inLine beginsWith: '' case '') ifTrue: [ - caseLabel := (inLine findTokens: '' :'') second. - outLine := '' CASE('', caseLabel, '')'' ]. - inLine = ''}'' ifTrue: [ - inPrimitiveResponse := false ] ] - ] ] ] ]. +!Float32ArrayTest methodsFor: 'Tests' stamp: 'jmv 9/3/2020 18:39:55'! +testIsType + self assert: (#[1.2 2.4 3.6 ] is: #Collection). + self assert: (#[1.2 2.4 3.6] asFloat32Array is: #Float32Array).! ! - outFileStream nextPutAll: outLine; cr. - extraOutLine ifNotNil: [ - outFileStream nextPutAll: extraOutLine; cr ]]]. +!Float32ArrayTest methodsFor: 'Tests' stamp: 'jmv 9/3/2020 18:39:53'! +testZeroArrayDividend - outFileStream close' )! ! + self assert: #[1.2 2.4 0.0 ] asFloat32Array / #[1.2 1.2 1.2 ] asFloat32Array = #[1.0 2.0 0.0 ] asFloat32Array ! ! -!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 6/24/2008 12:28'! -doTestDebuggerTempAccessWith: one with: two - "Test debugger access for temps" - | outerContext local1 remote1 | - outerContext := thisContext. - local1 := 3. - remote1 := 1/2. - self assert: (Compiler new evaluate: 'one' in: thisContext to: self) == one. - self assert: (Compiler new evaluate: 'two' in: thisContext to: self) == two. - self assert: (Compiler new evaluate: 'local1' in: thisContext to: self) == local1. - self assert: (Compiler new evaluate: 'remote1' in: thisContext to: self) == remote1. - Compiler new evaluate: 'local1 := -3.0' in: thisContext to: self. - self assert: local1 = -3.0. - (1 to: 2) do: - [:i| | local2 r1 r2 r3 r4 | - local2 := i * 3. - remote1 := local2 / 7. - self assert: thisContext ~~ outerContext. - self assert: (r1 := Compiler new evaluate: 'one' in: thisContext to: self) == one. - self assert: (r2 := Compiler new evaluate: 'two' in: thisContext to: self) == two. - self assert: (r3 := Compiler new evaluate: 'i' in: thisContext to: self) == i. - self assert: (r4 := Compiler new evaluate: 'local2' in: thisContext to: self) == local2. - self assert: (r4 := Compiler new evaluate: 'remote1' in: thisContext to: self) == remote1. - self assert: (r4 := Compiler new evaluate: 'remote1' in: outerContext to: self) == remote1. - Compiler new evaluate: 'local2 := 15' in: thisContext to: self. - self assert: local2 = 15. - Compiler new evaluate: 'local1 := 25' in: thisContext to: self. - self assert: local1 = 25. - { r1. r2. r3. r4 } "placate the compiler"]. - self assert: local1 = 25. - self assert: remote1 = (6/7)! ! +!Float32ArrayTest methodsFor: 'Tests' stamp: 'jmv 9/3/2020 18:40:16'! +testZeroArrayDivisor -!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 6/1/2021 14:22:49'! -supportTestSourceRangeAccessForDecompiledInjectInto: method source: source - "Test debugger source range selection for inject:into:" - ^self - supportTestSourceRangeAccessForInjectInto: method - source: source - selectionSequence: #( '_ arg1' - 'do: [:argm1_5 | temp3 _ arg2 value: temp3 value: argm1_5]' - 'value: temp3 value: argm1_5' - '_ arg2 value: temp3 value: argm1_5' - 'temp3 _ arg2 value: temp3 value: argm1_5' - 'value: temp3 value: argm1_5' - '_ arg2 value: temp3 value: argm1_5' - 'temp3 _ arg2 value: temp3 value: argm1_5' - '^temp3')! ! + "Test implicit exception" + self should: [ #[1.2 2.4 3.6 ] asFloat32Array / #[1.0 1.0 0.0 ] asFloat32Array] raise: ZeroDivide. -!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 6/4/2008 19:44'! -supportTestSourceRangeAccessForDecompiledNoBytecodeInjectInto: method source: source - "Test debugger source range selection for inject:into:" - ^self - supportTestSourceRangeAccessForInjectInto: method - source: source - selectionSequence: #( 'at: 1 put: t1' - 'do: [:t4 | t3 at: 1 put: (t2 value: (t3 at: 1) value: t4)]' - 'value: (t3 at: 1) value: t4' - 'at: 1 put: (t2 value: (t3 at: 1) value: t4)' - ']' - 'value: (t3 at: 1) value: t4' - 'at: 1 put: (t2 value: (t3 at: 1) value: t4)' - ']' - '^t3 at: 1')! ! + "Test explicit alternative value" + self assert: (#[1.0 2.0 3.141592 0.0] asFloat32Array divideBy: #[1.0 1.0 0.0 0.0 ] asFloat32Array ifDivisorZero: -100 ifBothZero: -200) = + #[1.0 2.0 -100.0 -200.0 ] asFloat32Array. -!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 12/30/2009 14:17'! -supportTestSourceRangeAccessForInjectInto: method source: source - "Test debugger source range selection for inject:into:" - ^self - supportTestSourceRangeAccessForInjectInto: method - source: source - selectionSequence: #( '_ thisValue' - 'do: [:each | nextValue _ binaryBlock value: nextValue value: each]' - 'value: nextValue value: each' - '_ binaryBlock value: nextValue value: each' - 'nextValue _ binaryBlock value: nextValue value: each' - 'value: nextValue value: each' - '_ binaryBlock value: nextValue value: each' - 'nextValue _ binaryBlock value: nextValue value: each' - '^nextValue')! ! + "Test explicit exceptions" + self should: [ + #[1.0 2.0 3.141592] asFloat32Array + divideBy: #[1.0 1.0 0.0] + ifDivisorZero: [ZeroDivide signal ] + ifBothZero: [DomainError signal ]] + raise: ZeroDivide. + self should: [ + #[0.0 2.0 3.141592] asFloat32Array + divideBy: #[0.0 1.0 1.0] + ifDivisorZero: [ZeroDivide signal ] + ifBothZero: [DomainError signal ]] + raise: DomainError. -!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 7/29/2008 17:16'! -supportTestSourceRangeAccessForInjectInto: method source: source selectionSequence: selections - "Test debugger source range selection for inject:into:" - | evaluationCount sourceMap debugTokenSequence debugCount | - DebuggerMethodMap voidMapCache. - evaluationCount := 0. - sourceMap := method debuggerMap abstractSourceMap. - debugTokenSequence := selections collect: [:string| Scanner new scanTokens: string]. - debugCount := 0. - thisContext - runSimulated: [(1 to: 2) - withArgs: - { 0. - [:sum :each| - evaluationCount := evaluationCount + 1. - sum + each]} - executeMethod: method] - contextAtEachStep: - [:ctxt| | range debugTokens | - (ctxt method == method - and: ["Exclude the send of #blockCopy: or #closureCopy:copiedValues: and braceWith:with: - to create the block, and the #new: and #at:'s for the indirect temp vector. - This for compilation without closure bytecodes. (Note that at:put:'s correspond to stores)" - (ctxt willSend - and: [(#(closureCopy:copiedValues: blockCopy: new: at: braceWith:with:) includes: ctxt selectorToSendOrSelf) not]) - "Exclude the store of the argument into the home context (for BlueBook blocks) - and the store of an indirection vector into an initial temp" - or: [(ctxt willStore - and: [(ctxt isBlock and: [ctxt pc = ctxt startpc]) not - and: [(ctxt isBlock not - and: [(method usesClosureBytecodes and: [ctxt abstractPC = 2])]) not]]) - or: [ctxt willReturn]]]) ifTrue: - [debugTokens := debugTokenSequence at: (debugCount := debugCount + 1) ifAbsent: [#(bogusToken)]. - self assert: (sourceMap includesKey: ctxt abstractPC). - range := sourceMap at: ctxt abstractPC ifAbsent: [(1 to: 0)]. - self assert: (Scanner new scanTokens: (source copyFrom: range first to: range last)) = debugTokens]]. - self assert: evaluationCount = 2! ! + "Test non local returns in blocks" + self assert: self divideByArrayOne = #[0.0 2.0 3.141592] asFloat32Array. + self assert: self divideByArrayZero = #divisionByZero. + self assert: self divideByArrayIndeterminate = #indeterminateResult.! ! -!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 6/1/2021 14:17:23'! -testBlockDoitDecompilation - "Tests that decompile of a doit block with remote vars executes correcly" - "Tests that decompilation of a Block, when 'method' of block is equivalent to that compiled by a DoIt, preserves the temp names " - - | blockSourceStream methodNode block decompiledBlock method | - blockSourceStream := '|x y| [:a :b | x _ a. y _ b. x + y]' readStream. - methodNode := Compiler new - from: blockSourceStream class: nil class context: nil notifying: nil; - translate: blockSourceStream noPattern: true ifFail: [nil]. - method _ methodNode generate. - block := nil withArgs: #() executeMethod: method. - - self shouldnt: [decompiledBlock := block decompile] raise: Error. - self assert: - '{[ :argm0_4 :argm0_5 | - temp1 _ argm0_4. - temp3 _ argm0_5. - temp1 + temp3. ]}' equals: decompiledBlock printString -! ! +!Float32ArrayTest methodsFor: 'Tests' stamp: 'jmv 9/3/2020 18:39:33'! +testZeroDividend -!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 1/17/2011 00:13'! -testBlockNumbering - "Test that the compiler and CompiledMethod agree on the block numbering of a substantial doit." - "self new testBlockNumbering" - | methodNode method tempRefs | - methodNode _ - Parser new - encoderClass: EncoderForV3PlusClosures; - parse: 'foo - | numCopiedValuesCounts | - numCopiedValuesCounts := Dictionary new. - 0 to: 32 do: [:i| numCopiedValuesCounts at: i put: 0]. - Transcript clear. - Smalltalk allClassesDo: - [:c| - {c. c class} do: - [:b| - Transcript nextPut: b name first; endEntry. - b selectorsAndMethodsDo: - [:s :m| | pn | - m isQuick not ifTrue: - [pn := b parserClass new - encoderClass: EncoderForV3PlusClosures; - parse: (b sourceCodeAt: s) - class: b. - pn generate: #(0 0 0 0). - [pn accept: nil] - on: MessageNotUnderstood - do: [:ex| | msg numCopied | - msg := ex message. - (msg selector == #visitBlockNode: - and: [(msg argument instVarNamed: ''optimized'') not]) ifTrue: - [numCopied := (msg argument computeCopiedValues: pn) size. - numCopiedValuesCounts - at: numCopied - put: (numCopiedValuesCounts at: numCopied) + 1]. - msg setSelector: #==. - ex resume: nil]]]]]. - numCopiedValuesCounts' - class: Object. - method _ methodNode generate: #(0 0 0 0). - tempRefs _ methodNode encoder blockExtentsToTempsMap. - self assert: tempRefs keys asSet = method startpcsToBlockExtents values asSet! ! + self assert: #[1.2 2.4 3.6 0.0 ] asFloat32Array / 1.2 = #[1.0 2.0 3.0 0.0 ] asFloat32Array ! ! -!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 1/17/2011 00:13'! -testBlockNumberingForInjectInto - "Test that the compiler and CompiledMethod agree on the block numbering of Collection>>inject:into: - and that temp names for inject:into: are recorded." - "self new testBlockNumberingForInjectInto" - | methodNode method tempRefs | - methodNode := Parser new - encoderClass: EncoderForV3PlusClosures; - parse: (Collection sourceCodeAt: #inject:into:) - class: Collection. - method := methodNode generate: #(0 0 0 0). - tempRefs := methodNode encoder blockExtentsToTempsMap. - self assert: tempRefs keys asSet = method startpcsToBlockExtents values asSet. - self assert: ((tempRefs includesKey: (0 to: 6)) - and: [(tempRefs at: (0 to: 6)) hasEqualElements: #(('thisValue' 1) ('binaryBlock' 2) ('nextValue' (3 1)))]). - self assert: ((tempRefs includesKey: (2 to: 4)) - and: [(tempRefs at: (2 to: 4)) hasEqualElements: #(('each' 1) ('binaryBlock' 2) ('nextValue' (3 1)))])! ! +!Float32ArrayTest methodsFor: 'Tests' stamp: 'jmv 9/3/2020 18:39:30'! +testZeroDivisor -!ClosureCompilerTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 07:20:04'! -testDebuggerTempAccess + "Test implicit exception" + self should: [ #[1.2 2.4 3.6 ] asFloat32Array / 0.0] raise: ZeroDivide. - "This test also fails in Squeak. Check if it is ever fixed." - self shouldFail: [ self doTestDebuggerTempAccessWith: 1 with: 2 ]! ! + "Test explicit alternative value" + self assert: (#[1.0 2.0 3.141592 0.0] asFloat32Array divideBy: 0.0 ifDivisorZero: -100 ifBothZero: -200) = + #[-100.0 -100.0 -100.0 -200.0 ] asFloat32Array. -!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 6/1/2021 14:19:36'! -testInjectIntoDecompilationsEncoderForV3PlusClosures - "Test various compilations decompile to the same code for a method sufficiently - simple that this is possible and sufficiently complex that the code generated - varies between the compilations." - "self new testInjectIntoDecompilationsEncoderForV3PlusClosures" - | source | + "Test explicit exceptions" + self should: [ + #[1.0 2.0 3.141592] asFloat32Array + divideBy: 0.0 + ifDivisorZero: [ZeroDivide signal ] + ifBothZero: [DomainError signal ]] + raise: ZeroDivide. + self should: [ + #[0.0 2.0 3.141592] asFloat32Array + divideBy: 0.0 + ifDivisorZero: [ZeroDivide signal ] + ifBothZero: [DomainError signal ]] + raise: DomainError. - source := (Collection sourceCodeAt: #inject:into:) asString. - { EncoderForV3PlusClosures } do: - [:encoderClass| | method | - method := (Parser new - encoderClass: encoderClass; - parse: source - class: Collection) - generate: #(0 0 0 0). - self assert: (Scanner new scanTokens: method decompileString) - = #(inject: arg1 into: arg2 - | temp3 | - temp3 _ arg1 . - self do: [ ':argm1_5' | temp3 _ arg2 value: temp3 value: argm1_5 ] . - ^ temp3 . )]! ! + "Test non local returns in blocks" + self assert: self divideByScalarOne = #[0.0 2.0 3.141592] asFloat32Array. + self assert: self divideByScalarZero = #divisionByZero. + self assert: self divideByScalarIndeterminate = #indeterminateResult.! ! -!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 5/27/2015 13:04'! -testInjectIntoDecompiledDebugs - "Test various debugs of the decompiled form debug correctly." - "self new testInjectIntoDecompiledDebugs" - | source | +!Float32ArrayTest methodsFor: 'Aux' stamp: 'jmv 9/3/2020 18:40:09'! +divideByArrayIndeterminate + "An example for testing. Uses a method to test behavior of non-local return." + ^#[0.0 2.0 3.141592] asFloat32Array + divideBy: #[0.0 2.0 3.141592] asFloat32Array + ifDivisorZero: [^ #divisionByZero] + ifBothZero: [^ #indeterminateResult]! ! - source := (Collection sourceCodeAt: #inject:into:) asString. - { EncoderForV3PlusClosures } do: - [:encoderClass| | method | - method := (Parser new - encoderClass: encoderClass; - parse: source - class: Collection) - generate: #(0 0 0 0). - self supportTestSourceRangeAccessForDecompiledInjectInto: method source: method decompileString]! ! +!Float32ArrayTest methodsFor: 'Aux' stamp: 'jmv 9/3/2020 18:40:13'! +divideByArrayOne + "An example for testing. Uses a method to test behavior of non-local return." + ^#[0.0 2.0 3.141592] asFloat32Array + divideBy: #[1.0 1.0 1.0] asFloat32Array + ifDivisorZero: [^ #divisionByZero] + ifBothZero: [^ #indeterminateResult]! ! -!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 7/24/2009 11:51'! -testInlineBlockCollectionEM1 - | a1 b1 i1 a2 b2 i2 we wb | - b1 := OrderedCollection new. - i1 := 1. - [a1 := i1. - i1 <= 3] whileTrue: - [b1 add: [a1]. - i1 := i1 + 1]. - b1 := b1 asArray collect: [:b | b value]. - b2 := OrderedCollection new. - i2 := 1. - we := [a2 := i2. i2 <= 3]. - wb := [b2 add: [a2]. i2 := i2 + 1]. - we whileTrue: wb. "defeat optimization" - b2 := b2 asArray collect: [:b | b value]. - self assert: b1 = b2! ! +!Float32ArrayTest methodsFor: 'Aux' stamp: 'jmv 9/3/2020 18:40:03'! +divideByArrayZero + "An example for testing. Uses a method to test behavior of non-local return." + ^#[1.0 2.0 3.141592] asFloat32Array + divideBy: #[0.0 2.0 3.141592] asFloat32Array + ifDivisorZero: [^ #divisionByZero] + ifBothZero: [^ #indeterminateResult]! ! -!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 3/7/2009 11:25'! -testInlineBlockCollectionLR1 - "Test case from Lukas Renggli" - | col | - col := OrderedCollection new. - 1 to: 11 do: [ :each | col add: [ each ] ]. - self assert: (col collect: [ :each | each value ]) asArray = (1 to: 11) asArray! ! +!Float32ArrayTest methodsFor: 'Aux' stamp: 'jmv 9/3/2020 18:40:00'! +divideByScalarIndeterminate + "An example for testing. Uses a method to test behavior of non-local return." + ^#[0.0 2.0 3.141592] asFloat32Array + divideBy: 0.0 + ifDivisorZero: [^ #divisionByZero] + ifBothZero: [^ #indeterminateResult]! ! -!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 3/7/2009 11:39'! -testInlineBlockCollectionLR2 - "Test case from Lukas Renggli" - | col | - col := OrderedCollection new. - 1 to: 11 do: [ :each | #(1) do: [:ignored| col add: [ each ]] ]. - self assert: (col collect: [ :each | each value ]) asArray = (1 to: 11) asArray! ! +!Float32ArrayTest methodsFor: 'Aux' stamp: 'jmv 9/3/2020 18:39:00'! +divideByScalarOne + "An example for testing. Uses a method to test behavior of non-local return." + ^#[0.0 2.0 3.141592] asFloat32Array + divideBy: 1.0 + ifDivisorZero: [^ #divisionByZero] + ifBothZero: [^ #indeterminateResult]! ! -!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 3/9/2009 11:00'! -testInlineBlockCollectionLR3 - | col | - col := OrderedCollection new. - 1 to: 11 do: [ :each | | i | i := each. col add: [ i ]. i := i + 1 ]. - self assert: (col collect: [ :each | each value ]) asArray = (2 to: 12) asArray! ! +!Float32ArrayTest methodsFor: 'Aux' stamp: 'jmv 9/3/2020 18:39:02'! +divideByScalarZero + "An example for testing. Uses a method to test behavior of non-local return." + ^#[1.0 2.0 3.141592] asFloat32Array + divideBy: 0.0 + ifDivisorZero: [^ #divisionByZero] + ifBothZero: [^ #indeterminateResult]! ! -!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 7/22/2009 16:55'! -testInlineBlockCollectionSD1 - | a1 b1 a2 b2 | - b1 := OrderedCollection new. - 1 to: 3 do: - [:i | - a1 := i. - b1 add: [a1]]. - b1 := b1 asArray collect: [:b | b value]. - b2 := OrderedCollection new. - 1 to: 3 do: - [:i | - a2 := i. - b2 add: [a2]] yourself. "defeat optimization" - b2 := b2 asArray collect: [:b | b value]. - self assert: b1 = b2! ! - -!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 6/4/2008 15:20'! -testSourceRangeAccessForClosureBytecodeInjectInto - "Test debugger source range selection for inject:into: for a version compiled with closures" - "self new testSourceRangeAccessForClosureBytecodeInjectInto" - | source method | - source := (Collection sourceCodeAt: #inject:into:) asString. - method := (Parser new - encoderClass: EncoderForV3PlusClosures; - parse: source - class: Collection) - generate: (Collection compiledMethodAt: #inject:into:) trailer. - self supportTestSourceRangeAccessForInjectInto: method source: source! ! +!Float64ArrayTest methodsFor: 'Tests' stamp: 'jpb 8/2/2019 23:07:59'! +testIsCollection + self assert: (#[1.0 2.0 3.141592 0.0] is: #Collection). + self assert: (#[-100.0 -100.0 -100.0 -200.0 ] is: #Collection).! ! -!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 6/4/2008 11:40'! -testSourceRangeAccessForInjectInto - "Test debugger source range selection for inject:into: for the current version of the method" - "self new testSourceRangeAccessForInjectInto" - self supportTestSourceRangeAccessForInjectInto: (Collection compiledMethodAt: #inject:into:) - source: (Collection sourceCodeAt: #inject:into:) asString! ! +!Float64ArrayTest methodsFor: 'Tests' stamp: 'jmv 7/9/2018 09:38:50'! +testZeroArrayDividend -!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 6/15/2008 11:26'! -testTempNameAccessForInjectInto - "self new testTempNameAccessForInjectInto" - | methodNode method evaluationCount block debuggerMap | - methodNode := Parser new - encoderClass: EncoderForV3PlusClosures; - parse: (Collection sourceCodeAt: #inject:into:) - class: Collection. - method := methodNode generate: #(0 0 0 0). - debuggerMap := DebuggerMethodMap forMethod: method methodNode: methodNode. - evaluationCount := 0. - block := [:prev :each| | theContext tempNames | - evaluationCount := evaluationCount + 1. - theContext := thisContext sender. - tempNames := debuggerMap tempNamesForContext: theContext. - self assert: (tempNames hasEqualElements: tempNames). - #('thisValue' 'each' 'binaryBlock' 'nextValue') - with: { 0. each. block. prev} - do: [:tempName :value| - self assert: (debuggerMap namedTempAt: (tempNames indexOf: tempName) in: theContext) == value. - tempName ~= 'each' ifTrue: - [self assert: (debuggerMap namedTempAt: (tempNames indexOf: tempName) in: theContext home) == value]]]. - (1 to: 10) withArgs: { 0. block } executeMethod: method. - self assert: evaluationCount = 10! ! + self assert: #[1.2 2.4 0.0 ] / #[1.2 1.2 1.2 ] = #[1.0 2.0 0.0 ] ! ! -!ClosureCompilerTest class methodsFor: 'code examples' stamp: 'eem 5/20/2008 09:40'! -methodWithCopiedAndAssignedTemps - | blk "0w" a "0w" b "0w" c "0w" t "0w" r1 "0w" r2 "0w" | - a := 1. "1w" - b := 2. "1w" - c := 4. "1w" - t := 0. "1w" - blk "5w" := ["2" t "3w" := t "3r" + a "3r" + b "3r" + c "3r" ] "4". - r1 "5w" := blk "5r" value. - b "5w" := -100. - r2 "5w" := blk "5r" value. - ^r1 "5r" -> r2 "5r" -> t "5r" +!Float64ArrayTest methodsFor: 'Tests' stamp: 'jmv 7/9/2018 09:51:49'! +testZeroArrayDivisor - "a: main(read(),write(0,1)), block(read(3),write()) => copy; no writes follow read - b: main(read(),write(0,1,5)), block(read(3),write()) => remote; write follows contained read - blk: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5 - c: main(read(),write(0,1)), block(read(3),write()) => copy; no writes follow read - r1: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5 - r2: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5 - t: main(read(5),write(0,1)), block(read(3),write(3)) => remote; read follows contained write" + "Test implicit exception" + self should: [ #[1.2 2.4 3.6 ] / #[1.0 1.0 0.0 ]] raise: ZeroDivide. + "Test explicit alternative value" + self assert: (#[1.0 2.0 3.141592 0.0] copy divideBy: #[1.0 1.0 0.0 0.0 ] ifDivisorZero: -100 ifBothZero: -200) = + #[1.0 2.0 -100.0 -200.0 ]. - "(Parser new - encoderClass: EncoderForV3; - parse: (self class sourceCodeAt: #methodWithCopiedAndAssignedTemps) - class: self class) generateUsingClosures: #(0 0 0 0)"! ! + "Test explicit exceptions" + self should: [ + #[1.0 2.0 3.141592] copy + divideBy: #[1.0 1.0 0.0] + ifDivisorZero: [ZeroDivide signal ] + ifBothZero: [DomainError signal ]] + raise: ZeroDivide. + self should: [ + #[0.0 2.0 3.141592] copy + divideBy: #[0.0 1.0 1.0] + ifDivisorZero: [ZeroDivide signal ] + ifBothZero: [DomainError signal ]] + raise: DomainError. -!ClosureCompilerTest class methodsFor: 'code examples' stamp: 'eem 5/19/2008 20:45'! -methodWithCopiedAndPostClosedOverAssignedTemps - | blk a b c r1 r2 | - a := 1. - b := 2. - c := 4. - blk := [a + b + c]. - r1 := blk value. - b := nil. - r2 := blk value. - r1 -> r2 + "Test non local returns in blocks" + self assert: self divideByArrayOne = #[0.0 2.0 3.141592]. + self assert: self divideByArrayZero = #divisionByZero. + self assert: self divideByArrayIndeterminate = #indeterminateResult.! ! - "(Parser new - encoderClass: EncoderForV3; - parse: (self class sourceCodeAt: #methodWithCopiedAndPostClosedOverAssignedTemps) - class: self class) generateUsingClosures: #(0 0 0 0)"! ! +!Float64ArrayTest methodsFor: 'Tests' stamp: 'jmv 7/9/2018 09:39:14'! +testZeroDividend -!ClosureCompilerTest class methodsFor: 'code examples' stamp: 'eem 5/19/2008 20:10'! -methodWithCopiedTemps - | a b c r | - a := 1. - b := 2. - c := 4. - r := [a + b + c] value. - b := nil. - r + self assert: #[1.2 2.4 3.6 0.0 ] / 1.2 = #[1.0 2.0 3.0 0.0 ] ! ! - "Parser new - parse: (self class sourceCodeAt: #methodWithCopiedTemps) - class: self class" +!Float64ArrayTest methodsFor: 'Tests' stamp: 'jmv 7/9/2018 09:53:42'! +testZeroDivisor - "(Parser new - encoderClass: EncoderForV3; - parse: (self class sourceCodeAt: #methodWithCopiedTemps) - class: self class) generateUsingClosures: #(0 0 0 0)"! ! + "Test implicit exception" + | | + self should: [ #[1.2 2.4 3.6 ] / 0.0] raise: ZeroDivide. -!ClosureCompilerTest class methodsFor: 'code examples' stamp: 'eem 5/19/2008 14:24'! -methodWithOptimizedBlocks - | s c | - s := self isNil - ifTrue: [| a | a := 'isNil'. a] - ifFalse: [| b | b := 'notNil'. b]. - c := String new: s size. - 1 to: s size do: - [:i| c at: i put: (s at: i)]. - ^c + "Test explicit alternative value" + self assert: (#[1.0 2.0 3.141592 0.0] copy divideBy: 0.0 ifDivisorZero: -100 ifBothZero: -200) = + #[-100.0 -100.0 -100.0 -200.0 ]. - "Parser new - parse: (self class sourceCodeAt: #methodWithOptimizedBlocks) - class: self class"! ! + "Test explicit exceptions" + self should: [ + #[1.0 2.0 3.141592] copy + divideBy: 0.0 + ifDivisorZero: [ZeroDivide signal ] + ifBothZero: [DomainError signal ]] + raise: ZeroDivide. + self should: [ + #[0.0 2.0 3.141592] copy + divideBy: 0.0 + ifDivisorZero: [ZeroDivide signal ] + ifBothZero: [DomainError signal ]] + raise: DomainError. -!ClosureCompilerTest class methodsFor: 'code examples' stamp: 'eem 5/19/2008 14:24'! -methodWithOptimizedBlocksA - | s c | - s := self isNil - ifTrue: [| a | a := 'isNil'. a] - ifFalse: [| a | a := 'notNil'. a]. - c := String new: s size. - 1 to: s size do: - [:i| c at: i put: (s at: i)]. - ^c + "Test non local returns in blocks" + self assert: self divideByScalarOne = #[0.0 2.0 3.141592]. + self assert: self divideByScalarZero = #divisionByZero. + self assert: self divideByScalarIndeterminate = #indeterminateResult.! ! - "Parser new - parse: (self class sourceCodeAt: #methodWithOptimizedBlocksA) - class: self class"! ! +!Float64ArrayTest methodsFor: 'Aux' stamp: 'jmv 7/9/2018 09:52:51'! +divideByArrayIndeterminate + "An example for testing. Uses a method to test behavior of non-local return." + ^#[0.0 2.0 3.141592] copy + divideBy: #[0.0 2.0 3.141592] + ifDivisorZero: [^ #divisionByZero] + ifBothZero: [^ #indeterminateResult]! ! -!ClosureCompilerTest class methodsFor: 'code examples' stamp: 'eem 5/19/2008 14:12'! -methodWithVariousTemps - | classes total totalLength | - classes := self withAllSuperclasses. - total := totalLength := 0. - classes do: [:class| | className | - className := class name. - total := total + 1. - totalLength := totalLength + className size]. - ^total -> totalLength +!Float64ArrayTest methodsFor: 'Aux' stamp: 'jmv 7/9/2018 09:52:56'! +divideByArrayOne + "An example for testing. Uses a method to test behavior of non-local return." + ^#[0.0 2.0 3.141592] copy + divideBy: #[1.0 1.0 1.0] + ifDivisorZero: [^ #divisionByZero] + ifBothZero: [^ #indeterminateResult]! ! - "Parser new - parse: (self class sourceCodeAt: #methodWithVariousTemps) - class: self class"! ! +!Float64ArrayTest methodsFor: 'Aux' stamp: 'jmv 7/9/2018 09:53:05'! +divideByArrayZero + "An example for testing. Uses a method to test behavior of non-local return." + ^#[1.0 2.0 3.141592] copy + divideBy: #[0.0 2.0 3.141592] + ifDivisorZero: [^ #divisionByZero] + ifBothZero: [^ #indeterminateResult]! ! -!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! -testSample01 - | blockClosure materialized | - blockClosure _ self bc01. - materialized _ blockClosure veryDeepCopy. - self assert: blockClosure value = materialized value.! ! +!Float64ArrayTest methodsFor: 'Aux' stamp: 'jmv 7/9/2018 09:38:35'! +divideByScalarIndeterminate + "An example for testing. Uses a method to test behavior of non-local return." + ^#[0.0 2.0 3.141592] + divideBy: 0.0 + ifDivisorZero: [^ #divisionByZero] + ifBothZero: [^ #indeterminateResult]! ! -!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! -testSample02 - | blockClosure materialized | - blockClosure _ self bc02. - materialized _ blockClosure veryDeepCopy. - self assert: blockClosure value = materialized value.! ! +!Float64ArrayTest methodsFor: 'Aux' stamp: 'jmv 7/9/2018 09:38:39'! +divideByScalarOne + "An example for testing. Uses a method to test behavior of non-local return." + ^#[0.0 2.0 3.141592] + divideBy: 1.0 + ifDivisorZero: [^ #divisionByZero] + ifBothZero: [^ #indeterminateResult]! ! -!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! -testSample03 - | blockClosure materialized | - blockClosure _ self bc03. - materialized _ blockClosure veryDeepCopy. - self assert: blockClosure value = materialized value. - self assert: blockClosure value = materialized value. - self assert: blockClosure value = materialized value.! ! - -!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! -testSample04 - | blockClosure materialized | - blockClosure _ self bc04. - materialized _ blockClosure veryDeepCopy. - self assert: blockClosure value = materialized value.! ! - -!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! -testSample05 - | blockClosure materialized | - blockClosure _ self bc05. - materialized _ blockClosure veryDeepCopy. - self assert: blockClosure value = materialized value. - self assert: blockClosure value = materialized value. - self assert: blockClosure value = materialized value.! ! - -!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! -testSample06 - | blockClosures materialized firstRun | +!Float64ArrayTest methodsFor: 'Aux' stamp: 'jmv 7/9/2018 09:38:43'! +divideByScalarZero + "An example for testing. Uses a method to test behavior of non-local return." + ^#[1.0 2.0 3.141592] + divideBy: 0.0 + ifDivisorZero: [^ #divisionByZero] + ifBothZero: [^ #indeterminateResult]! ! - blockClosures _ self bc06. - firstRun _ blockClosures second value. - "If sibling closures are serialized separately, their relationship is lost in the copies." - materialized _ blockClosures collect: [ :each | each veryDeepCopy ]. - self assert: blockClosures first value = materialized first value. - self assert: blockClosures second value = materialized second value. - self assert: blockClosures third value = materialized third value. - self assert: blockClosures first value = materialized first value. - self assert: firstRun = materialized second value. - self deny: blockClosures second value = materialized second value. +!Float64ArrayTest methodsFor: 'as yet unclassified' stamp: 'jmv 7/30/2020 21:58:18'! +testSum + | a | + self assert: ({0.0. 1.0. Float pi. Float e} asFloat64Array + 1) = ({0.0+1. 1.0+1. Float pi+1. Float e+1} asFloat64Array). + a _ {0.0. 1.0. Float pi. Float e} asFloat64Array. + self assert: (a + a) = (a * 2 )! ! - blockClosures _ self bc06. - "If sibling closures are serialized together, their relationship is kept in the copies." - materialized _ blockClosures veryDeepCopy. - self assert: blockClosures first value = materialized first value. - self assert: blockClosures second value = materialized second value. - self assert: blockClosures third value = materialized third value. - self assert: blockClosures first value = materialized first value. - self deny: firstRun = materialized second value. - self assert: blockClosures second value = materialized second value.! ! +!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:21:47'! +testUpTo1ShortRecords + ". this test ensures the upTo: delim method behaves as specified by the ANSI standard: + Delimiter is considered a separator (and therefore not required for the last chunk)." + | stream | + stream _ ReadStream on: 'record-1Xrecord-2Xrecord-incomplete'. + self assert: ((stream upTo: $X) = 'record-1'). + self assert: ((stream upTo: $X) = 'record-2'). + self assert: ((stream upTo: $X) = 'record-incomplete'). + self assert: ((stream upTo: $X) = ''). + ". the stream has been all consumed" + self assert: (stream position = 35). ! ! -!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! -testSample07 - | blockClosures materialized | +!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:55:33'! +testUpTo3LongUnterminatedRecord + "Long input, no delimiter found, expected to return all the data chunk up to the end of file. " + | longString stream read | + longString _ (1 to: 100) + inject: '' + into: [ :prev :each | + prev , 'A lot of stuff, needs over 2000 chars!! ' ]. + stream _ ReadStream on: longString. + read _ stream upTo: $X. + self assert: read = longString.! ! - blockClosures _ self bc07. - "If sibling closures are serialized separately, their relationship is lost in the copies." - materialized _ blockClosures collect: [ :each | each veryDeepCopy ]. - self assert: blockClosures first value = materialized first value. - self assert: blockClosures second value = materialized second value. - self deny: blockClosures third value = materialized third value. - self assert: blockClosures second value = materialized second value. - self deny: blockClosures first value = materialized first value. - self deny: blockClosures third value = materialized third value. - self deny: blockClosures first value = materialized first value. +!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:54:11'! +testUpTo4LongUnterminatedRecord + "Big chunk, not delimiter found, expected return all the chunk " + | stuff stream read | + stuff _ String streamContents: [ :strm | + 1 + to: 5000 + do: [ :i | + i < 3000 ifTrue: [ strm nextPut: $a ]. + i >= 3000 ifTrue: [ strm nextPut: $b ]]]. + stream _ ReadStream on: stuff. + read _ stream upTo: $X. + self assert: read size = 5000.! ! - blockClosures _ self bc07. - "If sibling closures are serialized together, their relationship is kept in the copies." - materialized _ blockClosures veryDeepCopy. - self assert: blockClosures first value = materialized first value. - self assert: blockClosures second value = materialized second value. - self assert: blockClosures third value = materialized third value. - self assert: blockClosures second value = materialized second value. - self assert: blockClosures first value = materialized first value. - self assert: blockClosures third value = materialized third value. - self assert: blockClosures first value = materialized first value.! ! +!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:58:48'! +testUpTo5TerminatedAndUnterminatedLongRecords + "Two big chunks, one delimiter in the middle, expected to return + the first time a big chunk, the second time the second block up to EOF. " + | stuff stream read | + stuff _ String streamContents: [ :strm | + 1 + to: 6000 + do: [ :i | + i < 3000 ifTrue: [ strm nextPut: $a ]. + i = 3000 ifTrue: [ strm nextPut: $X ]. + i > 3000 ifTrue: [ strm nextPut: $b ]]]. + stream _ ReadStream on: stuff. + " first scan, the delimiter is found but not printed. " + read _ stream upTo: $X. + self assert: read size = 2999. + self assert: (read at: 1) = $a. + " second scan. the delimiter is not found, all second chunk is returned " + read _ stream upTo: $X. + self assert: read size = 3000. + self assert: (read at: 1) = $b.! ! -!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! -testSample08 - | blockClosures materialized | +!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:59:51'! +testUpTo6TerminatedLongRecords + "Two big chunks, one delimiter in the middle, one at the end. expected to return + two big chunks in two read, delimiters excluded. " + | stuff stream read | + stuff _ String streamContents: [ :strm | + 1 + to: 6000 + do: [ :i | + i < 3000 ifTrue: [ strm nextPut: $a ]. + i = 3000 ifTrue: [ strm nextPut: $X ]. + ((Interval + from: 3001 + to: 5999) includes: i) ifTrue: [ strm nextPut: $b ]. + i = 6000 ifTrue: [ strm nextPut: $X ]]]. + stream _ ReadStream on: stuff. + " first scan, delimiter is found, return all the block delimiter excluded " + read _ stream upTo: $X. + self assert: read size = 2999. + self assert: (read at: 1) = $a. + " second scan, return chunk, delimiter excluded. " + read _ stream upTo: $X. + self assert: read size = 2999. + self assert: (read at: 1) = $b.! ! - blockClosures _ self bc08. - "If sibling closures are serialized separately, their relationship is lost in the copies." - materialized _ blockClosures collect: [ :each | each veryDeepCopy ]. - self assert: blockClosures first value = materialized first value. - self assert: (blockClosures second value: 7) = (materialized second value: 7). - self assert: blockClosures third value = materialized third value. - self deny: (blockClosures second value: 7) = (materialized second value: 7). - self deny: (blockClosures fourth value: 2 value: 3) = (materialized fourth value: 2 value: 3). +!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:00:52'! +testUpToTerminator1ShortRecords + " + . Read a file stream up to 'delim' in a strict way. + . If delim is found returns everything up to the first occurrence of 'delim' included. + . if delim is not found returns nil and set the FileStream position where it was before + the call was made. This ensures if another process writes into the file another delim + limited token we will fully read it on next upTo call. + This means Delimiter is a Terminator: a chunk is only considered well formed if it ends with it. + " + | stream | + stream _ ReadStream on: 'record-1Xrecord-2Xrecord-incomplete'. + self assert: ((stream upTo: $X delimiterIsTerminator: true) = 'record-1X'). + self assert: ((stream upTo: $X delimiterIsTerminator: true) = 'record-2X'). + self assert: ((stream upTo: $X delimiterIsTerminator: true) = nil). + ". we are not at the end of the stream, but just after the last delim was found. + we are ready to receive other delim limitated tokens. if they get written. + " + self assert: (stream position = 18).! ! - blockClosures _ self bc08. - "If sibling closures are serialized together, their relationship is kept in the copies." - materialized _ blockClosures veryDeepCopy. - self assert: blockClosures first value = materialized first value. - self assert: (blockClosures second value: 7) = (materialized second value: 7). - self assert: blockClosures third value = materialized third value. - self assert: (blockClosures second value: 7) = (materialized second value: 7). - self assert: (blockClosures fourth value: 2 value: 3) = (materialized fourth value: 2 value: 3).! ! +!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:01:38'! +testUpToTerminator3LongUnterminatedRecord + "Long input, no delimiter found, expected to return nil. " + | longString stream read | + longString _ (1 to: 100) + inject: '' + into: [ :prev :each | + prev , 'A lot of stuff, needs over 2000 chars!! ' ]. + stream _ ReadStream on: longString. + read _ stream + upTo: $X + delimiterIsTerminator: true. + self assert: read = nil.! ! -!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! -testSample09 - | blockClosures materialized | +!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:02:04'! +testUpToTerminator4LongUnterminatedRecord + "Big chunk, not delimiter found, expected return nil " + | stuff stream read | + stuff _ String streamContents: [ :strm | + 1 + to: 5000 + do: [ :i | + i < 3000 ifTrue: [ strm nextPut: $a ]. + i >= 3000 ifTrue: [ strm nextPut: $b ]]]. + stream _ ReadStream on: stuff. + read _ stream + upTo: $X + delimiterIsTerminator: true. + self assert: read = nil.! ! - blockClosures _ self bc09. - materialized _ blockClosures collect: [ :each | each veryDeepCopy ]. +!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:02:36'! +testUpToTerminator5TerminatedAndUnterminatedLongRecords + "Two big chunks, one delimiter in the middle, expected to return + the first time a big chunk, the second time nil. " + | stuff stream read | + stuff _ String streamContents: [ :strm | + 1 + to: 6000 + do: [ :i | + i < 3000 ifTrue: [ strm nextPut: $a ]. + i = 3000 ifTrue: [ strm nextPut: $X ]. + i > 3000 ifTrue: [ strm nextPut: $b ]]]. + stream _ ReadStream on: stuff. + " first scan, delimiter is found, return all the block delimiter included " + read _ stream + upTo: $X + delimiterIsTerminator: true. + self assert: read size = 3000. + self assert: (read at: 1) = $a. + " second scan, delimiter not found, returns nil " + read _ stream + upTo: $X + delimiterIsTerminator: true. + self assert: read = nil.! ! - self assert: (blockClosures first value: $c) = (materialized first value: $c). - self assert: (blockClosures second value: $d value: #e) = (materialized second value: $d value: #e). - self assert: (blockClosures third value: $d value: $e) = (materialized third value: $d value: $e).! ! - -!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! -testSample10 - | blockClosure1 blockClosure2 blockClosure3 value materialized1 materialized2a materialized2b materialized3a materialized3b materialized3c | +!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:03:06'! +testUpToTerminator6TerminatedLongRecords + "Two big chunks, one delimiter in the middle, one at the end expected to return + two big chunks in two read, delimiters included. " + | stuff stream read | + stuff _ String streamContents: [ :strm | + 1 + to: 6000 + do: [ :i | + i < 3000 ifTrue: [ strm nextPut: $a ]. + i = 3000 ifTrue: [ strm nextPut: $X ]. + ((Interval + from: 3001 + to: 5999) includes: i) ifTrue: [ strm nextPut: $b ]. + i = 6000 ifTrue: [ strm nextPut: $X ]]]. + stream _ ReadStream on: stuff. + " first scan, delimiter is found, return all the block delimiter included " + read _ stream + upTo: $X + delimiterIsTerminator: true. + self assert: read size = 3000. + self assert: (read at: 1) = $a. + " second scan, delimiter found, return chunk, delimiter included " + read _ stream + upTo: $X + delimiterIsTerminator: true. + self assert: read size = 3000. + self assert: (read at: 1) = $b.! ! - blockClosure1 _ self bc10. - blockClosure2 _ blockClosure1 withFirstArg: 1. - blockClosure3 _ (blockClosure1 withFirstArg: 1) withFirstArg: 2. - value _ blockClosure1 value: 1 value: 2. - self assert: (blockClosure2 value: 2) = value. - self assert: blockClosure3 value = value. +!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:06:39'! +testUpTo1ShortRecords + ". this test ensures the upTo: delim method behaves as specified by the ANSI standard: + Delimiter is considered a separator (and therefore not required for the last chunk)." + | stream | + stream _ ReadWriteStream on: ''. + stream nextPutAll: 'record-1Xrecord-2Xrecord-incomplete'. + stream position: 0. + self assert: ((stream upTo: $X) = 'record-1'). + self assert: ((stream upTo: $X) = 'record-2'). + self assert: ((stream upTo: $X) = 'record-incomplete'). + self assert: ((stream upTo: $X) = ''). + ". the stream has been all consumed" + self assert: (stream position = 35). ! ! - materialized1 _ blockClosure1 veryDeepCopy. - materialized2a _ materialized1 withFirstArg: 1. - materialized2b _ blockClosure2 veryDeepCopy. - materialized3a _ (materialized1 withFirstArg: 1) withFirstArg: 2. - materialized3b _ materialized2b withFirstArg: 2. - materialized3c _ blockClosure3 veryDeepCopy. - self assert: (materialized1 value: 1 value: 2) = value. - self assert: (materialized2a value: 2) = value. - self assert: (materialized2b value: 2) = value. - self assert: materialized3a value = value. - self assert: materialized3b value = value. - self assert: materialized3c value = value. -! ! +!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:07:32'! +testUpTo3LongUnterminatedRecord + "Long input, no delimiter found, expected to return all the data chunk up to the end of file. " + | longString stream read | + longString _ (1 to: 100) + inject: '' + into: [ :prev :each | + prev , 'A lot of stuff, needs over 2000 chars!! ' ]. + stream _ ReadWriteStream on: ''. + stream nextPutAll: longString. + stream position: 0. + read _ stream upTo: $X. + self assert: read = longString.! ! -!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! -testSample11 - | blockClosures materialized | +!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:08:12'! +testUpTo4LongUnterminatedRecord + "Big chunk, not delimiter found, expected return all the chunk " + | stuff stream read | + stuff _ String streamContents: [ :strm | + 1 + to: 5000 + do: [ :i | + i < 3000 ifTrue: [ strm nextPut: $a ]. + i >= 3000 ifTrue: [ strm nextPut: $b ]]]. + stream _ ReadWriteStream on: ''. + stream nextPutAll: stuff. + stream position: 0. + read _ stream upTo: $X. + self assert: read size = 5000.! ! - blockClosures _ self bc11. - "If sibling closures are serialized separately, their relationship is lost in the copies." - materialized _ blockClosures collect: [ :each | each veryDeepCopy ]. - self assert: blockClosures first value = materialized first value. - self assert: blockClosures second value = materialized second value. - self deny: blockClosures first value = materialized first value. - self assert: blockClosures second value = materialized second value. - self deny: blockClosures first value = materialized first value. +!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:08:41'! +testUpTo5TerminatedAndUnterminatedLongRecords + "Two big chunks, one delimiter in the middle, expected to return + the first time a big chunk, the second time the second block up to EOF. " + | stuff stream read | + stuff _ String streamContents: [ :strm | + 1 + to: 6000 + do: [ :i | + i < 3000 ifTrue: [ strm nextPut: $a ]. + i = 3000 ifTrue: [ strm nextPut: $X ]. + i > 3000 ifTrue: [ strm nextPut: $b ]]]. + stream _ ReadWriteStream on: ''. + stream nextPutAll: stuff. + stream position: 0. + " first scan, the delimiter is found but not printed. " + read _ stream upTo: $X. + self assert: read size = 2999. + self assert: (read at: 1) = $a. + " second scan. the delimiter is not found, all second chunk is returned " + read _ stream upTo: $X. + self assert: read size = 3000. + self assert: (read at: 1) = $b.! ! - blockClosures _ self bc11. - "If sibling closures are serialized together, their relationship is kept in the copies." - materialized _ blockClosures veryDeepCopy. - self assert: blockClosures first value = materialized first value. - self assert: blockClosures second value = materialized second value. - self assert: blockClosures first value = materialized first value. - self assert: blockClosures second value = materialized second value. - self assert: blockClosures first value = materialized first value.! ! +!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:08:54'! +testUpTo6TerminatedLongRecords + "Two big chunks, one delimiter in the middle, one at the end. expected to return + two big chunks in two read, delimiters excluded. " + | stuff stream read | + stuff _ String streamContents: [ :strm | + 1 + to: 6000 + do: [ :i | + i < 3000 ifTrue: [ strm nextPut: $a ]. + i = 3000 ifTrue: [ strm nextPut: $X ]. + ((Interval + from: 3001 + to: 5999) includes: i) ifTrue: [ strm nextPut: $b ]. + i = 6000 ifTrue: [ strm nextPut: $X ]]]. + stream _ ReadWriteStream on: ''. + stream nextPutAll: stuff. + stream position: 0. + " first scan, delimiter is found, return all the block delimiter excluded " + read _ stream upTo: $X. + self assert: read size = 2999. + self assert: (read at: 1) = $a. + " second scan, return chunk, delimiter excluded. " + read _ stream upTo: $X. + self assert: read size = 2999. + self assert: (read at: 1) = $b.! ! -!ClosureSerializationTest methodsFor: 'aux' stamp: 'jmv 9/26/2019 23:19:41'! -gimme5 - ^1+4! ! +!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:12:06'! +testUpToTerminator1ShortRecords + " + . Read a file stream up to 'delim' in a strict way. + . If delim is found returns everything up to the first occurrence of 'delim' included. + . if delim is not found returns nil and set the FileStream position where it was before + the call was made. This ensures if another process writes into the file another delim + limited token we will fully read it on next upTo call. + This means Delimiter is a Terminator: a chunk is only considered well formed if it ends with it. + " + | stream | + stream _ ReadWriteStream on: ''. + stream nextPutAll: 'record-1Xrecord-2Xrecord-incomplete'. + stream position: 0. + self assert: ((stream upTo: $X delimiterIsTerminator: true) = 'record-1X'). + self assert: ((stream upTo: $X delimiterIsTerminator: true) = 'record-2X'). + self assert: ((stream upTo: $X delimiterIsTerminator: true) = nil). + ". we are not at the end of the stream, but just after the last delim was found. + we are ready to receive other delim limitated tokens. if they get written. + " + self assert: (stream position = 18).! ! -!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! -bc01 - ^[ self gimme5 ]! ! +!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:12:49'! +testUpToTerminator3LongUnterminatedRecord + "Long input, no delimiter found, expected to return nil. " + | longString stream read | + longString _ (1 to: 100) + inject: '' + into: [ :prev :each | + prev , 'A lot of stuff, needs over 2000 chars!! ' ]. + stream _ ReadWriteStream on: ''. + stream nextPutAll: longString. + stream position: 0. + read _ stream + upTo: $X + delimiterIsTerminator: true. + self assert: read = nil.! ! -!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! -bc02 - ^[ ivar + 4 ]! ! +!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:13:03'! +testUpToTerminator4LongUnterminatedRecord + "Big chunk, not delimiter found, expected return nil " + | stuff stream read | + stuff _ String streamContents: [ :strm | + 1 + to: 5000 + do: [ :i | + i < 3000 ifTrue: [ strm nextPut: $a ]. + i >= 3000 ifTrue: [ strm nextPut: $b ]]]. + stream _ ReadWriteStream on: ''. + stream nextPutAll: stuff. + stream position: 0. + read _ stream + upTo: $X + delimiterIsTerminator: true. + self assert: read = nil.! ! -!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! -bc03 - ^[ ivar _ ivar + 3 ]! ! +!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:13:18'! +testUpToTerminator5TerminatedAndUnterminatedLongRecords + "Two big chunks, one delimiter in the middle, expected to return + the first time a big chunk, the second time nil. " + | stuff stream read | + stuff _ String streamContents: [ :strm | + 1 + to: 6000 + do: [ :i | + i < 3000 ifTrue: [ strm nextPut: $a ]. + i = 3000 ifTrue: [ strm nextPut: $X ]. + i > 3000 ifTrue: [ strm nextPut: $b ]]]. + stream _ ReadWriteStream on: ''. + stream nextPutAll: stuff. + stream position: 0. + " first scan, delimiter is found, return all the block delimiter included " + read _ stream + upTo: $X + delimiterIsTerminator: true. + self assert: read size = 3000. + self assert: (read at: 1) = $a. + " second scan, delimiter not found, returns nil " + read _ stream + upTo: $X + delimiterIsTerminator: true. + self assert: read = nil.! ! -!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! -bc04 - | t | - t _ self gimme5. - ^[ t * 2 ]! ! +!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:13:33'! +testUpToTerminator6TerminatedLongRecords + "Two big chunks, one delimiter in the middle, one at the end expected to return + two big chunks in two read, delimiters included. " + | stuff stream read | + stuff _ String streamContents: [ :strm | + 1 + to: 6000 + do: [ :i | + i < 3000 ifTrue: [ strm nextPut: $a ]. + i = 3000 ifTrue: [ strm nextPut: $X ]. + ((Interval + from: 3001 + to: 5999) includes: i) ifTrue: [ strm nextPut: $b ]. + i = 6000 ifTrue: [ strm nextPut: $X ]]]. + stream _ ReadWriteStream on: ''. + stream nextPutAll: stuff. + stream position: 0. + " first scan, delimiter is found, return all the block delimiter included " + read _ stream + upTo: $X + delimiterIsTerminator: true. + self assert: read size = 3000. + self assert: (read at: 1) = $a. + " second scan, delimiter found, return chunk, delimiter included " + read _ stream + upTo: $X + delimiterIsTerminator: true. + self assert: read size = 3000. + self assert: (read at: 1) = $b.! ! -!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! -bc05 - | t | - t _ self gimme5. - ^[ t _ t * 2 ]! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'jpb 8/2/2019 23:49:13'! +testIsStream + self assert: ((WriteStream on: '') is: #Stream).! ! -!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! -bc06 - | u t | - u _ self gimme5 + 2. - t _ self gimme5. - ^{[ u * 2 ]. [ t * 2 ].[t _ t*3]}.! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:27:06'! +testNewLineTabWhenConditionIsFalseDoesNotPutANewLineTabInStream -!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! -bc07 - | a b c d e f g | - a _ self gimme5 + 1. - b _ self gimme5 + 2. - c _ self gimme5 + 3. - d _ self gimme5 + 4. - e _ self gimme5 + 5. - f _ self gimme5 + 6. - g _ self gimme5 + 7. - ^{[ a * 10 + b * 10 + c * 10 + d * 10 + e + f + g ]. [ a _ 7. a * 2 ].[ c _ 9. d _ d*10. a * 10 + b * 10 + c + d]}.! ! + | stream | -!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! -bc08 + stream := WriteStream on: ''. + stream newLineTab: 2 when: false. + + self assert: stream contents isEmpty + ! ! - | u t | - u _ self gimme5 + 2. - t _ self gimme5. - ^{ - [ | x y z | x _ t. y _ x*0+2. z _ x * t. {u * 2. x. y. z} ]. - [ :a | t * 2 + a ]. - [|x y | t _ t*3. y _ t*2. {x. t. y}]. - [:a :b | a * b * t ] - }.! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:28:04'! +testNewLineTabWhenConditionIsTruePutsANewLineTabInStream -!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! -bc09 + | stream | - | clo1 clo2 closure | - closure := ( - ([ :a | - [ :b | - clo1 := [ :c | {c. b. a.}]. - clo2 := [ :d :e | {a. b. e. d.}] - ] - ]) value: $a - ) value: 'b'. - ^{ clo1. clo2. closure }! ! + stream := WriteStream on: ''. + stream newLineTab: 2 when: true. + + self assert: (String streamContents: [ :s | s newLineTab: 2 ]) equals: stream contents + ! ! -!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! -bc10 +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:20:47'! +testNewLineWhenConditionIsFalseDoesNotPutANewLineInStream - ^ [ :a :b | a + b ]! ! + | stream | -!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! -bc11 - | a b c d e f g | - a _ self gimme5 + 1. - b _ self gimme5 + 2. - c _ self gimme5 + 3. - d _ self gimme5 + 4. - e _ self gimme5 + 5. - f _ self gimme5 + 6. - g _ self gimme5 + 7. - { b. d. e. f } print. - ^{[ g + a * 10 + a + a + g + c ]. [ b _ 7. c _ c * 2 ]}.! ! + stream := WriteStream on: ''. + stream newLineWhen: false. + + self assert: stream contents isEmpty + ! ! -!ClosureSerializationTest methodsFor: 'setUp/tearDown' stamp: 'jmv 9/26/2019 23:19:41'! -setUp - ivar _ 7. - ^ivar! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:22:05'! +testNewLineWhenConditionIsTruePutsANewLineInStream -!ClosureTests methodsFor: 'utilities' stamp: 'lr 3/9/2009 16:48'! -assertValues: anArray - | values | - values := collection collect: [ :each | each value ]. - self - assert: anArray asArray = values asArray - description: 'Expected: ' , anArray asArray printString , - ', but got ' , values asArray printString! ! + | stream | -!ClosureTests methodsFor: 'utilities' stamp: 'cwp 11/16/2009 08:12'! -evaluateCopyOf: aBlock - aBlock copy value! ! + stream := WriteStream on: ''. + stream newLineWhen: true. + + self assert: Character newLineCharacter asString equals: stream contents + ! ! -!ClosureTests methodsFor: 'utilities' stamp: 'cwp 11/16/2009 08:12'! -methodWithNonLocalReturn - self evaluateCopyOf: [^ self]. - self signalFailure: 'Should never reach here'! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:06:13'! +testNextPutAllWhenConditionIsFalseDoesNotPutCollectionInStream -!ClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:35'! -methodArgument: anObject - ^ [ anObject ] - ! ! + | stream | -!ClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:33'! -testBlockArgument - | block block1 block2 | - block := [ :arg | | temp | temp := arg. [ temp ] ]. - block1 := block value: 1. - block2 := block value: 2. - self assert: block1 value = 1. - self assert: block2 value = 2! ! + stream := WriteStream on: ''. + stream nextPutAll: 'other' when: false. + + self assert: stream contents isEmpty + ! ! -!ClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:33'! -testBlockTemp - | block block1 block2 | - block := [ :arg | [ arg ] ]. - block1 := block value: 1. - block2 := block value: 2. - self assert: block1 value = 1. - self assert: block2 value = 2! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:06:19'! +testNextPutAllWhenConditionIsTruePutsCollectionInStream -!ClosureTests methodsFor: 'testing' stamp: 'cwp 11/16/2009 08:11'! -testCopyNonLocalReturn - self - shouldnt: [self methodWithNonLocalReturn] - raise: Error! ! + | stream | + + stream := WriteStream on: ''. + stream nextPutAll: 'other' when: true. + + self assert: 'other' equals: stream contents + + ! ! -!ClosureTests methodsFor: 'testing' stamp: 'jmv 7/3/2019 09:38:17'! -testIsTrivialClosure - " - ClosureTests new testIsTrivialClosure - " - | tempVar | - tempVar _ 1. - self assert: [ 3 + 4 ] isCleanClosure. - self assert: [ :a | a * 2 ] isCleanClosure. - self assert: [ Smalltalk size ] isCleanClosure. - self assert: [ ClosureTests selectors size ] isCleanClosure. - self assert: [ :blockArg | blockArg printString ] isCleanClosure. - self assert: [ | blockTemp | blockTemp printString ] isCleanClosure. - self assert: [ | blockTemp | blockTemp _ 7 ] isCleanClosure. - self assert: [ | c | c _ [ :a :b | a+b ]. c value: 3 value: 4 ] isCleanClosure. +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:06:24'! +testNextPutWhenConditionIsFalseDoesNotPutObjectInStream - self assert: [ | outerBlockTemp | [ outerBlockTemp printString ] ] isCleanClosure. - self assert: [ | outerBlockTemp | [ outerBlockTemp _ 7 ] ] isCleanClosure. - self assert: [ | outerBlockTemp | [[ outerBlockTemp printString ]] ] isCleanClosure. - self assert: [ | outerBlockTemp | [[ outerBlockTemp _ 7 ]] ] isCleanClosure. - self assert: [ [| outerBlockTemp | [ outerBlockTemp printString ]] ] isCleanClosure. - self assert: [ [| outerBlockTemp | [ outerBlockTemp _ 7 ]] ] isCleanClosure. + | stream | + + stream := WriteStream on: ''. + stream nextPut: $t when: false. + + self assert: stream contents isEmpty + + ! ! - self deny: [ | outerBlockTemp | [ outerBlockTemp printString ] isCleanClosure ] value. - self deny: [ | outerBlockTemp | [ outerBlockTemp _ 7 ] isCleanClosure ] value. - self deny: [ | outerBlockTemp | [[ outerBlockTemp printString ]] isCleanClosure ] value. - self deny: [ | outerBlockTemp | [[ outerBlockTemp _ 7 ]] isCleanClosure ] value. +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:06:28'! +testNextPutWhenConditionIsTruePutsObjectInStream - self deny: [ tempVar + 1 ] isCleanClosure. - self deny: [ tempVar _ 1 ] isCleanClosure. - self deny: [ ivar + 1 ] isCleanClosure. - self deny: [ ivar _ 1 ] isCleanClosure. - self deny: [ ^ true ] isCleanClosure. - self deny: [ self printString ] isCleanClosure. - self deny: [ ^ self ] isCleanClosure. - self deny: [ ClassVar + 1 ] isCleanClosure. - self deny: [ ClassVar _ 1 ] isCleanClosure! ! + | stream | + + stream := WriteStream on: ''. + stream nextPut: $t when: true. + + self assert: 't' equals: stream contents + + ! ! -!ClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:36'! -testMethodArgument - | temp block | - temp := 0. - block := [ [ temp ] ]. - temp := 1. - block := block value. - temp := 2. - self assert: block value = 2! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:13:06'! +testPrintWhenConditionIsFalseDoesNotPrintObjectInStream -!ClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:36'! -testMethodTemp - | block1 block2 | - block1 := self methodArgument: 1. - block2 := self methodArgument: 2. - self assert: block1 value = 1. - self assert: block2 value = 2! ! + | stream | + + stream := WriteStream on: ''. + stream print: Object when: false. + + self assert: stream contents isEmpty + + ! ! -!ClosureTests methodsFor: 'running' stamp: 'lr 3/9/2009 16:48'! -setUp - super setUp. - collection := OrderedCollection new! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:06:44'! +testPrintWhenConditionIsTruePrintsObjectInStream -!ClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'! -testToDoArgument - 1 to: 5 do: [ :index | - collection add: [ index ] ]. - self assertValues: #(1 2 3 4 5)! ! + | stream | + + stream := WriteStream on: ''. + stream print: Object when: true. + + self assert: Object printString equals: stream contents! ! -!ClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'! -testToDoArgumentNotInlined - | block | - block := [ :index | - collection add: [ index ] ]. - 1 to: 5 do: block. - self assertValues: #(1 2 3 4 5)! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:42:20'! +testSpaceManyTimesWhenConditionIsFalseDoesNotPutASpaceInStream -!ClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'! -testToDoInsideTemp - 1 to: 5 do: [ :index | - | temp | - temp := index. - collection add: [ temp ] ]. - self assertValues: #(1 2 3 4 5)! ! + | stream | -!ClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'! -testToDoInsideTempNotInlined - | block | - block := [ :index | - | temp | - temp := index. - collection add: [ temp ] ]. - 1 to: 5 do: block. - self assertValues: #(1 2 3 4 5)! ! + stream := WriteStream on: ''. + stream space: 2 when: false. + + self assert: stream contents isEmpty + ! ! -!ClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'! -testToDoOutsideTemp - | temp | - 1 to: 5 do: [ :index | - temp := index. - collection add: [ temp ] ]. - self assertValues: #(5 5 5 5 5)! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:43:01'! +testSpaceManyTimesWhenConditionIsTruePutSpacesInStream -!ClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'! -testToDoOutsideTempNotInlined - | block temp | - block := [ :index | - temp := index. - collection add: [ temp ] ]. - 1 to: 5 do: block. - self assertValues: #(5 5 5 5 5)! ! + | stream | -!ClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:29'! -testWhileModificationAfter - | index | - index := 0. - [ index < 5 ] whileTrue: [ - collection add: [ index ]. - index := index + 1 ]. - self assertValues: #(5 5 5 5 5)! ! + stream := WriteStream on: ''. + stream space: 2 when: true. + + self assert: ' ' equals: stream contents + ! ! -!ClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:29'! -testWhileModificationAfterNotInlined - | index block | - index := 0. - block := [ - collection add: [ index ]. - index := index + 1 ]. - [ index < 5 ] whileTrue: block. - self assertValues: #(5 5 5 5 5)! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:19:06'! +testSpaceWhenConditionIsFalseDoesNotPutASpaceInStream -!ClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:29'! -testWhileModificationBefore - | index | - index := 0. - [ index < 5 ] whileTrue: [ - index := index + 1. - collection add: [ index ] ]. - self assertValues: #(5 5 5 5 5)! ! + | stream | -!ClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:29'! -testWhileModificationBeforeNotInlined - | index block | - index := 0. - block := [ - index := index + 1. - collection add: [ index ] ]. - [ index < 5 ] whileTrue: block. - self assertValues: #(5 5 5 5 5)! ! + stream := WriteStream on: ''. + stream spaceWhen: false. + + self assert: stream contents isEmpty + ! ! -!ClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:52'! -testWhileWithTemp - | index | - index := 0. - [ index < 5 ] whileTrue: [ - | temp | - temp := index := index + 1. - collection add: [ temp ] ]. - self assertValues: #(1 2 3 4 5)! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:19:50'! +testSpaceWhenConditionIsTruePutsASpaceInStream -!ClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:53'! -testWhileWithTempNotInlined - | index block | - index := 0. - block := [ - | temp | - temp := index := index + 1. - collection add: [ temp ] ]. - [ index < 5 ] whileTrue: block. - self assertValues: #(1 2 3 4 5)! ! + | stream | -!ContextCompilationTest methodsFor: 'tests' stamp: 'eem 6/19/2008 10:11'! -testVariablesAndOffsetsDo + stream := WriteStream on: ''. + stream spaceWhen: true. + + self assert: ' ' equals: stream contents + ! ! - "ContextCompilationTest new testVariablesAndOffsetsDo" - | contextClasses | - contextClasses := ContextPart withAllSuperclasses, ContextPart allSubclasses asArray. - contextClasses do: - [:class| - class variablesAndOffsetsDo: - [:var :offset| - self assert: offset < 0. - self assert: (class instVarNameForIndex: offset negated) == var]]. +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:24:34'! +testTabManyTimesWhenConditionIsFalseDoesNotPutATabInStream - InstructionStream withAllSuperclasses, InstructionStream allSubclasses asArray do: - [:class| - (contextClasses includes: class) ifFalse: - [class variablesAndOffsetsDo: - [:var :offset| - (InstructionStream instVarNames includes: var) ifFalse: - [self assert: offset > 0. - self assert: (class instVarNameForIndex: offset) == var]]]]! ! + | stream | -!DecompilerTests methodsFor: 'utilities' stamp: 'sd 9/25/2004 15:30'! -blockingClasses + stream := WriteStream on: ''. + stream tab: 2 when: false. + + self assert: stream contents isEmpty + ! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:25:46'! +testTabManyTimesWhenConditionIsTruePutsTabsInStream - ^ #(CompiledMethod)! ! + | stream | -!DecompilerTests methodsFor: 'utilities' stamp: 'jmv 9/24/2020 16:56:42'! -checkDecompileMethod: oldMethod + stream := WriteStream on: ''. + stream tab: 2 when: true. - | cls selector oldMethodNode methodNode newMethod oldCodeString newCodeString | - cls _ oldMethod methodClass. - selector := oldMethod selector. - oldMethodNode _ Decompiler new - decompile: selector - in: cls - method: oldMethod. - [oldMethodNode properties includesKey: #warning] - whileTrue: [oldMethodNode properties removeKey: #warning]. - oldCodeString _ oldMethodNode decompileString. - methodNode _ [ Compiler new - compile: oldCodeString - in: cls - notifying: nil - ifFail: nil] - on: SyntaxErrorNotification - do: [ :ex | - ex errorMessage = 'Cannot store into' - ifTrue: [ex return: #badStore]. - ex pass ]. - "Ignore cannot store into block arg errors; they're not our issue." - methodNode ~~ #badStore ifTrue: [ - newMethod _ methodNode generate: #(0 0 0 0). - newCodeString := (Decompiler new - decompile: selector - in: cls - method: newMethod) decompileString. - "Decompiler might move temp declarations (keeping valid, equivalent code) and therefore affect the temp numbering. - Make temp numbering cannonical in decompiler code, to avoid bogus failures" - oldCodeString _ self withFixedTempNumbering: oldCodeString. - newCodeString _ self withFixedTempNumbering: newCodeString. - "(DifferenceFinder displayPatchFrom: oldCodeString to: newCodeString tryWords: true) - editLabel: 'Decompilation Differences for ', cls name,'>>',selector." - "(DifferenceFinder displayPatchFrom: oldMethod abstractSymbolic to: newMethod abstractSymbolic tryWords: true) - editLabel: 'Bytecode Differences for ', cls name,'>>',selector." - self assert: oldCodeString = newCodeString - description: cls name asString, ' ', selector asString - resumable: true ]! ! + self assert: (String streamContents: [ :s | s tab: 2 ]) equals: stream contents + ! ! -!DecompilerTests methodsFor: 'utilities' stamp: 'jmv 5/27/2015 13:58'! -decompileClassesSelect: aBlock - | cls | - (Smalltalk classNames select: aBlock) do: [ :cn | - cls _ Smalltalk at: cn. - cls selectorsAndMethodsDo: [ :selector :meth | - self checkDecompileMethod: meth ]]! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:22:50'! +testTabWhenConditionIsFalseDoesNotPutATabInStream -!DecompilerTests methodsFor: 'utilities' stamp: 'jmv 6/1/2021 14:00:00'! -withFixedTempNumbering: aString - | k code newCode tempStart startAt | - code _ aString. - `{'argm'. 'temp'}` with: `{'arg'. 'tmp'}` do: [ :a :b | - k _ 1. - startAt _ 1. - [tempStart _ code findString: a startingAt: startAt. tempStart > 0] whileTrue: [ | end | - end _ tempStart. [end <= code size and: [(code at: end) tokenish]] whileTrue: [end _ end + 1]. end _ end-1. - newCode _ code copyReplaceTokens: (code copyFrom: tempStart to: end) with: b, k printString. - code = newCode ifTrue: [startAt _ tempStart + 1]. - code _ newCode. - k _ k + 1 ]]. - ^code! ! + | stream | -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesAAtoAM - self decompileClassesSelect: [:cn| cn first = $A and: [cn second asUppercase <= $M]]! ! + stream := WriteStream on: ''. + stream tabWhen: false. + + self assert: stream contents isEmpty + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesANtoAZ - self decompileClassesSelect: [:cn| cn first = $A and: [cn second asUppercase > $M]]! ! +!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:23:28'! +testTabWhenConditionIsTruePutsATabInStream -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:57:20'! -testDecompilerInClassesBAtoBM + | stream | - self decompileClassesSelect: [:cn| cn first = $B and: [cn second asUppercase <= $M]]! ! + stream := WriteStream on: ''. + stream tabWhen: true. + + self assert: Character tab asString equals: stream contents + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:57:44'! -testDecompilerInClassesBNtoBZ +!ExceptionHandlingConditionTest methodsFor: 'exception handling tests' stamp: 'HAW 3/29/2017 13:50:30'! +testBlockClosuresCanBeUsedAsHandlingCondition - self decompileClassesSelect: [:cn| cn first = $B and: [cn second asUppercase > $M]]! ! + self + shouldnt: [ [ Error signal ] on: [:anException | true ] do: [ :anError | ] ] + raise: Error. + + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:57:51'! -testDecompilerInClassesCAtoCM +!ExceptionHandlingConditionTest methodsFor: 'exception handling tests' stamp: 'HAW 3/29/2017 13:48:37'! +testFilterConditionWorksAsExcpetedWhenHandlingException - self decompileClassesSelect: [:cn| cn first = $C and: [cn second asUppercase <= $M]]! ! + self + shouldnt: [ [ Error signal ] on: Error - ZeroDivide do: [ :anError | ] ] + raise: Error. + + self + should: [ [ ZeroDivide signal ] on: Error - ZeroDivide do: [ :anError | self fail ]] + raise: Error. -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:57:58'! -testDecompilerInClassesCNtoCZ +! ! - self decompileClassesSelect: [:cn| cn first = $C and: [cn second asUppercase > $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'exception handling tests' stamp: 'HAW 3/29/2017 13:49:45'! +testOrConditionWorksAsExcpetedWhenHandlingException -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:06'! -testDecompilerInClassesDAtoDM + self + shouldnt: [ [ Error signal ] on: Error, Notification do: [ :anError | ] ] + raise: Error. + + self + shouldnt: [ [ Notification signal ] on: Error, Notification do: [ :anError | ] ] + raise: Notification - self decompileClassesSelect: [:cn| cn first = $D and: [cn second asUppercase <= $M]]! ! + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:13'! -testDecompilerInClassesDNtoDZ +!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:06'! +testCanCreateFilterConditionWithExceptionTypeAndExceptionType - self decompileClassesSelect: [:cn| cn first = $D and: [cn second asUppercase > $M]]! ! + | condition | + + condition := Error - ZeroDivide . + + self assert: (condition handles: Error new). + self deny: (condition handles: ZeroDivide new). + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesEAtoEM - self decompileClassesSelect: [:cn| cn first = $E and: [cn second asUppercase <= $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:15'! +testCanCreateFilterConditionWithExceptionTypeAndFilterCondition -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesENtoEZ - self decompileClassesSelect: [:cn| cn first = $E and: [cn second asUppercase > $M]]! ! + | condition | + + condition := Error - (ZeroDivide - Halt). + + self assert: (condition handles: Error new). + self deny: (condition handles: ZeroDivide new). + self assert: (condition handles: Halt new). + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:22'! -testDecompilerInClassesFAtoFM +!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:10'! +testCanCreateFilterConditionWithExceptionTypeAndOrCondition - self decompileClassesSelect: [:cn| cn first = $F and: [cn second asUppercase <= $M]]! ! + | condition | + + condition := Error - (ZeroDivide, Halt). + + self assert: (condition handles: Error new). + self deny: (condition handles: ZeroDivide new). + self deny: (condition handles: Halt new). + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesFNtoFZ - self decompileClassesSelect: [:cn| cn first = $F and: [cn second asUppercase > $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:35'! +testCanCreateFilterConditionWithFilterConditionAndExceptionType -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesGAtoGM - self decompileClassesSelect: [:cn| cn first = $G and: [cn second asUppercase <= $M]]! ! + | condition | + + condition := (Error - Halt) - ZeroDivide. + + self assert: (condition handles: Error new). + self deny: (condition handles: Halt new). + self deny: (condition handles: ZeroDivide new). +! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesGNtoGZ - self decompileClassesSelect: [:cn| cn first = $G and: [cn second asUppercase > $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:43'! +testCanCreateFilterConditionWithFilterConditionAndFilterCondition -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesHAtoHM - self decompileClassesSelect: [:cn| cn first = $H and: [cn second asUppercase <= $M]]! ! + | condition | + + condition := (Error - Halt) - (ZeroDivide - Notification). + + self assert: (condition handles: Error new). + self deny: (condition handles: Halt new). + self deny: (condition handles: ZeroDivide new). + self assert: (condition handles: Notification new). +! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesHNtoHZ - self decompileClassesSelect: [:cn| cn first = $H and: [cn second asUppercase > $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:39'! +testCanCreateFilterConditionWithFilterConditionAndOrCondition -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesIAtoIM - self decompileClassesSelect: [:cn| cn first = $I and: [cn second asUppercase <= $M]]! ! + | condition | + + condition := (Error - Halt) - (Notification, ZeroDivide). + + self assert: (condition handles: Error new). + self deny: (condition handles: Halt new). + self deny: (condition handles: Notification new). + self deny: (condition handles: ZeroDivide new). +! ! -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:28'! -testDecompilerInClassesINtoIZ +!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:20'! +testCanCreateFilterConditionWithOrConditionAndExceptionType - self decompileClassesSelect: [:cn| cn first = $I and: [cn second asUppercase > $M]]! ! + | condition | + + condition := (Error, Halt) - ZeroDivide. + + self assert: (condition handles: Error new). + self assert: (condition handles: Halt new). + self deny: (condition handles: ZeroDivide new). + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesJAtoJM - self decompileClassesSelect: [:cn| cn first = $J and: [cn second asUppercase <= $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:29'! +testCanCreateFilterConditionWithOrConditionAndFilterCondition -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesJNtoJZ - self decompileClassesSelect: [:cn| cn first = $J and: [cn second asUppercase > $M]]! ! + | condition | + + condition := (Error, Halt) - (ZeroDivide - ArithmeticError). + + self assert: (condition handles: Error new). + self assert: (condition handles: Halt new). + self deny: (condition handles: ZeroDivide new). + self assert: (condition handles: ArithmeticError new). + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesKAtoKM - self decompileClassesSelect: [:cn| cn first = $K and: [cn second asUppercase <= $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'filter condition tests' stamp: 'HAW 3/29/2017 15:24:25'! +testCanCreateFilterConditionWithOrConditionAndOrCondition -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesKNtoKZ - self decompileClassesSelect: [:cn| cn first = $K and: [cn second asUppercase > $M]]! ! + | condition | + + condition := (Error, Halt) - (ArithmeticError, ZeroDivide). + + self assert: (condition handles: Error new). + self assert: (condition handles: Halt new). + self deny: (condition handles: ArithmeticError new). + self deny: (condition handles: ZeroDivide new). + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:37'! -testDecompilerInClassesLAtoLM +!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 15:21:29'! +testCanCreateOrConditionWithExceptionTypeAndExceptionType - self decompileClassesSelect: [:cn| cn first = $L and: [cn second asUppercase <= $M]]! ! + | handlingCondition | + + handlingCondition := Error, Notification. + + self assert: (handlingCondition handles: Error new). + self assert: (handlingCondition handles: Notification new). + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesLNtoLZ - self decompileClassesSelect: [:cn| cn first = $L and: [cn second asUppercase > $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 17:59:39'! +testCanCreateOrConditionWithExceptionTypeAndFilterCondition + + | handlingCondition | + + handlingCondition := Error, (ArithmeticError - ZeroDivide). + + self assert: (handlingCondition handles: Error new). + self assert: (handlingCondition handles: ArithmeticError new). + self deny: (handlingCondition handles: ZeroDivide new). + + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:51'! -testDecompilerInClassesMAtoMM +!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 15:21:37'! +testCanCreateOrConditionWithExceptionTypeAndOrCondition - self decompileClassesSelect: [:cn| cn first = $M and: [cn second asUppercase <= $M]]! ! + | handlingCondition | + + handlingCondition := Error, (Notification, UnhandledError). + + self assert: (handlingCondition handles: Error new). + self assert: (handlingCondition handles: Notification new). + self assert: (handlingCondition handles: UnhandledError new). + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesMNtoMZ - self decompileClassesSelect: [:cn| cn first = $M and: [cn second asUppercase > $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 17:56:49'! +testCanCreateOrConditionWithFilterConditionAndExceptionType -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesNAtoNM - self decompileClassesSelect: [:cn| cn first = $N and: [cn second asUppercase <= $M]]! ! + | condition | + + condition := (Error - ZeroDivide), ArithmeticError . + + self assert: (condition handles: Error new). + self deny: (condition handles: ZeroDivide new). + self assert: (condition handles: ArithmeticError new). + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesNNtoNZ - self decompileClassesSelect: [:cn| cn first = $N and: [cn second asUppercase > $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 17:56:57'! +testCanCreateOrConditionWithFilterConditionAndFilterCondition -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:57'! -testDecompilerInClassesOAtoOM + | condition | + + condition := (Error - ZeroDivide), (ArithmeticError - DomainError). + + self assert: (condition handles: Error new). + self deny: (condition handles: ZeroDivide new). + self assert: (condition handles: ArithmeticError new). + self deny: (condition handles: DomainError new). - self decompileClassesSelect: [:cn| cn first = $O and: [cn second asUppercase <= $M]]! ! + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesONtoOZ - self decompileClassesSelect: [:cn| cn first = $O and: [cn second asUppercase > $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 17:57:02'! +testCanCreateOrConditionWithFilterConditionAndOrCondition -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesPAtoPM - self decompileClassesSelect: [:cn| cn first = $P and: [cn second asUppercase <= $M]]! ! + | condition | + + condition := (ArithmeticError - ZeroDivide), (Error, Halt). + + self assert: (condition handles: ArithmeticError new). + self deny: (condition handles: ZeroDivide new). + self assert: (condition handles: Error new). + self assert: (condition handles: Halt new). -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesPNtoPZ - self decompileClassesSelect: [:cn| cn first = $P and: [cn second asUppercase > $M]]! ! + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesQAtoQM - self decompileClassesSelect: [:cn| cn first = $Q and: [cn second asUppercase <= $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 15:22:01'! +testCanCreateOrConditionWithOrConditionAndExceptionType + + | handlingCondition | + + handlingCondition := (Error, Halt), Notification. + + self assert: (handlingCondition handles: Error new). + self assert: (handlingCondition handles: Halt new). + self assert: (handlingCondition handles: Notification new). + + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesQNtoQZ - self decompileClassesSelect: [:cn| cn first = $Q and: [cn second asUppercase > $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 17:57:09'! +testCanCreateOrConditionWithOrConditionAndFilterCondition -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:59:04'! -testDecompilerInClassesRAtoRM + | exceptionSet | + + exceptionSet := (Error, Notification), (ArithmeticError - ZeroDivide). + + self assert: (exceptionSet handles: Error new). + self assert: (exceptionSet handles: Notification new). + self assert: (exceptionSet handles: ArithmeticError new). + self deny: (exceptionSet handles: ZeroDivide new). - self decompileClassesSelect: [:cn| cn first = $R and: [cn second asUppercase <= $M]]! ! + ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesRNtoRZ - self decompileClassesSelect: [:cn| cn first = $R and: [cn second asUppercase > $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'or condition tests' stamp: 'HAW 3/29/2017 15:22:06'! +testCanCreateOrConditionWithOrConditionAndOrCondition -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:59:11'! -testDecompilerInClassesSAtoSM + | handlingCondition | + + handlingCondition := (Error, Halt), (Notification, UnhandledError). + + self assert: (handlingCondition handles: Error new). + self assert: (handlingCondition handles: Halt new). + self assert: (handlingCondition handles: Notification new). + self assert: (handlingCondition handles: UnhandledError new). + ! ! - self decompileClassesSelect: [:cn| cn first = $S and: [cn second asUppercase <= $M]]! ! +!ExceptionHandlingConditionTest methodsFor: 'environment preconditions' stamp: 'sqr 6/26/2019 11:50:31'! +testExceptionsFollowTheExpectedHierarchy -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:59:18'! -testDecompilerInClassesSNtoSZ + "This test exits because all the others use existing exceptions and assume a subclass relationship + If the relationship is not the assumed one, false positives or negatives could happen" + + self assert: (Error inheritsFrom: Exception). + self assert: (Notification inheritsFrom: Exception). + self assert: (UnhandledError inheritsFrom: Exception). + self assert: (Halt inheritsFrom: Exception). + self assert: (ArithmeticError inheritsFrom: Error). + self assert: (DomainError inheritsFrom: ArithmeticError). + self assert: (ArithmeticMessageError inheritsFrom: Error). + self assert: (NegativePowerError inheritsFrom: ArithmeticMessageError). + self assert: (ZeroDivide inheritsFrom: ArithmeticMessageError)! ! - self decompileClassesSelect: [:cn| cn first = $S and: [cn second asUppercase > $M]]! ! +!ExceptionTests methodsFor: 'private' stamp: 'md 3/25/2003 23:40'! +assertSuccess: anExceptionTester + self should: [ ( anExceptionTester suiteLog first) endsWith: 'succeeded'].! ! -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:59:24'! -testDecompilerInClassesTAtoTM +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'dtl 6/1/2004 21:54'! +testDoubleOuterPass + self assertSuccess: (ExceptionTester new runTest: #doubleOuterPassTest ) ! ! - self decompileClassesSelect: [:cn| cn first = $T and: [cn second asUppercase <= $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'dtl 6/1/2004 21:54'! +testDoublePassOuter + self assertSuccess: (ExceptionTester new runTest: #doublePassOuterTest ) ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesTNtoTZ - self decompileClassesSelect: [:cn| cn first = $T and: [cn second asUppercase > $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:43'! +testDoubleResume + self assertSuccess: (ExceptionTester new runTest: #doubleResumeTest ) ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesUAtoUM - self decompileClassesSelect: [:cn| cn first = $U and: [cn second asUppercase <= $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:44'! +testNonResumableFallOffTheEndHandler + self assertSuccess: (ExceptionTester new runTest: #nonResumableFallOffTheEndHandler ) ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesUNtoUZ - self decompileClassesSelect: [:cn| cn first = $U and: [cn second asUppercase > $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'SqR 10/10/2015 16:22'! +testResignalAs -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:59:30'! -testDecompilerInClassesVAtoVM + | answer | + answer := [ + [3 zork] + on: ZeroDivide + do: [:ex | ex return: 5] + ] on: Error do: [:ex | ex resignalAs: ZeroDivide]. + self assert: answer == 5! ! - self decompileClassesSelect: [:cn| cn first = $V and: [cn second asUppercase <= $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'SqR 11/15/2015 11:42'! +testResignalAsUnwinds -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesVNtoVZ - self decompileClassesSelect: [:cn| cn first = $V and: [cn second asUppercase > $M]]! ! + | unwound answer | + unwound := false. + answer := [ + [3 zork] + on: ZeroDivide do: [:ex | self assert: unwound. ex return: 5] + ] on: Error do: [:ex | [ex resignalAs: ZeroDivide] ifCurtailed: [unwound := true]]. + self assert: answer == 5! ! -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:59:36'! -testDecompilerInClassesWAtoWM +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:44'! +testResumableFallOffTheEndHandler + self assertSuccess: (ExceptionTester new runTest: #resumableFallOffTheEndHandler ) ! ! - self decompileClassesSelect: [:cn| cn first = $W and: [cn second asUppercase <= $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:44'! +testSignalFromHandlerActionTest + self assertSuccess: (ExceptionTester new runTest: #signalFromHandlerActionTest ) ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesWNtoWZ - self decompileClassesSelect: [:cn| cn first = $W and: [cn second asUppercase > $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:48'! +testSimpleEnsure + self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTest ) ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesXAtoXM - self decompileClassesSelect: [:cn| cn first = $X and: [cn second asUppercase <= $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:45'! +testSimpleEnsureTestWithError + self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithError ) ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesXNtoXZ - self decompileClassesSelect: [:cn| cn first = $X and: [cn second asUppercase > $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:46'! +testSimpleEnsureTestWithNotification + self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithNotification ) ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesYAtoYM - self decompileClassesSelect: [:cn| cn first = $Y and: [cn second asUppercase <= $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:45'! +testSimpleEnsureTestWithUparrow + self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithUparrow ) ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesYNtoYZ - self decompileClassesSelect: [:cn| cn first = $Y and: [cn second asUppercase > $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:46'! +testSimpleIsNested + self assertSuccess: (ExceptionTester new runTest: #simpleIsNestedTest ) ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesZAtoZM - self decompileClassesSelect: [:cn| cn first = $Z and: [cn second asUppercase <= $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:41'! +testSimpleOuter + self assertSuccess: (ExceptionTester new runTest: #simpleOuterTest ) ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! -testDecompilerInClassesZNtoZZ - self decompileClassesSelect: [:cn| cn first = $Z and: [cn second asUppercase > $M]]! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:42'! +testSimplePass + self assertSuccess: (ExceptionTester new runTest: #simplePassTest ) ! ! -!DecompilerTests methodsFor: 'tests' stamp: 'jmv 12/28/2013 19:04'! -testRemoteTemp - | aBlock | - aBlock := Compiler evaluate: '| x y | [:a :b | x := a. y := b. x+y]'. - self shouldnt: [aBlock decompile] raise: Error - ! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:43'! +testSimpleResignalAs + self assertSuccess: (ExceptionTester new runTest: #simpleResignalAsTest ) ! ! -!DecompilerTestFailuresCollector methodsFor: 'accessing' stamp: 'HAW 3/17/2019 07:26:22'! -assert: aBoolean description: aString resumable: resumableBoolean - - aBoolean ifFalse: [ - failures ifNil: [ failures := OrderedCollection new]. - failures addLast: (thisContext sender tempAt: 1) methodReference]. - - ^super assert: aBoolean description: aString resumable: resumableBoolean -! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:48'! +testSimpleResume + self assertSuccess: (ExceptionTester new runTest: #simpleResumeTest ) ! ! -!DecompilerTestFailuresCollector methodsFor: 'accessing' stamp: 'eem 11/10/2008 15:47'! -failures - ^failures! ! +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:48'! +testSimpleRetry + self assertSuccess: (ExceptionTester new runTest: #simpleRetryTest ) ! ! -!MirrorPrimitiveTests methodsFor: 'tests' stamp: 'jmv 12/28/2013 19:06'! -testMirrorAt - | stackpBefore stackpAfter array byteArray | +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:47'! +testSimpleRetryUsing + self assertSuccess: (ExceptionTester new runTest: #simpleRetryUsingTest ) ! ! - Smalltalk isRunningCog ifFalse: [ - ^self assert: false description: 'Needs Cog' ]. +!ExceptionTests methodsFor: 'testing-ExceptionTester' stamp: 'md 3/25/2003 23:48'! +testSimpleReturn + self assertSuccess: (ExceptionTester new runTest: #simpleReturnTest ) ! ! - stackpBefore := thisContext stackPtr. - array := { 1. 2. 3 }. - byteArray := ByteArray with: 1 with: 2 with: 3. - self assert: (thisContext object: array basicAt: 1) = 1. - self assert: (thisContext object: byteArray basicAt: 2) = 2. - thisContext object: array basicAt: 2 put: #two. - self assert: array = #(1 #two 3). - thisContext object: byteArray basicAt: 2 put: 222. - self assert: byteArray asArray = #(1 222 3). - stackpAfter := thisContext stackPtr. - self assert: stackpBefore = stackpAfter. "Make sure primitives pop all their arguments" - self should: [thisContext object: array basicAt: 4] raise: Error. - self should: [thisContext object: byteArray basicAt: 0] raise: Error. - self should: [thisContext object: byteArray basicAt: 1 put: -1] raise: Error! ! +!ExceptionTests methodsFor: 'testing-outer' stamp: 'SqR 8/28/2014 22:45'! +testHandlerFromAction + "A test ensuring that nested exceptions work as expected." -!MirrorPrimitiveTests methodsFor: 'tests' stamp: 'eem 4/8/2009 19:44'! -testMirrorClass - | stackpBefore stackpAfter | - stackpBefore := thisContext stackPtr. - self assert: (thisContext objectClass: Array new) = Array. - self assert: (thisContext objectClass: 1) = 1 class. - self assert: (thisContext objectClass: ProtoObject new) = ProtoObject. - stackpAfter := thisContext stackPtr. - self assert: stackpBefore = stackpAfter "Make sure primitives pop all their arguments"! ! + | result | + result := [ + [ + [self error: 'trigger error'] on: ZeroDivide do: [ :ex | 'inner' ] + ] on: Error do: [ :ex | 3 / 0 ] + ] on: ZeroDivide do: [ :ex | 'outer' ]. + self assert: result = 'outer'! ! -!MirrorPrimitiveTests methodsFor: 'tests' stamp: 'jmv 12/28/2013 19:06'! -testMirrorEqEq - | stackpBefore stackpAfter | +!ExceptionTests methodsFor: 'testing-outer' stamp: 'dtl 6/1/2004 21:59'! +testNonResumableOuter - Smalltalk isRunningCog ifFalse: [ - ^self assert: false description: 'Needs Cog' ]. + self should: [ + [Error signal. 4] + on: Error + do: [:ex | ex outer. ex return: 5] + ] raise: Error +! ! - stackpBefore := thisContext stackPtr. - self assert: (thisContext object: Array new eqeq: Array new) == false. - self assert: (thisContext object: Array eqeq: Array) == true. - stackpAfter := thisContext stackPtr. - self assert: stackpBefore = stackpAfter "Make sure primitives pop all their arguments"! ! +!ExceptionTests methodsFor: 'testing-outer' stamp: 'dtl 6/1/2004 22:00'! +testNonResumablePass -!MirrorPrimitiveTests methodsFor: 'tests' stamp: 'jmv 12/28/2013 19:06'! -testMirrorInstVarAt - | stackpBefore stackpAfter array point | + self should: [ + [Error signal. 4] + on: Error + do: [:ex | ex pass. ex return: 5] + ] raise: Error +! ! - Smalltalk isRunningCog ifFalse: [ - ^self assert: false description: 'Needs Cog' ]. +!ExceptionTests methodsFor: 'testing-outer' stamp: 'ul 11/15/2010 11:39'! +testResumableOuter - stackpBefore := thisContext stackPtr. - array := { 1. 2. 3 }. - point := Point x: 1 y: 2. - self assert: (thisContext object: array instVarAt: 1) = 1. - self assert: (thisContext object: point instVarAt: 2) = 2. - thisContext object: array instVarAt: 2 put: #two. - self assert: array = #(1 #two 3). - thisContext object: point instVarAt: 1 put: 1/2. - self assert: point = (Point x: 1 / 2 y: 2). - stackpAfter := thisContext stackPtr. - self assert: stackpBefore = stackpAfter. "Make sure primitives pop all their arguments" - self should: [thisContext object: array instVarAt: 4] raise: Error. - self should: [thisContext object: point instVarAt: 3] raise: Error! ! + | result | + result := [Notification signal. 4] + on: Notification + do: [:ex | ex outer. ex return: 5]. + self assert: result = 5 +! ! -!MirrorPrimitiveTests methodsFor: 'tests' stamp: 'jmv 12/28/2013 19:06'! -testMirrorPerform - | stackpBefore stackpAfter anInterval | +!ExceptionTests methodsFor: 'testing-outer' stamp: 'ul 11/15/2010 11:39'! +testResumablePass - Smalltalk isRunningCog ifFalse: [ - ^self assert: false description: 'Needs Cog' ]. + | result | + result := [Notification signal. 4] + on: Notification + do: [:ex | ex pass. ex return: 5]. + self assert: result = 4 +! ! - stackpBefore := thisContext stackPtr. - anInterval := 1 to: 2. - self assert: (thisContext object: anInterval perform:# species withArguments: #() inClass: Interval) == Array. - self assert: (thisContext object: anInterval perform:# species withArguments: #() inClass: Interval superclass) == Interval. - self should: [thisContext object: anInterval perform:# species withArguments: #() inClass: Point] +!ExceptionTests methodsFor: 'testing' stamp: 'brp 10/21/2004 16:42'! +testNoTimeout + self assertSuccess: (ExceptionTester new runTest: #simpleNoTimeoutTest ) ! ! + +!ExceptionTests methodsFor: 'testing' stamp: 'brp 10/21/2004 16:41'! +testTimeoutWithZeroDuration + self assertSuccess: (ExceptionTester new runTest: #simpleTimeoutWithZeroDurationTest ) ! ! + +!ProgressInitiationExceptionTest methodsFor: 'testing' stamp: 'jmv 5/1/2021 20:11:23'! +test01 + | countStorage | + countStorage _ {0}. + self + should: [ self sampleProgress: countStorage ] + raise: ZeroDivide. + self assert: countStorage first = 5. + ! ! + +!ProgressInitiationExceptionTest methodsFor: 'testing' stamp: 'jmv 5/1/2021 20:11:36'! +test02 + | countStorage | + countStorage _ {0}. + self + shouldnt: [ + [self sampleProgress: countStorage] + on: ZeroDivide + do: [ :ex | ex resume] + ] raise: Error. - self should: [thisContext object: anInterval perform:# species withArguments: OrderedCollection new inClass: Interval] + self assert: countStorage first = 10. + ! ! + +!ProgressInitiationExceptionTest methodsFor: 'testing' stamp: 'jmv 5/1/2021 20:12:24'! +test03 + | countStorage | + countStorage _ {0}. + self + should: [ + [self sampleProgress: countStorage] + on: ProgressInitiationException + do: [ :ex | ex sendNotificationsTo: [ :min :max :curr | Transcript show: min printString, ' ', max printString, ' ', curr printString; newLine ]] + ] raise: Error. - stackpAfter := thisContext stackPtr. - self assert: stackpBefore = stackpAfter "Make sure primitives pop all their arguments"! ! + self assert: countStorage first = 5. + ! ! -!MirrorPrimitiveTests methodsFor: 'tests' stamp: 'jmv 12/28/2013 19:06'! -testMirrorSize - | stackpBefore stackpAfter | +!ProgressInitiationExceptionTest methodsFor: 'testing' stamp: 'jmv 5/1/2021 20:15:12'! +test04 + | countStorage | + countStorage _ {0}. + self + shouldnt: [ + [ + [self sampleProgress: countStorage] + on: ZeroDivide + do: [ :ex | ex resume] + ] + on: ProgressInitiationException + do: [ :ex | ex sendNotificationsTo: [ :min :max :curr | Transcript show: min printString, ' ', max printString, ' ', curr printString; newLine ]] + ] + raise: Error. + self assert: countStorage first = 10. + ! ! - Smalltalk isRunningCog ifFalse: [ - ^self assert: false description: 'Needs Cog' ]. +!ProgressInitiationExceptionTest methodsFor: 'testing' stamp: 'jmv 5/1/2021 20:15:48'! +test05 + | countStorage | + countStorage _ {0}. + self + shouldnt: [ + [ + [self sampleProgress: countStorage] + on: ProgressInitiationException + do: [ :ex | ex sendNotificationsTo: [ :min :max :curr | Transcript show: min printString, ' ', max printString, ' ', curr printString; newLine ]] + ] + on: ZeroDivide + do: [ :ex | ex resume] + ] + raise: Error. + self assert: countStorage first = 10. + ! ! - stackpBefore := thisContext stackPtr. - self assert: (thisContext objectSize: #(1 2 3)) = 3. - self assert: (thisContext objectSize: '123') = 3. - self assert: (thisContext objectSize: nil) = 0. - self assert: (thisContext objectSize: 1) = 0. - stackpAfter := thisContext stackPtr. - self assert: stackpBefore = stackpAfter. "Make sure primitives pop all their arguments"! ! +!ProgressInitiationExceptionTest methodsFor: 'aux' stamp: 'jmv 5/1/2021 20:09:48'! +sampleProgress: countStorage +" +self new sampleProgress: {0} +" + | d | + d _ Delay forMilliseconds: 10. + ^'Now here''s some Real Progress' + displayProgressAt: Sensor mousePoint + from: 0 + to: 10 + during: [ :barBlock | + 1 to: 10 do: [ :x | + countStorage at: 1 put: countStorage first + 1. + barBlock value: x. + d wait. + x = 5 ifTrue: [1/0]. "just to make life interesting" + ]. + 'done' + ]. -!ParseNodeEnumeratorTest methodsFor: 'tests about enumeration' stamp: 'RNG 9/27/2020 22:25:05'! -testItEnumeratesAllTheParseNodesPresentInAMethodNode +! ! - | blockNode enumeratedNodes methodNode enumerator tempVarsDeclarationNode tempVarDeclarationNode literalNode messageNode nodesToBeEnumerated returnNode variableNode | - methodNode := [ Parser parse: 'm1 | arg | ^ arg + 2' class: self class ] - on: SyntaxErrorNotification - do: [ :anError | self fail ]. +!ArrayLiteralTest methodsFor: 'tests' stamp: 'jpb 8/2/2019 23:05:08'! +testIsArray + self assert: ({1. 2. 'hello'. #Number} is: #Array).! ! - enumeratedNodes := Set new. - enumerator := ParseNodeEnumerator ofBlock: [ :parseNode | enumeratedNodes add: parseNode ]. - methodNode accept: enumerator. - blockNode := methodNode block. - tempVarsDeclarationNode := methodNode temporariesDeclaration. - tempVarDeclarationNode := tempVarsDeclarationNode temporaryDeclarationNodes first. - returnNode := blockNode statements first. - messageNode := returnNode expr. - variableNode := messageNode receiver. - literalNode := messageNode arguments first. - nodesToBeEnumerated := { - methodNode . blockNode . tempVarsDeclarationNode . tempVarDeclarationNode. - returnNode . messageNode . variableNode . literalNode. - }. +!ArrayLiteralTest methodsFor: 'tests' stamp: 'HAW 10/26/2019 18:24:11'! +testReservedIdentifiers + + self assert: #(nil true false) equals: {nil. true. false}.! ! - self assert: (enumeratedNodes includesAllOf: nodesToBeEnumerated)! ! +!ArrayLiteralTest methodsFor: 'tests' stamp: 'HAW 10/26/2019 18:24:52'! +testSymbols -!ParserTest methodsFor: 'test' stamp: 'HAW 2/29/2020 18:09:57'! -testRangesAreOkWhenReturningAVariableWithoutSpaceAfterThat + self assert: #(#nil #true #false #'nil' #'true' #'false') equals: {#nil. #true. #false. #nil. #true. #false}.! ! - | methodNode ranges | +!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:13'! +test01isAtSuperclassWhenIndexIsInSuperclass + + | classDefinitionNode analyzer | - "See Parser>>#variable" + classDefinitionNode := self thisClassDefinitionNode. - methodNode := self class methodNodeFor: 'm1 |v| ^v'. + analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. - ranges := methodNode rangeForNode: methodNode tempNodes first ifAbsent: [ self fail ]. - - self assert: 2 equals: ranges size. - self assert: ranges includes: (5 to: 5). - self assert: ranges includes: (9 to: 9). + self assert: (analyzer isAtSuperclass: 1). + self assert: (analyzer isAtSuperclass: self class superclass name size)! ! + +!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:19'! +test02isNotAtSuperclassWhenIndexIsOutsideSuperclass + + | classDefinitionNode analyzer | + classDefinitionNode := self thisClassDefinitionNode. + analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. + self deny: (analyzer isAtSuperclass: 0). + self deny: (analyzer isAtSuperclass: self class superclass name size + 1). ! ! -!ParserTest methodsFor: 'temporary variables tests' stamp: 'RNG 3/13/2020 00:39:16'! -testItGeneratesATempDeclarationNodeForEachTempInABlock +!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:25'! +test03isAtClassNameWhenIndexIsInClassName - | methodNode blockNode tempsDeclarationNode allTempDeclarationNodes | - methodNode := self class methodNodeFor: 'm1 [ | a b c | 42 ]'. - blockNode := methodNode block statements first. - tempsDeclarationNode := blockNode temporariesDeclaration. - allTempDeclarationNodes := tempsDeclarationNode temporaryDeclarationNodes. + | classDefinitionNode analyzer | - self - assert: allTempDeclarationNodes size equals: 3; - assert: allTempDeclarationNodes first variableName equals: 'a'; - assert: allTempDeclarationNodes second variableName equals: 'b'; - assert: allTempDeclarationNodes third variableName equals: 'c'.! ! - -!ParserTest methodsFor: 'temporary variables tests' stamp: 'RNG 3/13/2020 00:38:08'! -testItGeneratesATempDeclarationNodeForEachTempInAMethod - - | methodNode tempsDeclarationNode allTempDeclarationNodes | - methodNode := self class methodNodeFor: 'm1 | a b c | ^a + b + c'. - tempsDeclarationNode := methodNode temporariesDeclaration. - allTempDeclarationNodes := tempsDeclarationNode temporaryDeclarationNodes. + classDefinitionNode := self thisClassDefinitionNode. - self - assert: allTempDeclarationNodes size equals: 3; - assert: allTempDeclarationNodes first variableName equals: 'a'; - assert: allTempDeclarationNodes second variableName equals: 'b'; - assert: allTempDeclarationNodes third variableName equals: 'c'.! ! - -!ParserTest methodsFor: 'temporary variables tests' stamp: 'RNG 3/13/2020 00:34:19'! -testItGeneratesAnEmptyTempsDeclarationNodeForAMethodWithoutTemps - - | methodNode tempsDeclarationNode | - methodNode := self class methodNodeFor: 'm1 ^42'. - tempsDeclarationNode := methodNode temporariesDeclaration. + analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. - self assert: tempsDeclarationNode allDeclaredVariableNodes isEmpty.! ! - -!PrettyPrintingTest methodsFor: 'testing' stamp: 'jmv 4/19/2014 17:39'! -test1 - " - self new test1 - " - | prettyPrinted source | - - source _ -'sample1: x - x with: [ - self print. - self print ].'. - - prettyPrinted _ Compiler format: source in: PrettyPrintingTest notifying: nil. - - self assert: source equals: prettyPrinted! ! - -!PrettyPrintingTest methodsFor: 'testing' stamp: 'jmv 4/19/2014 17:39'! -test2 - " - self new test2 - " - | prettyPrinted source | - - source _ -'sample2: x - x - print; - with: [ :a :b :c | | d e f | - self print. - self print. - self do: [ :each | - self print. - self print. - x size + each size ]].'. - - prettyPrinted _ Compiler format: source in: PrettyPrintingTest notifying: nil. - - self assert: source equals: prettyPrinted! ! - -!PrettyPrintingTest methodsFor: 'testing' stamp: 'jmv 4/19/2014 17:40'! -test3 - " - self new test3 - " - | prettyPrinted source | - - source _ -'sample3: x - x - print; - with: [ :a :b :c | - self print. - self print. - self do: [ :each | - self print. - self print. - x size + each size ]].'. - - prettyPrinted _ Compiler format: source in: PrettyPrintingTest notifying: nil. - - self assert: source equals: prettyPrinted! ! - -!PrettyPrintingTest methodsFor: 'testing' stamp: 'jmv 4/19/2014 17:40'! -test4 - " - self new test4 - " - | prettyPrinted source | - - source _ -'sample4: x - x - print; - with: [ | d e f | - self print. - self print. - self do: [ :each | - self print. - self print. - x size + each size ]].'. - - prettyPrinted _ Compiler format: source in: PrettyPrintingTest notifying: nil. - - self assert: source equals: prettyPrinted! ! - -!PrettyPrintingTest methodsFor: 'testing' stamp: 'jmv 4/19/2014 17:41'! -test5 - " - self new test5 - " - | prettyPrinted source | - - source _ -'sample5: x - x - print; - print; - print; - - with: [ - self print. - self print ] - do: [ - self print. - self print ].'. - - prettyPrinted _ Compiler format: source in: PrettyPrintingTest notifying: nil. - - self assert: source equals: prettyPrinted! ! - -!PrettyPrintingTest methodsFor: 'testing' stamp: 'jmv 4/19/2014 17:40'! -test6 - " - self new test6 - " - | prettyPrinted source | - - source _ -'sample6: x - x - with: [ - self print. - self print ] - do: [ - self print. - self print ].'. + self assert: (analyzer isAtClassName: (self class definition findString: self class name) - 1). + self assert: (analyzer isAtClassName: (self class definition findString: self class name) + self class name size - 1). +! ! - prettyPrinted _ Compiler format: source in: PrettyPrintingTest notifying: nil. +!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:29'! +test04isNotAtClassNameWhenIndexIsOutsideClassName - self assert: source equals: prettyPrinted! ! + | classDefinitionNode analyzer | + + classDefinitionNode := self thisClassDefinitionNode. + + analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. + + self deny: (analyzer isAtClassName: (self class definition findString: self class name) - 2). + self deny: (analyzer isAtClassName: (self class definition findString: self class name) + self class name size). +! ! -!ReturnNodeTest methodsFor: 'tests' stamp: 'HAW 10/19/2020 16:07:48'! -test01isImplicitSelfReturnInReturnsTrueWithMethodWithOutAnySourceCode +!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:35'! +test05isAtInstanceVariablesWhenIndexIsInInstanceVariablesString - | methodNode returnNode | + | classDefinitionNode analyzer | - methodNode := (self class >> #methodWithImplicitReturn) methodNode. - returnNode := methodNode block statements first. + classDefinitionNode := self thisClassDefinitionNode. - self assert: (returnNode isImplicitSelfReturnIn: methodNode)! ! + analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. + + self assert: (analyzer isAtInstanceVariables: (self class definition findString: 'iv1')). + self assert: (analyzer isAtInstanceVariables: (self class definition findString: 'iv1') + 2). +! ! -!ReturnNodeTest methodsFor: 'tests' stamp: 'HAW 10/19/2020 16:08:15'! -test02isImplicitSelfReturnInReturnsTrueWithMethodReferencingSelf +!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:40'! +test06isNotAtInstanceVariablesWhenIndexIsOutsideInstanceVariablesString - | methodNode returnNode | + | classDefinitionNode analyzer | - methodNode := (self class >> #methodReferencingSelfWithImplicitReturn) methodNode. - returnNode := self returnNodeOf: methodNode. + classDefinitionNode := self thisClassDefinitionNode. - self assert: (returnNode isImplicitSelfReturnIn: methodNode)! ! + analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. + + self deny: (analyzer isAtInstanceVariables: (self class definition findString: '''iv1''')). + self deny: (analyzer isAtInstanceVariables: (self class definition findString: '''iv1''') + 4). + + ! ! -!ReturnNodeTest methodsFor: 'tests' stamp: 'HAW 10/19/2020 16:09:20'! -test03isImplicitSelfReturnInReturnsFalseWithMethodReturningSelf +!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:45'! +test07CanAccessSuperclass - | methodNode returnNode | + | classDefinitionNode analyzer | - methodNode := (self class >> #methodWithoutImplicitReturn) methodNode. - returnNode := self returnNodeOf: methodNode. + classDefinitionNode := self thisClassDefinitionNode. - self deny: (returnNode isImplicitSelfReturnIn: methodNode)! ! + analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. + + self assert: self class superclass equals: analyzer superclass! ! -!ReturnNodeTest methodsFor: 'test data' stamp: 'HAW 10/19/2020 16:06:04'! -methodReferencingSelfWithImplicitReturn +!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:50'! +test08isAtCategoryWhenIndexIsInCategoryString - self yourself + | classDefinitionNode analyzer | - ! ! - -!ReturnNodeTest methodsFor: 'test data' stamp: 'HAW 10/19/2020 16:00:38'! -methodWithImplicitReturn + classDefinitionNode := self thisClassDefinitionNode. + + analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. + + self assert: (analyzer isAtCategory: (self class definition findString: self class category asString)). + self assert: (analyzer isAtCategory: (self class definition findString: self class category asString) + self class category size - 1). ! ! -!ReturnNodeTest methodsFor: 'test data' stamp: 'HAW 10/19/2020 16:08:38'! -methodWithoutImplicitReturn - - ^self! ! +!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:07:55'! +test09isNotAtCategoryWhenIndexIsOutsideCategoryString -!ReturnNodeTest methodsFor: 'test support' stamp: 'HAW 10/19/2020 16:03:45'! -returnNodeOf: methodNode + | classDefinitionNode analyzer | - methodNode nodesDo: [:node | node isReturn ifTrue: [^node]]. + classDefinitionNode := self thisClassDefinitionNode. - self error: 'No return node found'! ! - -!ScannerTest methodsFor: 'testing' stamp: 'jmv 9/5/2016 20:48:53'! -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: 94), (96 to: 126) collect: [:ascii | Character numericValue: ascii]) , - #(':x:yourself' '::' 'x:yourself' '123' 'x0:x1:x2:' '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']! ! - -!SourceCodeIntervalTest methodsFor: 'tests - trimming' stamp: 'RNG 5/8/2020 21:02:35'! -test01TryingToTrimAnAlreadyTrimmedIntervalThatRepresentsASmalltalkExpressionDoesNotChangeTheOriginalInterval + analyzer := ClassDefinitionNodeAnalyzer for: classDefinitionNode. - | originalInterval trimmedInterval sourceCode | - sourceCode := '3+4'. - originalInterval := (1 to: sourceCode size) asSourceCodeInterval. - trimmedInterval := originalInterval trimToMatchExpressionOn: sourceCode. - - self assert: originalInterval equals: trimmedInterval! ! - -!SourceCodeIntervalTest methodsFor: 'tests - trimming' stamp: 'RNG 5/8/2020 21:02:27'! -test02StartingAndEndingSeparatorsAreTrimmed + self deny: (analyzer isAtCategory: (self class definition findString: self class category asString) - 1). + self deny: (analyzer isAtCategory: (self class definition findString: self class category asString) + self class category size). - | originalInterval trimmedInterval sourceCode | - sourceCode := ' 3+4 '. - originalInterval := (1 to: sourceCode size) asSourceCodeInterval. - trimmedInterval := originalInterval trimToMatchExpressionOn: sourceCode. + ! ! - self assert: (2 to: 4) asSourceCodeInterval equals: trimmedInterval! ! +!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 10/11/2019 16:51:32'! +test10InstanceVariablesIsTheSecondParameter -!SourceCodeIntervalTest methodsFor: 'tests - trimming' stamp: 'RNG 5/8/2020 21:02:09'! -test03StartingAndEndingDotsAreTrimmed + | subclassCreationSelectors | - | originalInterval trimmedInterval sourceCode | - sourceCode := '...3+4..'. - originalInterval := (1 to: sourceCode size) asSourceCodeInterval. - trimmedInterval := originalInterval trimToMatchExpressionOn: sourceCode. - - self assert: (4 to: 6) asSourceCodeInterval equals: trimmedInterval! ! - -!SourceCodeIntervalTest methodsFor: 'tests - trimming' stamp: 'RNG 5/8/2020 21:01:42'! -test04GroupsOfParenthesesAreTrimmed + subclassCreationSelectors := Class organization listAtCategoryNamed: 'subclass creation'. + self assert: subclassCreationSelectors notEmpty. - | originalInterval trimmedInterval sourceCode | - sourceCode := '((3+4))'. - originalInterval := (1 to: sourceCode size) asSourceCodeInterval. - trimmedInterval := originalInterval trimToMatchExpressionOn: sourceCode. + subclassCreationSelectors do: [ :aSubclassCreationSelector | + self + assert: (aSubclassCreationSelector keywords at: ClassDefinitionNodeAnalyzer instanceVariableNamesPositionForClassDefinition ) + equals: 'instanceVariableNames:' ]! ! - self assert: (3 to: 5) asSourceCodeInterval equals: trimmedInterval! ! +!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 21:06:49'! +test11CategoryIsTheFifthParameter -!SourceCodeIntervalTest methodsFor: 'tests - trimming' stamp: 'RNG 5/8/2020 21:01:13'! -test05GroupsOfParenthesesIncludingSeparatorsAreTrimmed + | subclassCreationSelectors | - | originalInterval trimmedInterval sourceCode | - sourceCode := ' ( (3+4) - )'. - originalInterval := (1 to: sourceCode size) asSourceCodeInterval. - trimmedInterval := originalInterval trimToMatchExpressionOn: sourceCode. - - self assert: (5 to: 7) asSourceCodeInterval equals: trimmedInterval! ! - -!SourceCodeIntervalTest methodsFor: 'tests - equality' stamp: 'RNG 5/27/2020 23:59:37'! -test11AsSourceCodeIntervalMessageDoesNotCreateANewSourceCodeIntervalInstance - - | interval | - interval := (1 to: 10) asSourceCodeInterval. + subclassCreationSelectors := Class organization listAtCategoryNamed: 'subclass creation'. + self assert: subclassCreationSelectors notEmpty. - self assert: interval == interval asSourceCodeInterval! ! + subclassCreationSelectors do: [ :aSubclassCreationSelector | + self + assert: (aSubclassCreationSelector keywords at: ClassDefinitionNodeAnalyzer categoryPosition) + equals: 'category:' ]! ! -!SourceCodeIntervalTest methodsFor: 'tests - expanding' stamp: 'RNG 5/9/2020 15:41:07'! -test06AnIntervalThatDoesNotHaveCharactersToExpandRemainsTheSame +!ClassDefinitionNodeAnalyzerTest methodsFor: 'testing' stamp: 'HAW 4/17/2019 18:16:08'! +thisClassDefinitionNode + + ^self class methodNodeFor: self class definition noPattern: true ! ! - | sourceCode expandedInterval originalInterval | - sourceCode := '3+4 factorial'. - originalInterval := (1 to: sourceCode size) asSourceCodeInterval. - expandedInterval := originalInterval expandToMatchExpressionOn: sourceCode. +!ClosureCompilerTest methodsFor: 'source' stamp: 'jmv 3/13/2012 11:29'! +closureCases + ^#( +'| n | +n := 1. +^n + n' - self assert: originalInterval equals: expandedInterval! ! +'| i | +i := 0. +[i := i + 1. + i <= 10] whileTrue. +^i' -!SourceCodeIntervalTest methodsFor: 'tests - expanding' stamp: 'RNG 5/9/2020 15:41:07'! -test07AnIntervalEnclosedByParenthesesCanBeExpanded +'[:c :s| | mn | +mn := Compiler new + compile: (c sourceCodeAt: s) + in: c + notifying: nil + ifFail: [self halt]. +mn generate: #(0 0 0 0). +{mn blockExtentsToTempsMap. + mn encoder schematicTempNames}] + value: ArrayLiteralTest + value: #testSymbols' - | sourceCode expandedInterval originalInterval | - sourceCode := '(3+4 factorial)'. - originalInterval := (2 to: sourceCode size - 1) asSourceCodeInterval. - expandedInterval := originalInterval expandToMatchExpressionOn: sourceCode. +'inject: thisValue into: binaryBlock + | nextValue | + nextValue := thisValue. + self do: [:each | nextValue := binaryBlock value: nextValue value: each]. + ^nextValue' - self assert: (1 to: sourceCode size) equals: expandedInterval! ! +'runBinaryConditionalJumps: assertPrintBar + "CogIA32CompilerTests new runBinaryConditionalJumps: false" + | mask reg1 reg2 reg3 | + mask := 1 << self processor bitsInWord - 1. + self concreteCompilerClass dataRegistersWithAccessorsDo: + [:n :get :set| + n = 0 ifTrue: [reg1 := get]. + n = 1 ifTrue: [reg2 := set]. + n = 2 ifTrue: [reg3 := set]]. + #( (JumpAbove > unsigned) (JumpBelowOrEqual <= unsigned) + (JumpBelow < unsigned) (JumpAboveOrEqual >= unsigned) + (JumpGreater > signed) (JumpLessOrEqual <= signed) + (JumpLess < signed) (JumpGreaterOrEqual >= signed) + (JumpZero = signed) (JumpNonZero ~= signed)) do: + [:triple| + [:opName :relation :signednessOrResult| | opcode jumpNotTaken jumpTaken nop memory bogus | + self resetGen. + opcode := CogRTLOpcodes classPool at: opName. + self gen: CmpRR operand: 2 operand: 1. + jumpTaken := self gen: opcode. + self gen: MoveCqR operand: 0 operand: 0. + jumpNotTaken := self gen: Jump. + jumpTaken jmpTarget: (self gen: MoveCqR operand: 1 operand: 0). + jumpNotTaken jmpTarget: (nop := self gen: Nop). + memory := self generateInstructions. + bogus := false. + self pairs: (-2 to: 2) do: + [:a :b| | taken | + self processor + reset; + perform: reg2 with: a signedIntToLong; + perform: reg3 with: b signedIntToLong. + [self processor singleStepIn: memory. + self processor pc ~= nop address] whileTrue. + taken := (self processor perform: reg1) = 1. + assertPrintBar + ifTrue: + [self assert: taken = (signednessOrResult == #unsigned + ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)] + ifFalse: [a perform: relation with: b])] + ifFalse: + [Transcript + nextPutAll: reg2; nextPut: $(; print: a; nextPutAll: '') ''; nextPutAll: relation; space; + nextPutAll: reg3; nextPut: $(; print: b; nextPutAll: '') = ''; + print: taken; cr; flush. + taken = (signednessOrResult == #unsigned + ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)] + ifFalse: [a perform: relation with: b]) ifFalse: + [bogus := true]]]. + bogus ifTrue: + [self processor printRegistersOn: Transcript. + Transcript show: (self processor disassembleInstructionAt: jumpTaken address In: memory); cr]] + valueWithArguments: triple]' -!SourceCodeIntervalTest methodsFor: 'tests - expanding' stamp: 'RNG 5/9/2020 15:41:07'! -test08AnIntervalWithParenthesesOnJustOneSideCannotBeExpanded +'mapFromBlockStartsIn: aMethod toTempVarsFrom: schematicTempNamesString constructor: aDecompilerConstructor + | map | + map := aMethod + mapFromBlockKeys: aMethod startpcsToBlockExtents keys asSortedCollection + toSchematicTemps: schematicTempNamesString. + map keysAndValuesDo: + [:startpc :tempNameTupleVector| | subMap tempVector numTemps | + subMap := Dictionary new. + "Find how many temp slots there are (direct & indirect temp vectors) + and for each indirect temp vector find how big it is." + tempNameTupleVector do: + [:tuple| + tuple last isArray + ifTrue: + [subMap at: tuple last first put: tuple last last. + numTemps := tuple last first] + ifFalse: + [numTemps := tuple last]]. + "create the temp vector for this scope level." + tempVector := Array new: numTemps. + "fill it in with any indirect temp vectors" + subMap keysAndValuesDo: + [:index :size| + tempVector at: index put: (Array new: size)]. + "fill it in with temp nodes." + tempNameTupleVector do: + [:tuple| | itv | + tuple last isArray + ifTrue: + [itv := tempVector at: tuple last first. + itv at: tuple last last + put: (aDecompilerConstructor + codeTemp: tuple last last - 1 + named: tuple first)] + ifFalse: + [tempVector + at: tuple last + put: (aDecompilerConstructor + codeTemp: tuple last - 1 + named: tuple first)]]. + "replace any indirect temp vectors with proper RemoteTempVectorNodes" + subMap keysAndValuesDo: + [:index :size| + tempVector + at: index + put: (aDecompilerConstructor + codeRemoteTemp: index + remoteTemps: (tempVector at: index))]. + "and update the entry in the map" + map at: startpc put: tempVector]. + ^map' - | sourceCode expandedInterval originalInterval | - sourceCode := '3 + 4 factorial)'. - originalInterval := (1 to: sourceCode size - 1) asSourceCodeInterval. - expandedInterval := originalInterval expandToMatchExpressionOn: sourceCode. + 'gnuifyFrom: inFileStream to: outFileStream - self assert: originalInterval equals: expandedInterval! ! +"convert interp.c to use GNU features" -!SourceCodeIntervalTest methodsFor: 'tests - expanding' stamp: 'RNG 5/9/2020 15:41:07'! -test09AnIntervalEnclosedByBackticksCanBeExpanded + | inData beforeInterpret inInterpret inInterpretVars beforePrimitiveResponse inPrimitiveResponse | - | sourceCode expandedInterval originalInterval | - sourceCode := '`3 + 4 factorial`'. - originalInterval := (2 to: sourceCode size - 1) asSourceCodeInterval. - expandedInterval := originalInterval expandToMatchExpressionOn: sourceCode. + inData := inFileStream upToEnd withSqueakLineEndings. + inFileStream close. - self assert: (1 to: sourceCode size) equals: expandedInterval! ! - -!SourceCodeIntervalTest methodsFor: 'tests - expanding' stamp: 'RNG 5/9/2020 15:41:07'! -test10AnIntervalEnclosedMultipleBackticksAndParenthesesCanBeExpanded - - | sourceCode expandedInterval originalInterval | - sourceCode := '`((3 + 4 factorial))`'. - originalInterval := (4 to: sourceCode size - 3) asSourceCodeInterval. - expandedInterval := originalInterval expandToMatchExpressionOn: sourceCode. - - self assert: (1 to: sourceCode size) equals: expandedInterval! ! + "print a header" + outFileStream + nextPutAll: ''/* This file has been post-processed for GNU C */''; + cr; cr; cr. -!FileIOAccessorTest methodsFor: 'private' stamp: 'jmv 5/31/2016 10:30'! -defaultDirectoryPath - ^DirectoryEntry currentDirectory pathName! ! + beforeInterpret := true. "whether we are before the beginning of interpret()" + inInterpret := false. "whether we are in the middle of interpret" + inInterpretVars := false. "whether we are in the variables of interpret" + beforePrimitiveResponse := true. "whether we are before the beginning of primitiveResponse()" + inPrimitiveResponse := false. "whether we are inside of primitiveResponse" + ''Gnuifying'' + displayProgressAt: Sensor mousePoint + from: 1 to: (inData occurrencesOf: Character crCharacter) + during: + [:bar | | lineNumber | + lineNumber := 0. + inData linesDo: + [ :inLine | | outLine extraOutLine caseLabel | + bar value: (lineNumber := lineNumber + 1). + outLine := inLine. "print out one line for each input line; by default, print out the line that was input, but some rules modify it" + extraOutLine := nil. "occasionally print a second output line..." + beforeInterpret ifTrue: [ + inLine = ''#include "sq.h"'' ifTrue: [ + outLine := ''#include "sqGnu.h"'' ]. + inLine = ''interpret(void) {'' ifTrue: [ + "reached the beginning of interpret" + beforeInterpret := false. + inInterpret := true. + inInterpretVars := true ] ] + ifFalse: [ + inInterpretVars ifTrue: [ + (inLine findString: ''register struct foo * foo = &fum;'') > 0 ifTrue: [ + outLine := ''register struct foo * foo FOO_REG = &fum;'' ]. + (inLine findString: '' localIP;'') > 0 ifTrue: [ + outLine := '' char* localIP IP_REG;'' ]. + (inLine findString: '' localFP;'') > 0 ifTrue: [ + outLine := '' char* localFP FP_REG;'' ]. + (inLine findString: '' localSP;'') > 0 ifTrue: [ + outLine := '' char* localSP SP_REG;'' ]. + (inLine findString: '' currentBytecode;'') > 0 ifTrue: [ + outLine := '' sqInt currentBytecode CB_REG;'' ]. + inLine isEmpty ifTrue: [ + "reached end of variables" + inInterpretVars := false. + outLine := '' JUMP_TABLE;''. + extraOutLine := inLine ] ] + ifFalse: [ + inInterpret ifTrue: [ + "working inside interpret(); translate the switch statement" + (inLine beginsWith: '' case '') ifTrue: [ + caseLabel := (inLine findTokens: '' :'') second. + outLine := '' CASE('', caseLabel, '')'' ]. + inLine = '' break;'' ifTrue: [ + outLine := '' BREAK;'' ]. + inLine = ''}'' ifTrue: [ + "all finished with interpret()" + inInterpret := false ] ] + ifFalse: [ + beforePrimitiveResponse ifTrue: [ + (inLine beginsWith: ''primitiveResponse('') ifTrue: [ + "into primitiveResponse we go" + beforePrimitiveResponse := false. + inPrimitiveResponse := true. + extraOutLine := '' PRIM_TABLE;'' ] ] + ifFalse: [ + inPrimitiveResponse ifTrue: [ + inLine = '' switch (primitiveIndex) {'' ifTrue: [ + extraOutLine := outLine. + outLine := '' PRIM_DISPATCH;'' ]. + inLine = '' switch (GIV(primitiveIndex)) {'' ifTrue: [ + extraOutLine := outLine. + outLine := '' PRIM_DISPATCH;'' ]. + (inLine beginsWith: '' case '') ifTrue: [ + caseLabel := (inLine findTokens: '' :'') second. + outLine := '' CASE('', caseLabel, '')'' ]. + inLine = ''}'' ifTrue: [ + inPrimitiveResponse := false ] ] + ] ] ] ]. -!FileIOAccessorTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:48'! -testDirectoryExists - "FileIOAccessorTest debug: #testDirectoryExists" - | subDirString dirString | - subDirString := 99999 atRandom asString. - dirString := self defaultDirectoryPath, FileIOAccessor default slash, subDirString. + outFileStream nextPutAll: outLine; cr. + extraOutLine ifNotNil: [ + outFileStream nextPutAll: extraOutLine; cr ]]]. - FileIOAccessor default createDirectory: dirString. + outFileStream close' )! ! - self should: [ dirString asDirectoryEntry exists ]. +!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 6/24/2008 12:28'! +doTestDebuggerTempAccessWith: one with: two + "Test debugger access for temps" + | outerContext local1 remote1 | + outerContext := thisContext. + local1 := 3. + remote1 := 1/2. + self assert: (Compiler new evaluate: 'one' in: thisContext to: self) == one. + self assert: (Compiler new evaluate: 'two' in: thisContext to: self) == two. + self assert: (Compiler new evaluate: 'local1' in: thisContext to: self) == local1. + self assert: (Compiler new evaluate: 'remote1' in: thisContext to: self) == remote1. + Compiler new evaluate: 'local1 := -3.0' in: thisContext to: self. + self assert: local1 = -3.0. + (1 to: 2) do: + [:i| | local2 r1 r2 r3 r4 | + local2 := i * 3. + remote1 := local2 / 7. + self assert: thisContext ~~ outerContext. + self assert: (r1 := Compiler new evaluate: 'one' in: thisContext to: self) == one. + self assert: (r2 := Compiler new evaluate: 'two' in: thisContext to: self) == two. + self assert: (r3 := Compiler new evaluate: 'i' in: thisContext to: self) == i. + self assert: (r4 := Compiler new evaluate: 'local2' in: thisContext to: self) == local2. + self assert: (r4 := Compiler new evaluate: 'remote1' in: thisContext to: self) == remote1. + self assert: (r4 := Compiler new evaluate: 'remote1' in: outerContext to: self) == remote1. + Compiler new evaluate: 'local2 := 15' in: thisContext to: self. + self assert: local2 = 15. + Compiler new evaluate: 'local1 := 25' in: thisContext to: self. + self assert: local1 = 25. + { r1. r2. r3. r4 } "placate the compiler"]. + self assert: local1 = 25. + self assert: remote1 = (6/7)! ! - FileIOAccessor default deleteDirectory: dirString. +!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 6/1/2021 14:22:49'! +supportTestSourceRangeAccessForDecompiledInjectInto: method source: source + "Test debugger source range selection for inject:into:" + ^self + supportTestSourceRangeAccessForInjectInto: method + source: source + selectionSequence: #( '_ arg1' + 'do: [:argm1_5 | temp3 _ arg2 value: temp3 value: argm1_5]' + 'value: temp3 value: argm1_5' + '_ arg2 value: temp3 value: argm1_5' + 'temp3 _ arg2 value: temp3 value: argm1_5' + 'value: temp3 value: argm1_5' + '_ arg2 value: temp3 value: argm1_5' + 'temp3 _ arg2 value: temp3 value: argm1_5' + '^temp3')! ! - self shouldnt: [ dirString asDirectoryEntry exists ].! ! +!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 6/4/2008 19:44'! +supportTestSourceRangeAccessForDecompiledNoBytecodeInjectInto: method source: source + "Test debugger source range selection for inject:into:" + ^self + supportTestSourceRangeAccessForInjectInto: method + source: source + selectionSequence: #( 'at: 1 put: t1' + 'do: [:t4 | t3 at: 1 put: (t2 value: (t3 at: 1) value: t4)]' + 'value: (t3 at: 1) value: t4' + 'at: 1 put: (t2 value: (t3 at: 1) value: t4)' + ']' + 'value: (t3 at: 1) value: t4' + 'at: 1 put: (t2 value: (t3 at: 1) value: t4)' + ']' + '^t3 at: 1')! ! -!FileManTest methodsFor: 'private' stamp: 'jmv 5/31/2016 10:28'! -directoryEntryForTest - ^'./fmTestDir' asDirectoryEntry! ! +!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 12/30/2009 14:17'! +supportTestSourceRangeAccessForInjectInto: method source: source + "Test debugger source range selection for inject:into:" + ^self + supportTestSourceRangeAccessForInjectInto: method + source: source + selectionSequence: #( '_ thisValue' + 'do: [:each | nextValue _ binaryBlock value: nextValue value: each]' + 'value: nextValue value: each' + '_ binaryBlock value: nextValue value: each' + 'nextValue _ binaryBlock value: nextValue value: each' + 'value: nextValue value: each' + '_ binaryBlock value: nextValue value: each' + 'nextValue _ binaryBlock value: nextValue value: each' + '^nextValue')! ! -!FileManTest methodsFor: 'private' stamp: 'jmv 5/31/2016 10:28'! -randomFileName - ^100000 atRandom asString, '.fmtst'! ! +!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 7/29/2008 17:16'! +supportTestSourceRangeAccessForInjectInto: method source: source selectionSequence: selections + "Test debugger source range selection for inject:into:" + | evaluationCount sourceMap debugTokenSequence debugCount | + DebuggerMethodMap voidMapCache. + evaluationCount := 0. + sourceMap := method debuggerMap abstractSourceMap. + debugTokenSequence := selections collect: [:string| Scanner new scanTokens: string]. + debugCount := 0. + thisContext + runSimulated: [(1 to: 2) + withArgs: + { 0. + [:sum :each| + evaluationCount := evaluationCount + 1. + sum + each]} + executeMethod: method] + contextAtEachStep: + [:ctxt| | range debugTokens | + (ctxt method == method + and: ["Exclude the send of #blockCopy: or #closureCopy:copiedValues: and braceWith:with: + to create the block, and the #new: and #at:'s for the indirect temp vector. + This for compilation without closure bytecodes. (Note that at:put:'s correspond to stores)" + (ctxt willSend + and: [(#(closureCopy:copiedValues: blockCopy: new: at: braceWith:with:) includes: ctxt selectorToSendOrSelf) not]) + "Exclude the store of the argument into the home context (for BlueBook blocks) + and the store of an indirection vector into an initial temp" + or: [(ctxt willStore + and: [(ctxt isBlock and: [ctxt pc = ctxt startpc]) not + and: [(ctxt isBlock not + and: [(method usesClosureBytecodes and: [ctxt abstractPC = 2])]) not]]) + or: [ctxt willReturn]]]) ifTrue: + [debugTokens := debugTokenSequence at: (debugCount := debugCount + 1) ifAbsent: [#(bogusToken)]. + self assert: (sourceMap includesKey: ctxt abstractPC). + range := sourceMap at: ctxt abstractPC ifAbsent: [(1 to: 0)]. + self assert: (Scanner new scanTokens: (source copyFrom: range first to: range last)) = debugTokens]]. + self assert: evaluationCount = 2! ! -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:49'! -testAbsolutePath - "FileManTest debug: #testAbsolutePath" - | dirEntry dirEntry1 dirEntry2 dirEntry3 dirEntry4 | - dirEntry := '/' asDirectoryEntry. - self should: [dirEntry = ':' asDirectoryEntry]. - self should: [dirEntry = '\' asDirectoryEntry]. +!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 6/1/2021 14:17:23'! +testBlockDoitDecompilation + "Tests that decompile of a doit block with remote vars executes correcly" + "Tests that decompilation of a Block, when 'method' of block is equivalent to that compiled by a DoIt, preserves the temp names " - dirEntry1 := '/temp/' asDirectoryEntry. - self should: [dirEntry1 = ':temp' asDirectoryEntry]. - self should: [dirEntry1 = '\temp' asDirectoryEntry]. - - dirEntry2 := '/temp/a' asDirectoryEntry. - self should: [dirEntry2 = ':temp:a' asDirectoryEntry]. - self should: [dirEntry2 = '\temp\a' asDirectoryEntry]. + | blockSourceStream methodNode block decompiledBlock method | + blockSourceStream := '|x y| [:a :b | x _ a. y _ b. x + y]' readStream. + methodNode := Compiler new + from: blockSourceStream class: nil class context: nil notifying: nil; + translate: blockSourceStream noPattern: true ifFail: [nil]. + method _ methodNode generate. + block := nil withArgs: #() executeMethod: method. + + self shouldnt: [decompiledBlock := block decompile] raise: Error. + self assert: + '{[ :argm0_4 :argm0_5 | + temp1 _ argm0_4. + temp3 _ argm0_5. + temp1 + temp3. ]}' equals: decompiledBlock printString +! ! - dirEntry3 := 'C:/temp/b' asDirectoryEntry. - self should: [dirEntry3 = 'C:\temp\b' asDirectoryEntry]. - self should: [dirEntry3 = 'C::temp:b' asDirectoryEntry]. - - "Platform specific path tests" - FileIOAccessor default onMacClassic ifTrue: [ - dirEntry4 := 'Macintosh HD:tmp' asDirectoryEntry. - self should: [dirEntry4 = 'Macintosh HD/tmp' asDirectoryEntry]. - self should: [dirEntry4 = 'Macintosh HD\tmp' asDirectoryEntry]. - ]. - - - - ! ! - -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:49'! -testAtPut - "FileManTest debug: #testAtPut" - | dir bytes | - dir := self directoryEntryForTest. - dir at: 'test1' put: 'Hello'. - self should: [(dir at: 'test1') = 'Hello']. - self should: [dir includesKey: 'test1']. - - bytes := #(1 2 3 4 5 6) asByteArray. - dir binaryAt: 'test2' put: bytes. - self should: [(dir binaryAt: 'test2') = bytes]. - self should: [dir includesKey: 'test2']. - - dir removeKey: 'test1'. +!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 1/17/2011 00:13'! +testBlockNumbering + "Test that the compiler and CompiledMethod agree on the block numbering of a substantial doit." + "self new testBlockNumbering" + | methodNode method tempRefs | + methodNode _ + Parser new + encoderClass: EncoderForV3PlusClosures; + parse: 'foo + | numCopiedValuesCounts | + numCopiedValuesCounts := Dictionary new. + 0 to: 32 do: [:i| numCopiedValuesCounts at: i put: 0]. + Transcript clear. + Smalltalk allClassesDo: + [:c| + {c. c class} do: + [:b| + Transcript nextPut: b name first; endEntry. + b selectorsAndMethodsDo: + [:s :m| | pn | + m isQuick not ifTrue: + [pn := b parserClass new + encoderClass: EncoderForV3PlusClosures; + parse: (b sourceCodeAt: s) + class: b. + pn generate: #(0 0 0 0). + [pn accept: nil] + on: MessageNotUnderstood + do: [:ex| | msg numCopied | + msg := ex message. + (msg selector == #visitBlockNode: + and: [(msg argument instVarNamed: ''optimized'') not]) ifTrue: + [numCopied := (msg argument computeCopiedValues: pn) size. + numCopiedValuesCounts + at: numCopied + put: (numCopiedValuesCounts at: numCopied) + 1]. + msg setSelector: #==. + ex resume: nil]]]]]. + numCopiedValuesCounts' + class: Object. + method _ methodNode generate: #(0 0 0 0). + tempRefs _ methodNode encoder blockExtentsToTempsMap. + self assert: tempRefs keys asSet = method startpcsToBlockExtents values asSet! ! - self shouldnt: [dir includesKey: 'test1']. +!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 1/17/2011 00:13'! +testBlockNumberingForInjectInto + "Test that the compiler and CompiledMethod agree on the block numbering of Collection>>inject:into: + and that temp names for inject:into: are recorded." + "self new testBlockNumberingForInjectInto" + | methodNode method tempRefs | + methodNode := Parser new + encoderClass: EncoderForV3PlusClosures; + parse: (Collection sourceCodeAt: #inject:into:) + class: Collection. + method := methodNode generate: #(0 0 0 0). + tempRefs := methodNode encoder blockExtentsToTempsMap. + self assert: tempRefs keys asSet = method startpcsToBlockExtents values asSet. + self assert: ((tempRefs includesKey: (0 to: 6)) + and: [(tempRefs at: (0 to: 6)) hasEqualElements: #(('thisValue' 1) ('binaryBlock' 2) ('nextValue' (3 1)))]). + self assert: ((tempRefs includesKey: (2 to: 4)) + and: [(tempRefs at: (2 to: 4)) hasEqualElements: #(('each' 1) ('binaryBlock' 2) ('nextValue' (3 1)))])! ! - dir recursiveDelete. - self should: [dir exists not]! ! +!ClosureCompilerTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 07:20:04'! +testDebuggerTempAccess -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:49'! -testConcatenation - " - FileManTest debug: #testConcatenation - " - | dir | - dir := ('./subDir' asDirectoryEntry / 'aaa/bbb' / 'ccc' / 'ddd\eee' / 'fff:ggg'). - dir at: 'test1' put: 'RecursiveDeleted!!'. + "This test also fails in Squeak. Check if it is ever fixed." + self shouldFail: [ self doTestDebuggerTempAccessWith: 1 with: 2 ]! ! - self assert: dir name = 'ggg'. - self assert: dir parent name = 'fff'. - self assert: dir parent parent name = 'eee'. - self assert: dir parent parent parent name = 'ddd'. - self assert: dir parent parent parent parent name = 'ccc'. - self assert: dir parent parent parent parent parent name = 'bbb'. - self assert: dir parent parent parent parent parent parent name = 'aaa'. +!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 6/1/2021 14:19:36'! +testInjectIntoDecompilationsEncoderForV3PlusClosures + "Test various compilations decompile to the same code for a method sufficiently + simple that this is possible and sufficiently complex that the code generated + varies between the compilations." + "self new testInjectIntoDecompilationsEncoderForV3PlusClosures" + | source | - './subDir' asDirectoryEntry recursiveDelete. - self shouldnt: [dir exists]. - self shouldnt: ['./subDir' asDirectoryEntry exists].! ! + source := (Collection sourceCodeAt: #inject:into:) asString. + { EncoderForV3PlusClosures } do: + [:encoderClass| | method | + method := (Parser new + encoderClass: encoderClass; + parse: source + class: Collection) + generate: #(0 0 0 0). + self assert: (Scanner new scanTokens: method decompileString) + = #(inject: arg1 into: arg2 + | temp3 | + temp3 _ arg1 . + self do: [ ':argm1_5' | temp3 _ arg2 value: temp3 value: argm1_5 ] . + ^ temp3 . )]! ! -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:49'! -testCopy - "FileManTest debug: #testCopy" - | file1 file2 | - file1 := self randomFileName asFileEntry. - file2 := file1 parent // self randomFileName. +!ClosureCompilerTest methodsFor: 'tests' stamp: 'jmv 5/27/2015 13:04'! +testInjectIntoDecompiledDebugs + "Test various debugs of the decompiled form debug correctly." + "self new testInjectIntoDecompiledDebugs" + | source | - file1 fileContents: 'This is a test'. + source := (Collection sourceCodeAt: #inject:into:) asString. + { EncoderForV3PlusClosures } do: + [:encoderClass| | method | + method := (Parser new + encoderClass: encoderClass; + parse: source + class: Collection) + generate: #(0 0 0 0). + self supportTestSourceRangeAccessForDecompiledInjectInto: method source: method decompileString]! ! -" self should: [file2 fileContents isEmpty]." - self should: [file2 exists not]. +!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 7/24/2009 11:51'! +testInlineBlockCollectionEM1 + | a1 b1 i1 a2 b2 i2 we wb | + b1 := OrderedCollection new. + i1 := 1. + [a1 := i1. + i1 <= 3] whileTrue: + [b1 add: [a1]. + i1 := i1 + 1]. + b1 := b1 asArray collect: [:b | b value]. + b2 := OrderedCollection new. + i2 := 1. + we := [a2 := i2. i2 <= 3]. + wb := [b2 add: [a2]. i2 := i2 + 1]. + we whileTrue: wb. "defeat optimization" + b2 := b2 asArray collect: [:b | b value]. + self assert: b1 = b2! ! - file1 copyTo: file2 pathName. +!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 3/7/2009 11:25'! +testInlineBlockCollectionLR1 + "Test case from Lukas Renggli" + | col | + col := OrderedCollection new. + 1 to: 11 do: [ :each | col add: [ each ] ]. + self assert: (col collect: [ :each | each value ]) asArray = (1 to: 11) asArray! ! - self should: [file2 fileContents = 'This is a test']. +!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 3/7/2009 11:39'! +testInlineBlockCollectionLR2 + "Test case from Lukas Renggli" + | col | + col := OrderedCollection new. + 1 to: 11 do: [ :each | #(1) do: [:ignored| col add: [ each ]] ]. + self assert: (col collect: [ :each | each value ]) asArray = (1 to: 11) asArray! ! - file1 delete. - file2 delete. - self should: [file1 exists not]. - self should: [file2 exists not] - - - ! ! +!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 3/9/2009 11:00'! +testInlineBlockCollectionLR3 + | col | + col := OrderedCollection new. + 1 to: 11 do: [ :each | | i | i := each. col add: [ i ]. i := i + 1 ]. + self assert: (col collect: [ :each | each value ]) asArray = (2 to: 12) asArray! ! -!FileManTest methodsFor: 'testing' stamp: 'jmv 6/1/2016 17:17'! -testDefaultDirectory - " - FileManTest debug: #testDefaultDirectory - " - - | pathComponents | +!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 7/22/2009 16:55'! +testInlineBlockCollectionSD1 + | a1 b1 a2 b2 | + b1 := OrderedCollection new. + 1 to: 3 do: + [:i | + a1 := i. + b1 add: [a1]]. + b1 := b1 asArray collect: [:b | b value]. + b2 := OrderedCollection new. + 1 to: 3 do: + [:i | + a2 := i. + b2 add: [a2]] yourself. "defeat optimization" + b2 := b2 asArray collect: [:b | b value]. + self assert: b1 = b2! ! - " - See #asAbsolutePathName. See #isAbsolutePathName - self assert: '' asDirectoryEntry = DirectoryEntry currentDirectory. - " +!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 6/4/2008 15:20'! +testSourceRangeAccessForClosureBytecodeInjectInto + "Test debugger source range selection for inject:into: for a version compiled with closures" + "self new testSourceRangeAccessForClosureBytecodeInjectInto" + | source method | + source := (Collection sourceCodeAt: #inject:into:) asString. + method := (Parser new + encoderClass: EncoderForV3PlusClosures; + parse: source + class: Collection) + generate: (Collection compiledMethodAt: #inject:into:) trailer. + self supportTestSourceRangeAccessForInjectInto: method source: source! ! - pathComponents := '' asDirectoryEntry pathComponents. - self assert: pathComponents = DirectoryEntry currentDirectory pathComponents! ! +!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 6/4/2008 11:40'! +testSourceRangeAccessForInjectInto + "Test debugger source range selection for inject:into: for the current version of the method" + "self new testSourceRangeAccessForInjectInto" + self supportTestSourceRangeAccessForInjectInto: (Collection compiledMethodAt: #inject:into:) + source: (Collection sourceCodeAt: #inject:into:) asString! ! -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:49'! -testFileContents - "FileManTest debug: #testFileContents" - | file1 file2 bytes | - file1 := self randomFileName asFileEntry. - file1 fileContents: 'This is a test'. - self should: [file1 fileContents = 'This is a test']. - file1 delete. - self should: [file1 exists not]. - - file2 := self randomFileName asFileEntry. - bytes := #(1 2 3 4 5 6) asByteArray. - file2 fileContents: bytes. - self should: [file2 fileContents = bytes asString]. - self should: [file2 binaryContents = bytes]. - file2 delete. - self should: [file2 exists not]! ! +!ClosureCompilerTest methodsFor: 'tests' stamp: 'eem 6/15/2008 11:26'! +testTempNameAccessForInjectInto + "self new testTempNameAccessForInjectInto" + | methodNode method evaluationCount block debuggerMap | + methodNode := Parser new + encoderClass: EncoderForV3PlusClosures; + parse: (Collection sourceCodeAt: #inject:into:) + class: Collection. + method := methodNode generate: #(0 0 0 0). + debuggerMap := DebuggerMethodMap forMethod: method methodNode: methodNode. + evaluationCount := 0. + block := [:prev :each| | theContext tempNames | + evaluationCount := evaluationCount + 1. + theContext := thisContext sender. + tempNames := debuggerMap tempNamesForContext: theContext. + self assert: (tempNames hasEqualElements: tempNames). + #('thisValue' 'each' 'binaryBlock' 'nextValue') + with: { 0. each. block. prev} + do: [:tempName :value| + self assert: (debuggerMap namedTempAt: (tempNames indexOf: tempName) in: theContext) == value. + tempName ~= 'each' ifTrue: + [self assert: (debuggerMap namedTempAt: (tempNames indexOf: tempName) in: theContext home) == value]]]. + (1 to: 10) withArgs: { 0. block } executeMethod: method. + self assert: evaluationCount = 10! ! -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:49'! -testIsAbsolutePathName - " - FileManTest debug: #testIsAbsolutePathName - " - self assert: '/' isAbsolutePathName. - self assert: '/temp/' isAbsolutePathName. - self assert: '/temp/a' isAbsolutePathName. - Smalltalk platformName = 'Win32' ifTrue: [ - self assert: 'C:/temp/b' isAbsolutePathName ]. - FileIOAccessor default onMacClassic ifTrue: [ - self assert: 'Macintosh HD/tmp' isAbsolutePathName ]. - - self deny: './' isAbsolutePathName. - self deny: '../' isAbsolutePathName. - self deny: 'afile' isAbsolutePathName.! ! +!ClosureCompilerTest class methodsFor: 'code examples' stamp: 'eem 5/20/2008 09:40'! +methodWithCopiedAndAssignedTemps + | blk "0w" a "0w" b "0w" c "0w" t "0w" r1 "0w" r2 "0w" | + a := 1. "1w" + b := 2. "1w" + c := 4. "1w" + t := 0. "1w" + blk "5w" := ["2" t "3w" := t "3r" + a "3r" + b "3r" + c "3r" ] "4". + r1 "5w" := blk "5r" value. + b "5w" := -100. + r2 "5w" := blk "5r" value. + ^r1 "5r" -> r2 "5r" -> t "5r" -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:50'! -testIsRelativePathName - " - FileManTest debug: #testIsRelativePathName - " - self assert: './' isRelativePathName. - self assert: '../' isRelativePathName. -" self assert: 'afile' isRelativePathName." - self deny: '/' isRelativePathName. - self deny: '/temp/' isRelativePathName. - self deny: '/temp/a' isRelativePathName. - self deny: 'C:/temp/b' isRelativePathName. - self deny: 'Macintosh HD/tmp' isRelativePathName.! ! + "a: main(read(),write(0,1)), block(read(3),write()) => copy; no writes follow read + b: main(read(),write(0,1,5)), block(read(3),write()) => remote; write follows contained read + blk: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5 + c: main(read(),write(0,1)), block(read(3),write()) => copy; no writes follow read + r1: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5 + r2: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5 + t: main(read(5),write(0,1)), block(read(3),write(3)) => remote; read follows contained write" -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:50'! -testPathComponents - " - FileManTest debug: #testPathComponents - " - | pathComponents | - pathComponents := './aaa/bbb\ccc:ddd' asDirectoryEntry pathComponents. - pathComponents := pathComponents last: 4. - self assert: pathComponents asArray = #('aaa' 'bbb' 'ccc' 'ddd'). + "(Parser new + encoderClass: EncoderForV3; + parse: (self class sourceCodeAt: #methodWithCopiedAndAssignedTemps) + class: self class) generateUsingClosures: #(0 0 0 0)"! ! - pathComponents := '/aaa/bbb\ccc:ddd' asDirectoryEntry pathComponents. - pathComponents := pathComponents last: 4. - self assert: pathComponents asArray = #('aaa' 'bbb' 'ccc' 'ddd'). +!ClosureCompilerTest class methodsFor: 'code examples' stamp: 'eem 5/19/2008 20:45'! +methodWithCopiedAndPostClosedOverAssignedTemps + | blk a b c r1 r2 | + a := 1. + b := 2. + c := 4. + blk := [a + b + c]. + r1 := blk value. + b := nil. + r2 := blk value. + r1 -> r2 - pathComponents := 'aaa/bbb\ccc:ddd' asDirectoryEntry pathComponents. - pathComponents := pathComponents last: 4. - self assert: pathComponents asArray = #('aaa' 'bbb' 'ccc' 'ddd')! ! + "(Parser new + encoderClass: EncoderForV3; + parse: (self class sourceCodeAt: #methodWithCopiedAndPostClosedOverAssignedTemps) + class: self class) generateUsingClosures: #(0 0 0 0)"! ! -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:50'! -testPipe - "FileManTest debug: #testPipe" - | reverseFilter file1 file2 file3 | +!ClosureCompilerTest class methodsFor: 'code examples' stamp: 'eem 5/19/2008 20:10'! +methodWithCopiedTemps + | a b c r | + a := 1. + b := 2. + c := 4. + r := [a + b + c] value. + b := nil. + r - reverseFilter := [:in :out | out nextPutAll: (in upToEnd reverse)]. + "Parser new + parse: (self class sourceCodeAt: #methodWithCopiedTemps) + class: self class" - file1 := self randomFileName asFileEntry. - file2 := self randomFileName asFileEntry. - file3 := self randomFileName asFileEntry. + "(Parser new + encoderClass: EncoderForV3; + parse: (self class sourceCodeAt: #methodWithCopiedTemps) + class: self class) generateUsingClosures: #(0 0 0 0)"! ! - file1 fileContents: 'This is a pipe test'. +!ClosureCompilerTest class methodsFor: 'code examples' stamp: 'eem 5/19/2008 14:24'! +methodWithOptimizedBlocks + | s c | + s := self isNil + ifTrue: [| a | a := 'isNil'. a] + ifFalse: [| b | b := 'notNil'. b]. + c := String new: s size. + 1 to: s size do: + [:i| c at: i put: (s at: i)]. + ^c - file1 pipe: reverseFilter to: file2 pathName. + "Parser new + parse: (self class sourceCodeAt: #methodWithOptimizedBlocks) + class: self class"! ! - self should: [('.' asDirectoryEntry at: file1 name) = 'This is a pipe test']. - self should: [(file2 fileContents) = 'tset epip a si sihT']. -" self should: [(file3 fileContents) isEmpty]." - self should: [file3 exists not]. +!ClosureCompilerTest class methodsFor: 'code examples' stamp: 'eem 5/19/2008 14:24'! +methodWithOptimizedBlocksA + | s c | + s := self isNil + ifTrue: [| a | a := 'isNil'. a] + ifFalse: [| a | a := 'notNil'. a]. + c := String new: s size. + 1 to: s size do: + [:i| c at: i put: (s at: i)]. + ^c - file2 pipe: reverseFilter to: file3 pathName. - self should: [(file3 fileContents) = 'This is a pipe test']. + "Parser new + parse: (self class sourceCodeAt: #methodWithOptimizedBlocksA) + class: self class"! ! - file1 delete. - file2 delete. - file3 delete. - self should: [file1 exists not]. - self should: [file2 exists not]. - self should: [file3 exists not] - - - ! ! +!ClosureCompilerTest class methodsFor: 'code examples' stamp: 'eem 5/19/2008 14:12'! +methodWithVariousTemps + | classes total totalLength | + classes := self withAllSuperclasses. + total := totalLength := 0. + classes do: [:class| | className | + className := class name. + total := total + 1. + totalLength := totalLength + className size]. + ^total -> totalLength -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:50'! -testRecursiveDelete - "FileManTest debug: #testRecursiveDelete" - | dir | - dir := ('./subDir' asDirectoryEntry / 'aaa\bbb' / 'ccc' / 'ddd\eee' / 'fff:ggg'). - dir at: 'test1' put: 'RecursiveDelete!!'. - self should: [(dir at: 'test1') = 'RecursiveDelete!!']. + "Parser new + parse: (self class sourceCodeAt: #methodWithVariousTemps) + class: self class"! ! - dir removeKey: 'test1'. +!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! +testSample01 + | blockClosure materialized | + blockClosure _ self bc01. + materialized _ blockClosure veryDeepCopy. + self assert: blockClosure value = materialized value.! ! - self shouldnt: [(dir // 'test1') exists]. +!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! +testSample02 + | blockClosure materialized | + blockClosure _ self bc02. + materialized _ blockClosure veryDeepCopy. + self assert: blockClosure value = materialized value.! ! - './subDir' asDirectoryEntry recursiveDelete. - self shouldnt: [dir exists]. - self shouldnt: ['./subDir' asDirectoryEntry exists]. +!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! +testSample03 + | blockClosure materialized | + blockClosure _ self bc03. + materialized _ blockClosure veryDeepCopy. + self assert: blockClosure value = materialized value. + self assert: blockClosure value = materialized value. + self assert: blockClosure value = materialized value.! ! - ! ! +!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! +testSample04 + | blockClosure materialized | + blockClosure _ self bc04. + materialized _ blockClosure veryDeepCopy. + self assert: blockClosure value = materialized value.! ! -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:50'! -testRefresh - "FileManTest debug: #testRefresh" - | file1 | - file1 := self randomFileName asFileEntry. +!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! +testSample05 + | blockClosure materialized | + blockClosure _ self bc05. + materialized _ blockClosure veryDeepCopy. + self assert: blockClosure value = materialized value. + self assert: blockClosure value = materialized value. + self assert: blockClosure value = materialized value.! ! - file1 fileContents: '1234567890'. - self should: [file1 fileSize = 10]. +!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! +testSample06 + | blockClosures materialized firstRun | - file1 fileContents: '123'. - self should: [file1 fileSize = 3]. - - - file1 delete. - self should: [file1 exists not]. - ! ! + blockClosures _ self bc06. + firstRun _ blockClosures second value. + "If sibling closures are serialized separately, their relationship is lost in the copies." + materialized _ blockClosures collect: [ :each | each veryDeepCopy ]. + self assert: blockClosures first value = materialized first value. + self assert: blockClosures second value = materialized second value. + self assert: blockClosures third value = materialized third value. + self assert: blockClosures first value = materialized first value. + self assert: firstRun = materialized second value. + self deny: blockClosures second value = materialized second value. -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:50'! -testRename - "FileManTest debug: #testRename" - | file1 | - file1 := self randomFileName asFileEntry. - file1 fileContents: 'ToBeRenamed'. + blockClosures _ self bc06. + "If sibling closures are serialized together, their relationship is kept in the copies." + materialized _ blockClosures veryDeepCopy. + self assert: blockClosures first value = materialized first value. + self assert: blockClosures second value = materialized second value. + self assert: blockClosures third value = materialized third value. + self assert: blockClosures first value = materialized first value. + self deny: firstRun = materialized second value. + self assert: blockClosures second value = materialized second value.! ! - self shouldnt: [file1 name = 'newName1']. +!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! +testSample07 + | blockClosures materialized | - file1 rename: 'newName1'. + blockClosures _ self bc07. + "If sibling closures are serialized separately, their relationship is lost in the copies." + materialized _ blockClosures collect: [ :each | each veryDeepCopy ]. + self assert: blockClosures first value = materialized first value. + self assert: blockClosures second value = materialized second value. + self deny: blockClosures third value = materialized third value. + self assert: blockClosures second value = materialized second value. + self deny: blockClosures first value = materialized first value. + self deny: blockClosures third value = materialized third value. + self deny: blockClosures first value = materialized first value. - self should: [file1 name = 'newName1']. - self should: [file1 exists]. + blockClosures _ self bc07. + "If sibling closures are serialized together, their relationship is kept in the copies." + materialized _ blockClosures veryDeepCopy. + self assert: blockClosures first value = materialized first value. + self assert: blockClosures second value = materialized second value. + self assert: blockClosures third value = materialized third value. + self assert: blockClosures second value = materialized second value. + self assert: blockClosures first value = materialized first value. + self assert: blockClosures third value = materialized third value. + self assert: blockClosures first value = materialized first value.! ! - self should: [file1 fileContents = 'ToBeRenamed']. +!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! +testSample08 + | blockClosures materialized | - file1 delete. - self should: [file1 exists not]. - ! ! + blockClosures _ self bc08. + "If sibling closures are serialized separately, their relationship is lost in the copies." + materialized _ blockClosures collect: [ :each | each veryDeepCopy ]. + self assert: blockClosures first value = materialized first value. + self assert: (blockClosures second value: 7) = (materialized second value: 7). + self assert: blockClosures third value = materialized third value. + self deny: (blockClosures second value: 7) = (materialized second value: 7). + self deny: (blockClosures fourth value: 2 value: 3) = (materialized fourth value: 2 value: 3). -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 12:02'! -testRoot - "FileManTest debug: #testRoot" - | root | - root := DirectoryEntry roots first. - self should: [root pathComponents isEmpty]. - FileIOAccessor default onUnix ifTrue: [ - self should: [root = '\' asDirectoryEntry]. - self should: [root = ':' asDirectoryEntry]. - self should: [root = '/' asDirectoryEntry]]! ! + blockClosures _ self bc08. + "If sibling closures are serialized together, their relationship is kept in the copies." + materialized _ blockClosures veryDeepCopy. + self assert: blockClosures first value = materialized first value. + self assert: (blockClosures second value: 7) = (materialized second value: 7). + self assert: blockClosures third value = materialized third value. + self assert: (blockClosures second value: 7) = (materialized second value: 7). + self assert: (blockClosures fourth value: 2 value: 3) = (materialized fourth value: 2 value: 3).! ! -!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 11:19'! -testStream - "FileManTest debug: #testStream" - | file1 contents formerContents allContents | - file1 := self randomFileName asFileEntry. - file1 writeStreamDo: [:str | str nextPutAll: 'HELLO!!']. - contents := file1 readStreamDo: [:str | str upToEnd]. - self should: [contents = 'HELLO!!']. +!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! +testSample09 + | blockClosures materialized | - file1 appendStreamDo: [:str | str nextPutAll: 'AGAIN!!']. + blockClosures _ self bc09. + materialized _ blockClosures collect: [ :each | each veryDeepCopy ]. - formerContents := file1 readStreamDo: [:str | str upTo:$!!]. - self should: [formerContents = 'HELLO']. + self assert: (blockClosures first value: $c) = (materialized first value: $c). + self assert: (blockClosures second value: $d value: #e) = (materialized second value: $d value: #e). + self assert: (blockClosures third value: $d value: $e) = (materialized third value: $d value: $e).! ! - allContents := file1 readStreamDo: [:str | str upToEnd]. - self should: [allContents = 'HELLO!!AGAIN!!']. +!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! +testSample10 + | blockClosure1 blockClosure2 blockClosure3 value materialized1 materialized2a materialized2b materialized3a materialized3b materialized3c | - file1 delete. - self should: [file1 exists not]. - ! ! + blockClosure1 _ self bc10. + blockClosure2 _ blockClosure1 withFirstArg: 1. + blockClosure3 _ (blockClosure1 withFirstArg: 1) withFirstArg: 2. + value _ blockClosure1 value: 1 value: 2. + self assert: (blockClosure2 value: 2) = value. + self assert: blockClosure3 value = value. -!CuisSourceFileArrayTest methodsFor: 'testing' stamp: 'jmv 5/22/2011 23:57'! -testAddressRange - "Test source pointer to file position address translation across the full address range" - - | sf | - sf := CuisSourceFileArray new. - (16r1000000 to: 16r4FFFFFF by: 811) do: [:e | | i a p | - i := sf fileIndexFromSourcePointer: e. - p := sf filePositionFromSourcePointer: e. - a := sf sourcePointerFromFileIndex: i andPosition: p. - self assert: a = e] + materialized1 _ blockClosure1 veryDeepCopy. + materialized2a _ materialized1 withFirstArg: 1. + materialized2b _ blockClosure2 veryDeepCopy. + materialized3a _ (materialized1 withFirstArg: 1) withFirstArg: 2. + materialized3b _ materialized2b withFirstArg: 2. + materialized3c _ blockClosure3 veryDeepCopy. + self assert: (materialized1 value: 1 value: 2) = value. + self assert: (materialized2a value: 2) = value. + self assert: (materialized2b value: 2) = value. + self assert: materialized3a value = value. + self assert: materialized3b value = value. + self assert: materialized3c value = value. ! ! -!CuisSourceFileArrayTest methodsFor: 'testing' stamp: 'jmv 5/23/2011 00:08'! -testChangesFileAddressRange - "Test file position to source pointer address translation for the changes file" - - | sf a e | - sf := CuisSourceFileArray new. - (0 to: 16r1FFFFFF by: 811) do: [:ee | | a2 i p | - e _ ee // 32 * 32. - a := sf sourcePointerFromFileIndex: 2 andPosition: e. - i := sf fileIndexFromSourcePointer: a. - self assert: i = 2. - p := sf filePositionFromSourcePointer: a. - self assert: p = e. - a2 := sf sourcePointerFromFileIndex: 2 andPosition: p. - self assert: a2 = a]. - (0 to: 16rFFFFFF by: 811) do: [:ee | - e _ ee // 32 * 32. - a := sf sourcePointerFromFileIndex: 2 andPosition: e. - self assert: (a between: 16r3000000 and: 16r3FFFFFF)]. - (16r1000000 to: 16r1FFFFFF by: 811) do: [:ee | - e _ ee // 32 * 32. - a := sf sourcePointerFromFileIndex: 2 andPosition: e. - self assert: (a between: 16r3000000 and: 16r4FFFFFF)] +!ClosureSerializationTest methodsFor: 'testing' stamp: 'jmv 9/26/2019 23:19:41'! +testSample11 + | blockClosures materialized | + blockClosures _ self bc11. + "If sibling closures are serialized separately, their relationship is lost in the copies." + materialized _ blockClosures collect: [ :each | each veryDeepCopy ]. + self assert: blockClosures first value = materialized first value. + self assert: blockClosures second value = materialized second value. + self deny: blockClosures first value = materialized first value. + self assert: blockClosures second value = materialized second value. + self deny: blockClosures first value = materialized first value. -! ! + blockClosures _ self bc11. + "If sibling closures are serialized together, their relationship is kept in the copies." + materialized _ blockClosures veryDeepCopy. + self assert: blockClosures first value = materialized first value. + self assert: blockClosures second value = materialized second value. + self assert: blockClosures first value = materialized first value. + self assert: blockClosures second value = materialized second value. + self assert: blockClosures first value = materialized first value.! ! -!CuisSourceFileArrayTest methodsFor: 'testing' stamp: 'jmv 5/23/2011 00:06'! -testFileIndexFromSourcePointer - "Test derivation of file index for sources or changes file from source pointers" +!ClosureSerializationTest methodsFor: 'aux' stamp: 'jmv 9/26/2019 23:19:41'! +gimme5 + ^1+4! ! - | sf | - sf := CuisSourceFileArray new. - "sources file mapping" - self assert: 1 = (sf fileIndexFromSourcePointer: 16r1000000). - self assert: 1 = (sf fileIndexFromSourcePointer: 16r1000013). - self assert: 1 = (sf fileIndexFromSourcePointer: 16r1FFFFFF). - self assert: 1 = (sf fileIndexFromSourcePointer: 16r2000000). - self assert: 1 = (sf fileIndexFromSourcePointer: 16r2000013). - self assert: 1 = (sf fileIndexFromSourcePointer: 16r2FFFFFF). - (16r1000000 to: 16r1FFFFFF by: 811) do: [:e | self assert: 1 = (sf fileIndexFromSourcePointer: e)]. - (16r2000000 to: 16r2FFFFFF by: 811) do: [:e | self assert: 1 = (sf fileIndexFromSourcePointer: e)]. - "changes file mapping" - self assert: 2 = (sf fileIndexFromSourcePointer: 16r3000000). - self assert: 2 = (sf fileIndexFromSourcePointer: 16r3000013). - self assert: 2 = (sf fileIndexFromSourcePointer: 16r3FFFFFF). - self assert: 2 = (sf fileIndexFromSourcePointer: 16r4000000). - self assert: 2 = (sf fileIndexFromSourcePointer: 16r4000013). - self assert: 2 = (sf fileIndexFromSourcePointer: 16r4FFFFFF). - (16r3000000 to: 16r3FFFFFF by: 811) do: [:e | self assert: 2 = (sf fileIndexFromSourcePointer: e)]. - (16r4000000 to: 16r4FFFFFF by: 811) do: [:e | self assert: 2 = (sf fileIndexFromSourcePointer: e)] +!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! +bc01 + ^[ self gimme5 ]! ! +!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! +bc02 + ^[ ivar + 4 ]! ! -! ! +!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! +bc03 + ^[ ivar _ ivar + 3 ]! ! -!CuisSourceFileArrayTest methodsFor: 'testing' stamp: 'jmv 5/23/2011 00:09'! -testFilePositionFromSourcePointer - "Test derivation of file position for sources or changes file from source pointers" +!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! +bc04 + | t | + t _ self gimme5. + ^[ t * 2 ]! ! - | sf | - sf := CuisSourceFileArray new. - "sources file" - self assert: 0 = (sf filePositionFromSourcePointer: 16r1000000). - "changes file" - self assert: 0 = (sf filePositionFromSourcePointer: 16r3000000).! ! +!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! +bc05 + | t | + t _ self gimme5. + ^[ t _ t * 2 ]! ! -!CuisSourceFileArrayTest methodsFor: 'testing' stamp: 'jmv 5/23/2011 00:10'! -testSourcePointerFromFileIndexAndPosition - "Test valid input ranges" +!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! +bc06 + | u t | + u _ self gimme5 + 2. + t _ self gimme5. + ^{[ u * 2 ]. [ t * 2 ].[t _ t*3]}.! ! - | sf | - sf := CuisSourceFileArray new. - self should: [sf sourcePointerFromFileIndex: 0 andPosition: 0] raise: Error. - self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 0] raise: Error. - self shouldnt: [sf sourcePointerFromFileIndex: 2 andPosition: 0] raise: Error. - self should: [sf sourcePointerFromFileIndex: 0 andPosition: 3] raise: Error. - self should: [sf sourcePointerFromFileIndex: 1 andPosition: -1] raise: Error. - self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF] raise: Error. - self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 16r2000000] raise: Error. - self should: [sf sourcePointerFromFileIndex: 3 andPosition: 0] raise: Error. - self should: [sf sourcePointerFromFileIndex: 4 andPosition: 0] raise: Error. - - self assert: 16r1000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 0). - self assert: 16r3000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 0).! ! +!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! +bc07 + | a b c d e f g | + a _ self gimme5 + 1. + b _ self gimme5 + 2. + c _ self gimme5 + 3. + d _ self gimme5 + 4. + e _ self gimme5 + 5. + f _ self gimme5 + 6. + g _ self gimme5 + 7. + ^{[ a * 10 + b * 10 + c * 10 + d * 10 + e + f + g ]. [ a _ 7. a * 2 ].[ c _ 9. d _ d*10. a * 10 + b * 10 + c + d]}.! ! -!CuisSourceFileArrayTest methodsFor: 'testing' stamp: 'jmv 5/23/2011 00:11'! -testSourcesFileAddressRange - "Test file position to source pointer address translation for the sources file" - - | sf a e | - sf := CuisSourceFileArray new. - (0 to: 16r1FFFFFF by: 811) do: [:ee | | a2 p i | - e _ ee // 32 * 32. - a := sf sourcePointerFromFileIndex: 1 andPosition: e. - i := sf fileIndexFromSourcePointer: a. - self assert: i = 1. - p := sf filePositionFromSourcePointer: a. - self assert: p = e. - a2 := sf sourcePointerFromFileIndex: 1 andPosition: p. - self assert: a2 = a]. - (0 to: 16rFFFFFF by: 811) do: [:ee | - e _ ee // 32 * 32. - a := sf sourcePointerFromFileIndex: 1 andPosition: e. - self assert: (a between: 16r1000000 and: 16r1FFFFFF)]. - (16r1000000 to: 16r1FFFFFF by: 811) do: [:ee | - e _ ee // 32 * 32. - a := sf sourcePointerFromFileIndex: 1 andPosition: e. - self assert: (a between: 16r1000000 and: 16r2FFFFFF)] +!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! +bc08 -! ! + | u t | + u _ self gimme5 + 2. + t _ self gimme5. + ^{ + [ | x y z | x _ t. y _ x*0+2. z _ x * t. {u * 2. x. y. z} ]. + [ :a | t * 2 + a ]. + [|x y | t _ t*3. y _ t*2. {x. t. y}]. + [:a :b | a * b * t ] + }.! ! -!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:15:22'! -testUpTo1ShortRecords - ". this test ensures the upTo: delim method behaves as specified by the ANSI standard: - Delimiter is considered a separator (and therefore not required for the last chunk)." - |path fs| - path _ 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . - path asFileEntry fileContents: 'record-1Xrecord-2Xrecord-incomplete'. - fs _ path asFileEntry readStream . - self assert: ((fs upTo: $X) = 'record-1'). - self assert: ((fs upTo: $X) = 'record-2'). - self assert: ((fs upTo: $X) = 'record-incomplete'). - self assert: ((fs upTo: $X) = ''). - ". the stream has been all consumed" - self assert: (fs position = 35). - fs close . - path asFileEntry delete. +!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! +bc09 - ! ! + | clo1 clo2 closure | + closure := ( + ([ :a | + [ :b | + clo1 := [ :c | {c. b. a.}]. + clo2 := [ :d :e | {a. b. e. d.}] + ] + ]) value: $a + ) value: 'b'. + ^{ clo1. clo2. closure }! ! -!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:14:45'! -testUpTo2IncompleteRecords - " - . This test stresses the motivation for introducing upTo:delimiterIsTerminator: - . if two separate processes are reading and writing records into the same file - upTo can potentially create a bit a of a mess by reading in half records and complete records. - . please compare to the equivalent testUpToTerminatorX to see what is probably the behaviour your are looking for - " - |path fs| - path _ 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . - " a process starts to write data into a file but it does not end cleanly the writing " - path asFileEntry fileContents: 'record-1Xrec'. - fs _ path asFileEntry readStream . - " upTo reads 'record-1' and the second time reads half a token " - self assert: ((fs upTo: $X) = 'record-1'). - self assert: ((fs upTo: $X) = 'rec'). - ". the writing process comes back online and terminates its record writing " - path asFileEntry appendContents: 'ord-2Xrecord-3X'. - ". upTo reads an half token and then a complete one " - self assert: ((fs upTo: $X) = 'ord-2'). - self assert: ((fs upTo: $X) = 'record-3'). - ". when there is nothing more to read upTo returns the empty string " - self assert: ((fs upTo: $X) = ''). - fs close . - path asFileEntry delete. +!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! +bc10 - ! ! + ^ [ :a :b | a + b ]! ! -!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:01:55'! -testUpTo3LongUnterminatedRecord - "Long input, no delimiter found, expected to return all the data chunk up to the end of file. " - | path longString fs read | - path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . - longString _ ((1 to: 100) inject: '' into: [ :prev :each | prev, 'A lot of stuff, needs over 2000 chars!! ']). - path asFileEntry fileContents: longString . - fs := path asFileEntry readStream. - read := fs upTo: $X. - self assert: (read = longString ). - fs close. - path asFileEntry delete.! ! +!ClosureSerializationTest methodsFor: 'sample closures' stamp: 'jmv 9/26/2019 23:19:41'! +bc11 + | a b c d e f g | + a _ self gimme5 + 1. + b _ self gimme5 + 2. + c _ self gimme5 + 3. + d _ self gimme5 + 4. + e _ self gimme5 + 5. + f _ self gimme5 + 6. + g _ self gimme5 + 7. + { b. d. e. f } print. + ^{[ g + a * 10 + a + a + g + c ]. [ b _ 7. c _ c * 2 ]}.! ! -!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:02:02'! -testUpTo4LongUnterminatedRecord - "Big chunk, not delimiter found, expected return all the chunk " - | path fs read | - path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . - fs _ path asFileEntry forceWriteStream . - 1 to: 5000 do: [ :i | - (i < 3000) ifTrue: [ fs nextPut: $a ]. - (i >= 3000) ifTrue: [ fs nextPut: $b ]. - ]. - fs close. - fs := path asFileEntry readStream. - read := fs upTo: $X. - self assert: (read size = 5000). - fs close. - path asFileEntry delete.! ! +!ClosureSerializationTest methodsFor: 'setUp/tearDown' stamp: 'jmv 9/26/2019 23:19:41'! +setUp + ivar _ 7. + ^ivar! ! -!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:02:08'! -testUpTo5TerminatedAndUnterminatedLongRecords - "Two big chunks, one delimiter in the middle, expected to return - the first time a big chunk, the second time the second block up to EOF. " - | path fs read | - path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . - fs _ path asFileEntry forceWriteStream . - 1 to: 6000 do: [ :i | - (i < 3000) ifTrue: [ fs nextPut: $a ]. - (i = 3000) ifTrue: [ fs nextPut: $X ]. - (i > 3000) ifTrue: [ fs nextPut: $b ]. - ]. - fs close. - fs := path asFileEntry readStream. - " first scan, the delimiter is found but not printed. " - read := fs upTo: $X. - self assert: (read size = 2999). - self assert: ((read at: 1) = $a). - " second scan. the delimiter is not found, all second chunk is returned " - read := fs upTo: $X. - self assert: (read size = 3000). - self assert: (read at: 1) = $b. - fs close. - path asFileEntry delete.! ! +!ClosureTests methodsFor: 'utilities' stamp: 'lr 3/9/2009 16:48'! +assertValues: anArray + | values | + values := collection collect: [ :each | each value ]. + self + assert: anArray asArray = values asArray + description: 'Expected: ' , anArray asArray printString , + ', but got ' , values asArray printString! ! -!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:02:13'! -testUpTo6TerminatedLongRecords - "Two big chunks, one delimiter in the middle, one at the end. expected to return - two big chunks in two read, delimiters excluded. " - | path fs read | - path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . - fs _ path asFileEntry forceWriteStream . - 1 to: 6000 do: [ :i | - (i < 3000) ifTrue: [ fs nextPut: $a ]. - (i = 3000) ifTrue: [ fs nextPut: $X ]. - ((Interval from: 3001 to: 5999) includes: i) ifTrue: [ fs nextPut: $b ]. - (i = 6000) ifTrue: [ fs nextPut: $X ] . - ]. - fs close. - fs := path asFileEntry readStream. - " first scan, delimiter is found, return all the block delimiter excluded " - read := fs upTo: $X. - self assert: (read size = 2999). - self assert: ((read at: 1) = $a). - " second scan, return chunk, delimiter excluded. " - read := fs upTo: $X. - self assert: (read size = 2999). - self assert: ((read at: 1) = $b). - fs close. - path asFileEntry delete.! ! +!ClosureTests methodsFor: 'utilities' stamp: 'cwp 11/16/2009 08:12'! +evaluateCopyOf: aBlock + aBlock copy value! ! -!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:17:41'! -testUpToTerminator1ShortRecords - " - . Read a file stream up to 'delim' in a strict way. - . If delim is found returns everything up to the first occurrence of 'delim' included. - . if delim is not found returns nil and set the FileStream position where it was before - the call was made. This ensures if another process writes into the file another delim - limited token we will fully read it on next upTo call. - This means Delimiter is a Terminator: a chunk is only considered well formed if it ends with it. - " - |path fs| - path _ 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . - path asFileEntry fileContents: 'record-1Xrecord-2Xrecord-incomplete'. - fs _ path asFileEntry readStream . - self assert: ((fs upTo: $X delimiterIsTerminator: true) = 'record-1X'). - self assert: ((fs upTo: $X delimiterIsTerminator: true) = 'record-2X'). - self assert: ((fs upTo: $X delimiterIsTerminator: true) = nil). - ". we are not at the end of the stream, but just after the last delim was found. - we are ready to receive other delim limitated tokens. if they get written. - " - self assert: (fs position = 18). - fs close . - path asFileEntry delete . +!ClosureTests methodsFor: 'utilities' stamp: 'cwp 11/16/2009 08:12'! +methodWithNonLocalReturn + self evaluateCopyOf: [^ self]. + self signalFailure: 'Should never reach here'! ! + +!ClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:35'! +methodArgument: anObject + ^ [ anObject ] ! ! -!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:18:12'! -testUpToTerminator2IncompleteRecords - " - . This test stresses the motivation for introducing upTo:delimiterIsTerminator: - . if two separate processes are reading and writing records into the same file - upTo:delimiterIsTerminator:true will not loose any token and will never return half written tokens. - " - |path fs| - path _ 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . - " a process starts to write data into a file but it does not end cleanly the writing " - path asFileEntry fileContents: 'record-1Xrec'. - fs _ path asFileEntry readStream . - " upTo:strict reads upto what it can find and ignores the rest " - self assert: ((fs upTo: $X delimiterIsTerminator: true) = 'record-1X'). - self assert: ((fs upTo: $X delimiterIsTerminator: true) = nil). - ". the writing process comes back online and terminates its record writing " - path asFileEntry appendContents: 'ord-2Xrecord-3X'. - ". upTo:strict is ready and reads just completed tokens and brand new ones. " - self assert: ((fs upTo: $X delimiterIsTerminator: true) = 'record-2X'). - self assert: ((fs upTo: $X delimiterIsTerminator: true) = 'record-3X'). - self assert: ((fs upTo: $X delimiterIsTerminator: true) = nil). - fs close . - path asFileEntry delete. - - ! ! - -!StandardFileStreamTest methodsFor: 'tests' stamp: 'jmv 10/25/2021 10:12:02'! -testUpToTerminator3LongUnterminatedRecord - "Long input, no delimiter found, expected to return nil. " - | path fs read | - path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . - path asFileEntry fileContents: ((1 to: 100) inject: '' into: [ :prev :each | prev, 'A lot of stuff, needs over 2000 chars!! ']). - fs := path asFileEntry readStream. - read := fs upTo: $X delimiterIsTerminator: true. - self assert: (read = nil). - fs close. - path asFileEntry delete.! ! - -!StandardFileStreamTest methodsFor: 'tests' stamp: 'jmv 10/25/2021 10:12:08'! -testUpToTerminator4LongUnterminatedRecord - "Big chunk, not delimiter found, expected return nil " - | path fs read | - path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . - fs _ path asFileEntry forceWriteStream . - 1 to: 5000 do: [ :i | - (i < 3000) ifTrue: [ fs nextPut: $a ]. - (i >= 3000) ifTrue: [ fs nextPut: $b ]. - ]. - fs close. - fs := path asFileEntry readStream. - read := fs upTo: $X delimiterIsTerminator: true. - self assert: (read = nil). - fs close. - path asFileEntry delete.! ! +!ClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:33'! +testBlockArgument + | block block1 block2 | + block := [ :arg | | temp | temp := arg. [ temp ] ]. + block1 := block value: 1. + block2 := block value: 2. + self assert: block1 value = 1. + self assert: block2 value = 2! ! -!StandardFileStreamTest methodsFor: 'tests' stamp: 'jmv 10/25/2021 10:12:14'! -testUpToTerminator5TerminatedAndUnterminatedLongRecords - "Two big chunks, one delimiter in the middle, expected to return - the first time a big chunk, the second time nil. " - | path fs read | - path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . - fs _ path asFileEntry forceWriteStream . - 1 to: 6000 do: [ :i | - (i < 3000) ifTrue: [ fs nextPut: $a ]. - (i = 3000) ifTrue: [ fs nextPut: $X ]. - (i > 3000) ifTrue: [ fs nextPut: $b ]. - ]. - fs close. - fs := path asFileEntry readStream. - " first scan, delimiter is found, return all the block delimiter included " - read := fs upTo: $X delimiterIsTerminator: true. - self assert: (read size = 3000). - self assert: ((read at: 1) = $a). - " second scan, delimiter not found, returns nil " - read := fs upTo: $X delimiterIsTerminator: true. - self assert: (read = nil). - fs close. - path asFileEntry delete.! ! +!ClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:33'! +testBlockTemp + | block block1 block2 | + block := [ :arg | [ arg ] ]. + block1 := block value: 1. + block2 := block value: 2. + self assert: block1 value = 1. + self assert: block2 value = 2! ! -!StandardFileStreamTest methodsFor: 'tests' stamp: 'jmv 10/25/2021 10:12:22'! -testUpToTerminator6TerminatedLongRecords - "Two big chunks, one delimiter in the middle, one at the end expected to return - two big chunks in two read, delimiters included. " - | path fs read | - path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . - fs _ path asFileEntry forceWriteStream . - 1 to: 6000 do: [ :i | - (i < 3000) ifTrue: [ fs nextPut: $a ]. - (i = 3000) ifTrue: [ fs nextPut: $X ]. - ((Interval from: 3001 to: 5999) includes: i) ifTrue: [ fs nextPut: $b ]. - (i = 6000) ifTrue: [ fs nextPut: $X ] . - ]. - fs close. - fs := path asFileEntry readStream. - " first scan, delimiter is found, return all the block delimiter included " - read := fs upTo: $X delimiterIsTerminator: true. - self assert: (read size = 3000). - self assert: ((read at: 1) = $a). - " second scan, delimiter found, return chunk, delimiter included " - read := fs upTo: $X delimiterIsTerminator: true. - self assert: (read size = 3000). - self assert: ((read at: 1) = $b). - fs close. - path asFileEntry delete.! ! +!ClosureTests methodsFor: 'testing' stamp: 'cwp 11/16/2009 08:11'! +testCopyNonLocalReturn + self + shouldnt: [self methodWithNonLocalReturn] + raise: Error! ! -!ReferenceStreamTest methodsFor: 'testing' stamp: 'jmv 9/25/2012 22:42'! -testDiskProxy +!ClosureTests methodsFor: 'testing' stamp: 'jmv 7/3/2019 09:38:17'! +testIsTrivialClosure " - ReferenceStreamTest new testDiskProxy + ClosureTests new testIsTrivialClosure " - | newInstance oldInstance | - self flag: #jmvVer2. - oldInstance _ { Smalltalk . Display . Morph}. - newInstance _ ReferenceStream unStream: (ReferenceStream streamedRepresentationOf: oldInstance). - 1 to: oldInstance size do: [ :i | - self assert: (newInstance at: i) == (oldInstance at: i) ]! ! + | tempVar | + tempVar _ 1. + self assert: [ 3 + 4 ] isCleanClosure. + self assert: [ :a | a * 2 ] isCleanClosure. + self assert: [ Smalltalk size ] isCleanClosure. + self assert: [ ClosureTests selectors size ] isCleanClosure. + self assert: [ :blockArg | blockArg printString ] isCleanClosure. + self assert: [ | blockTemp | blockTemp printString ] isCleanClosure. + self assert: [ | blockTemp | blockTemp _ 7 ] isCleanClosure. + self assert: [ | c | c _ [ :a :b | a+b ]. c value: 3 value: 4 ] isCleanClosure. -!ReferenceStreamTest methodsFor: 'testing' stamp: 'jmv 12/6/2011 08:19'! -testSortedCollection - " - ReferenceStreamTest new testSortedCollection - " - | newInstance oldInstance | - oldInstance _ SortedCollection sortBlock: [ :a :b | a printString < b printString ]. - oldInstance add: 'hi'; add: 'there'; add: 'you'; add: 'all'. - newInstance _ ReferenceStream unStream: (ReferenceStream streamedRepresentationOf: oldInstance). - self assert: newInstance asArray = oldInstance asArray! ! + self assert: [ | outerBlockTemp | [ outerBlockTemp printString ] ] isCleanClosure. + self assert: [ | outerBlockTemp | [ outerBlockTemp _ 7 ] ] isCleanClosure. + self assert: [ | outerBlockTemp | [[ outerBlockTemp printString ]] ] isCleanClosure. + self assert: [ | outerBlockTemp | [[ outerBlockTemp _ 7 ]] ] isCleanClosure. + self assert: [ [| outerBlockTemp | [ outerBlockTemp printString ]] ] isCleanClosure. + self assert: [ [| outerBlockTemp | [ outerBlockTemp _ 7 ]] ] isCleanClosure. -!ReferenceStreamTest methodsFor: 'testing' stamp: 'jmv 8/21/2012 17:02'! -testWeakDumps - "Test that if we serialize a model with weak references to views, only the model is serialized and not the views. - - Note: The bug became apparent only when dumping a model to a SmartRefStream, that calls #references, and the serialized stream - was later materialized in an image where the view classes had been deleted. In such rare cases, materialization would fail when trying to reference these - absent classes. If serializing to a ReferenceStream, the bug didn't become apparent (views were never serialized). If serializing to a SmartRefStream, but - view classes still existed, the bug didn't really become apparent (because views were not actually deserialized), the only effect was a larger file. - - ReferenceStreamTest new testWeakDumps - " - | oldInstance window refStream | - oldInstance _ TextModel withText: 'This is a text'. - window _ SystemWindow editText: oldInstance label: 'old instance' wrap: true. - refStream _ ReferenceStream on: (DummyStream on: nil). - refStream nextPut: oldInstance. - self deny: (refStream references keys anySatisfy: [ :dumpedObject | dumpedObject isKindOf: Morph ]). - window delete! ! + self deny: [ | outerBlockTemp | [ outerBlockTemp printString ] isCleanClosure ] value. + self deny: [ | outerBlockTemp | [ outerBlockTemp _ 7 ] isCleanClosure ] value. + self deny: [ | outerBlockTemp | [[ outerBlockTemp printString ]] isCleanClosure ] value. + self deny: [ | outerBlockTemp | [[ outerBlockTemp _ 7 ]] isCleanClosure ] value. -!SmartRefStreamTest methodsFor: 'testing' stamp: 'jmv 9/25/2012 22:42'! -testDiskProxy - " - SmartRefStreamTest new testDiskProxy - " - | newInstance oldInstance | - self flag: #jmvVer2. - oldInstance _ { Smalltalk . Display . Morph}. - newInstance _ SmartRefStream unStream: (SmartRefStream streamedRepresentationOf: oldInstance). - 1 to: oldInstance size do: [ :i | - self assert: (newInstance at: i) == (oldInstance at: i) ]! ! + self deny: [ tempVar + 1 ] isCleanClosure. + self deny: [ tempVar _ 1 ] isCleanClosure. + self deny: [ ivar + 1 ] isCleanClosure. + self deny: [ ivar _ 1 ] isCleanClosure. + self deny: [ ^ true ] isCleanClosure. + self deny: [ self printString ] isCleanClosure. + self deny: [ ^ self ] isCleanClosure. + self deny: [ ClassVar + 1 ] isCleanClosure. + self deny: [ ClassVar _ 1 ] isCleanClosure! ! -!SmartRefStreamTest methodsFor: 'testing' stamp: 'jmv 12/6/2011 08:34'! -testSortedCollection - " - SmartRefStreamTest new testSortedCollection - " - | newInstance oldInstance | - oldInstance _ SortedCollection sortBlock: [ :a :b | a printString < b printString ]. - oldInstance add: 'hi'; add: 'there'; add: 'you'; add: 'all'. - newInstance _ SmartRefStream unStream: (SmartRefStream streamedRepresentationOf: oldInstance). - self assert: newInstance asArray = oldInstance asArray! ! +!ClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:36'! +testMethodArgument + | temp block | + temp := 0. + block := [ [ temp ] ]. + temp := 1. + block := block value. + temp := 2. + self assert: block value = 2! ! -!SmartRefStreamTest methodsFor: 'testing' stamp: 'jmv 8/21/2012 17:00'! -testWeakDumps - "Test that if we serialize a model with weak references to views, only the model is serialized and not the views. - - Note: The bug became apparent only when dumping a model to a SmartRefStream, that calls #references, and the serialized stream - was later materialized in an image where the view classes had been deleted. In such rare cases, materialization would fail when trying to reference these - absent classes. If serializing to a ReferenceStream, the bug didn't become apparent (views were never serialized). If serializing to a SmartRefStream, but - view classes still existed, the bug didn't really become apparent (because views were not actually deserialized), the only effect was a larger file. - - SmartRefStreamTest new testWeakDumps - " - | oldInstance window refStream | - oldInstance _ TextModel withText: 'This is a text'. - window _ SystemWindow editText: oldInstance label: 'old instance' wrap: true. - refStream _ SmartRefStream on: (DummyStream on: nil). - refStream nextPut: oldInstance. - self deny: (refStream references keys anySatisfy: [ :dumpedObject | dumpedObject isKindOf: Morph ]). - window delete! ! +!ClosureTests methodsFor: 'testing' stamp: 'lr 3/11/2009 17:36'! +testMethodTemp + | block1 block2 | + block1 := self methodArgument: 1. + block2 := self methodArgument: 2. + self assert: block1 value = 1. + self assert: block2 value = 2! ! -!BitBltTest methodsFor: 'bugs' stamp: 'jmv 3/11/2010 08:40'! -testAllAlphasRgbAdd - "self run: #testAllAlphasRgbAdd" - | sourceForm destForm blt correctAlphas | - correctAlphas _ 0. - 0 to: 255 do: [:sourceAlpha | - sourceForm _ Form extent: 1 @ 1 depth: 32. - sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. - 0 to: 255 do: [:destAlpha | - destForm _ Form extent: 1 @ 1 depth: 32. - destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. - blt _ BitBlt new. - blt sourceForm: sourceForm. - blt sourceOrigin: 0 @ 0. - blt setDestForm: destForm. - blt destOrigin: 0 @ 0. - blt combinationRule: 20. "rgbAdd" - blt copyBits. - correctAlphas _ correctAlphas - + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha + sourceAlpha min: 255) - ifTrue: [1] - ifFalse: [0]) - ]]. - self assert: correctAlphas = 65536 description: 'Some incorrect alpha values computed for BitBlt rule rgbAdd'! ! - -!BitBltTest methodsFor: 'bugs' stamp: 'jmv 3/11/2010 08:40'! -testAllAlphasRgbMax - "self run: #testAllAlphasRgbMax" - | sourceForm destForm blt correctAlphas | - correctAlphas _ 0. - 0 to: 255 do: [:sourceAlpha | - sourceForm _ Form extent: 1 @ 1 depth: 32. - sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. - 0 to: 255 do: [:destAlpha | - destForm _ Form extent: 1 @ 1 depth: 32. - destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. - blt _ BitBlt new. - blt sourceForm: sourceForm. - blt sourceOrigin: 0 @ 0. - blt setDestForm: destForm. - blt destOrigin: 0 @ 0. - blt combinationRule: 27. "rgbMax" - blt copyBits. - correctAlphas _ correctAlphas - + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha max: sourceAlpha) - ifTrue: [1] - ifFalse: [0]) - ]]. - self assert: correctAlphas = 65536 description: 'Some incorrect alpha values computed for BitBlt rule rgbMax'! ! +!ClosureTests methodsFor: 'running' stamp: 'lr 3/9/2009 16:48'! +setUp + super setUp. + collection := OrderedCollection new! ! -!BitBltTest methodsFor: 'bugs' stamp: 'jmv 3/11/2010 08:40'! -testAllAlphasRgbMin - "self run: #testAllAlphasRgbMin" - | sourceForm destForm blt correctAlphas | - correctAlphas _ 0. - 0 to: 255 do: [:sourceAlpha | - sourceForm _ Form extent: 1 @ 1 depth: 32. - sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. - 0 to: 255 do: [:destAlpha | - destForm _ Form extent: 1 @ 1 depth: 32. - destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. - blt _ BitBlt new. - blt sourceForm: sourceForm. - blt sourceOrigin: 0 @ 0. - blt setDestForm: destForm. - blt destOrigin: 0 @ 0. - blt combinationRule: 28. "rgbMin" - blt copyBits. - correctAlphas _ correctAlphas - + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha min: sourceAlpha) - ifTrue: [1] - ifFalse: [0]) - ]]. - self assert: correctAlphas = 65536 description: 'Some incorrect alpha values computed for BitBlt rule rgbMin'! ! +!ClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'! +testToDoArgument + 1 to: 5 do: [ :index | + collection add: [ index ] ]. + self assertValues: #(1 2 3 4 5)! ! -!BitBltTest methodsFor: 'bugs' stamp: 'jmv 3/11/2010 08:39'! -testAllAlphasRgbMinInvert - "self run: #testAllAlphasRgbMinInvert" - | sourceForm destForm blt correctAlphas | - correctAlphas _ 0. - 0 to: 255 do: [:sourceAlpha | - sourceForm _ Form extent: 1 @ 1 depth: 32. - sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. - 0 to: 255 do: [:destAlpha | - destForm _ Form extent: 1 @ 1 depth: 32. - destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. - blt _ BitBlt new. - blt sourceForm: sourceForm. - blt sourceOrigin: 0 @ 0. - blt setDestForm: destForm. - blt destOrigin: 0 @ 0. - blt combinationRule: 29. "rgbMinInvert" - blt copyBits. - correctAlphas _ correctAlphas - + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha min: 255-sourceAlpha) - ifTrue: [1] - ifFalse: [0]) - ]]. - self assert: correctAlphas = 65536 description: 'Some incorrect alpha values computed for BitBlt rule rgbMinInvert'! ! +!ClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'! +testToDoArgumentNotInlined + | block | + block := [ :index | + collection add: [ index ] ]. + 1 to: 5 do: block. + self assertValues: #(1 2 3 4 5)! ! -!BitBltTest methodsFor: 'bugs' stamp: 'jmv 3/11/2010 08:39'! -testAllAlphasRgbMul - "self run: #testAllAlphasRgbMul" - | sourceForm destForm blt correctAlphas | - correctAlphas _ 0. - 0 to: 255 do: [:sourceAlpha | - sourceForm _ Form extent: 1 @ 1 depth: 32. - sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. - 0 to: 255 do: [:destAlpha | - destForm _ Form extent: 1 @ 1 depth: 32. - destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. - blt _ BitBlt new. - blt sourceForm: sourceForm. - blt sourceOrigin: 0 @ 0. - blt setDestForm: destForm. - blt destOrigin: 0 @ 0. - blt combinationRule: 37. "rgbMul" - blt copyBits. - correctAlphas _ correctAlphas - + (((blt destForm bits at: 1) digitAt: 4) = ((destAlpha+1) * (sourceAlpha+1)- 1 // 256) - ifTrue: [1] - ifFalse: [0]) - ]]. - self assert: correctAlphas = 65536 description: 'Some incorrect alpha values computed for BitBlt rule rgbMul'! ! +!ClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'! +testToDoInsideTemp + 1 to: 5 do: [ :index | + | temp | + temp := index. + collection add: [ temp ] ]. + self assertValues: #(1 2 3 4 5)! ! -!BitBltTest methodsFor: 'bugs' stamp: 'jmv 3/11/2010 08:39'! -testAllAlphasRgbSub - "self run: #testAllAlphasRgbSub" - | sourceForm destForm blt correctAlphas | - correctAlphas _ 0. - 0 to: 255 do: [:sourceAlpha | - sourceForm _ Form extent: 1 @ 1 depth: 32. - sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. - 0 to: 255 do: [:destAlpha | - destForm _ Form extent: 1 @ 1 depth: 32. - destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. - blt _ BitBlt new. - blt sourceForm: sourceForm. - blt sourceOrigin: 0 @ 0. - blt setDestForm: destForm. - blt destOrigin: 0 @ 0. - blt combinationRule: 21. "rgbSub" - blt copyBits. - correctAlphas _ correctAlphas - + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha - sourceAlpha) abs - ifTrue: [1] - ifFalse: [0]) - ]]. - self assert: correctAlphas = 65536 description: 'Some incorrect alpha values computed for BitBlt rule rgbSub'! ! +!ClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'! +testToDoInsideTempNotInlined + | block | + block := [ :index | + | temp | + temp := index. + collection add: [ temp ] ]. + 1 to: 5 do: block. + self assertValues: #(1 2 3 4 5)! ! -!BitBltTest methodsFor: 'bugs' stamp: 'jmv 7/12/2015 22:27'! -testAlphaCompositing - " - BitBltTest new testAlphaCompositing - " +!ClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'! +testToDoOutsideTemp + | temp | + 1 to: 5 do: [ :index | + temp := index. + collection add: [ temp ] ]. + self assertValues: #(5 5 5 5 5)! ! - | bb f1 f2 mixColor result eps | - f1 := Form extent: 1@1 depth: 32. - f2 := Form extent: 1@1 depth: 32. - eps := 0.5 / 255. - 0 to: 255 do:[:i| - f1 colorAt: 0@0 put: (Color r: 0 g: 0 b: 1). - mixColor := Color r: 1 g: 0 b: 0 alpha: i / 255.0. - f2 colorAt: 0@0 put: mixColor. - mixColor := f2 colorAt: 0@0. - bb := BitBlt toForm: f1. - bb sourceForm: f2. - bb combinationRule: Form blend. - bb copyBits. - result := f1 colorAt: 0@0. - self assert: (result red - mixColor alpha) abs < eps. - self assert: (result blue - (1.0 - mixColor alpha)) abs < eps. - self assert: result alpha = 1.0. - ].! ! +!ClosureTests methodsFor: 'testing-todo' stamp: 'lr 3/10/2009 14:51'! +testToDoOutsideTempNotInlined + | block temp | + block := [ :index | + temp := index. + collection add: [ temp ] ]. + 1 to: 5 do: block. + self assertValues: #(5 5 5 5 5)! ! -!BitBltTest methodsFor: 'bugs' stamp: 'jmv 7/12/2015 22:27'! -testAlphaCompositing2 - " - BitBltTest new testAlphaCompositing2 - " +!ClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:29'! +testWhileModificationAfter + | index | + index := 0. + [ index < 5 ] whileTrue: [ + collection add: [ index ]. + index := index + 1 ]. + self assertValues: #(5 5 5 5 5)! ! - | bb f1 f2 mixColor result eps | - f1 := Form extent: 1@1 depth: 32. - f2 := Form extent: 1@1 depth: 32. - eps := 0.5 / 255. - 0 to: 255 do:[:i| - f1 colorAt: 0@0 put: Color transparent. - mixColor := Color r: 1 g: 0 b: 0 alpha: i / 255.0. - f2 colorAt: 0@0 put: mixColor. - mixColor := f2 colorAt: 0@0. - bb := BitBlt toForm: f1. - bb sourceForm: f2. - bb combinationRule: Form blend. - bb copyBits. - result := f1 colorAt: 0@0. - self assert: (result red - mixColor alpha) abs < eps. - self assert: result alpha = mixColor alpha. - ].! ! +!ClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:29'! +testWhileModificationAfterNotInlined + | index block | + index := 0. + block := [ + collection add: [ index ]. + index := index + 1 ]. + [ index < 5 ] whileTrue: block. + self assertValues: #(5 5 5 5 5)! ! -!AffineTransformationTest methodsFor: 'testing' stamp: 'jmv 1/14/2015 15:11'! -testComposition - " - AffineTransformationTest new testComposition - " - | composition inner outer | +!ClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:29'! +testWhileModificationBefore + | index | + index := 0. + [ index < 5 ] whileTrue: [ + index := index + 1. + collection add: [ index ] ]. + self assertValues: #(5 5 5 5 5)! ! - outer _ AffineTransformation withTranslation: 3@5. - inner _ AffineTransformation withRadians: 0.3. - composition _ outer composedWith: inner. - self assert: composition translation = outer translation. - self assert: (outer externalizePosition: (inner externalizePosition: 3@4)) = (composition externalizePosition: 3@4). - self assert: (outer externalizeDelta: (inner externalizeDelta: 3@4)) = (composition externalizeDelta: 3@4). - self assert: (outer externalizeScalar: (inner externalizeScalar: 7)) = (composition externalizeScalar: 7). - self assert: (inner internalizePosition: (outer internalizePosition: 3@4)) = (composition internalizePosition: 3@4). - self assert: (inner internalizeDelta: (outer internalizeDelta: 3@4)) = (composition internalizeDelta: 3@4). - self assert: (inner internalizeScalar: (outer internalizeScalar: 7)) = (composition internalizeScalar: 7). +!ClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:29'! +testWhileModificationBeforeNotInlined + | index block | + index := 0. + block := [ + index := index + 1. + collection add: [ index ] ]. + [ index < 5 ] whileTrue: block. + self assertValues: #(5 5 5 5 5)! ! +!ClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:52'! +testWhileWithTemp + | index | + index := 0. + [ index < 5 ] whileTrue: [ + | temp | + temp := index := index + 1. + collection add: [ temp ] ]. + self assertValues: #(1 2 3 4 5)! ! - outer _ AffineTransformation withRadians: 0.3. - inner _ AffineTransformation withTranslation: 3@5. - composition _ outer composedWith: inner. - self assert: composition radians = outer radians. - self assert: ((outer externalizePosition: (inner externalizePosition: 3@4)) - (composition externalizePosition: 3@4)) r < 0.0001. - self assert: (outer externalizeDelta: (inner externalizeDelta: 3@4)) = (composition externalizeDelta: 3@4). - self assert: (outer externalizeScalar: (inner externalizeScalar: 7)) = (composition externalizeScalar: 7). - self assert: ((inner internalizePosition: (outer internalizePosition: 3@4)) - (composition internalizePosition: 3@4)) r < 0.0001. - self assert: (inner internalizeDelta: (outer internalizeDelta: 3@4)) = (composition internalizeDelta: 3@4). - self assert: (inner internalizeScalar: (outer internalizeScalar: 7)) = (composition internalizeScalar: 7).! ! +!ClosureTests methodsFor: 'testing-while' stamp: 'lr 3/10/2009 14:53'! +testWhileWithTempNotInlined + | index block | + index := 0. + block := [ + | temp | + temp := index := index + 1. + collection add: [ temp ] ]. + [ index < 5 ] whileTrue: block. + self assertValues: #(1 2 3 4 5)! ! -!AffineTransformationTest methodsFor: 'testing' stamp: 'len 5/9/2022 17:57:24'! -testDisplayBounds - " - AffineTransformationTest new testDisplayBounds - " - self assert: ((AffineTransformation withRadians: 0.3) externalBoundingRectOf: (10@10 extent: 20@30)) - encompassingIntegerRectangle = (-3@12 corner: 26@48). - self assert: (AffineTransformation new externalBoundingRectOf: (-2@ 2 extent: 10@10)) - encompassingIntegerRectangle = (-2@2 corner: 8@12). - self assert: (AffineTransformation new externalBoundingRectOf: (-12@ 12 extent: 10@10)) - encompassingIntegerRectangle = (-12@12 corner: -2@22). - self assert: ((AffineTransformation withTranslation: 2) externalBoundingRectOf: (-4@ 2 extent: 10@10)) - encompassingIntegerRectangle = (-2@4 corner: 8@14). - self assert: ((AffineTransformation withTranslation: -4) externalBoundingRectOf: (2@ 2 extent: 10@10)) - encompassingIntegerRectangle = (-2@ -2 corner: 8@8). - self assert: ((AffineTransformation withTranslation: 2) externalBoundingRectOf: (-14@ 2 extent: 10@10)) - encompassingIntegerRectangle = (-12@4 corner: -2@14). - self assert: ((AffineTransformation withTranslation: 4) externalBoundingRectOf: (-12@ 2 extent: 10@10)) - encompassingIntegerRectangle = (-8@6 corner: 2@16). - self assert: ((AffineTransformation withTranslation: -4) externalBoundingRectOf: (12@ 2 extent: 10@10)) - encompassingIntegerRectangle = (8 @ -2 corner: 18@8). - self assert: ((AffineTransformation withTranslation: -2) externalBoundingRectOf: (4@ 2 extent: 10@10)) - encompassingIntegerRectangle = (2@0 corner: 12@10). - self assert: ((AffineTransformation withTranslation: 4) externalBoundingRectOf: (-2@ 2 extent: 10@10)) - encompassingIntegerRectangle = (2@6 corner: 12@16).! ! +!ContextCompilationTest methodsFor: 'tests' stamp: 'eem 6/19/2008 10:11'! +testVariablesAndOffsetsDo -!AffineTransformationTest methodsFor: 'testing' stamp: 'len 5/9/2022 17:56:56'! -testFloatInverseTransform - " - AffineTransformationTest new testFloatInverseTransform - " - self assert: (AffineTransformation new inverseTransform: (-2@ 2)) = (-2@2). - self assert: ((AffineTransformation withTranslation: 2) inverseTransform: (-4@ 2)) = (-6@0). - self assert: ((AffineTransformation withTranslation: 4) inverseTransform: (-2@ 2)) = (-6@ -2). - self assert: ((AffineTransformation withTranslation: -2) inverseTransform: (4@ 2)) = (6@4). - self assert: ((AffineTransformation withTranslation: -4) inverseTransform: (2@ 2)) = (6@6)! ! + "ContextCompilationTest new testVariablesAndOffsetsDo" + | contextClasses | + contextClasses := ContextPart withAllSuperclasses, ContextPart allSubclasses asArray. + contextClasses do: + [:class| + class variablesAndOffsetsDo: + [:var :offset| + self assert: offset < 0. + self assert: (class instVarNameForIndex: offset negated) == var]]. -!AffineTransformationTest methodsFor: 'testing' stamp: 'len 5/9/2022 17:57:03'! -testFloatTransform - " - AffineTransformationTest new testFloatTransform - " - self assert: (AffineTransformation new transform: (-2@ 2)) = (-2@2). - self assert: ((AffineTransformation withTranslation: 2) transform: (-4@ 2)) = (-2@4). - self assert: ((AffineTransformation withTranslation: 4) transform: (-2@ 2)) = (2@6). - self assert: ((AffineTransformation withTranslation: -2) transform: (4@ 2)) = (2@0). - self assert: ((AffineTransformation withTranslation: -4) transform: (2@ 2)) = (-2@ -2)! ! + InstructionStream withAllSuperclasses, InstructionStream allSubclasses asArray do: + [:class| + (contextClasses includes: class) ifFalse: + [class variablesAndOffsetsDo: + [:var :offset| + (InstructionStream instVarNames includes: var) ifFalse: + [self assert: offset > 0. + self assert: (class instVarNameForIndex: offset) == var]]]]! ! -!AffineTransformationTest methodsFor: 'testing' stamp: 'jmv 1/14/2015 15:12'! -testInverseTransformation - " - AffineTransformationTest new testInverseTransformation - " - | forward inverse | +!DecompilerTests methodsFor: 'utilities' stamp: 'sd 9/25/2004 15:30'! +blockingClasses - forward _ AffineTransformation withTranslation: 3@5. - inverse _ forward inverseTransformation. + + ^ #(CompiledMethod)! ! + +!DecompilerTests methodsFor: 'utilities' stamp: 'jmv 9/24/2020 16:56:42'! +checkDecompileMethod: oldMethod - self assert: inverse translation = forward translation negated. - self assert: (inverse externalizePosition: 3@4) = (forward internalizePosition: 3@4). - self assert: (inverse externalizeDelta: 3@4) = (forward internalizeDelta: 3@4). - self assert: (inverse externalizeScalar: 7) = (forward internalizeScalar: 7). - self assert: (inverse internalizePosition: 3@4) = (forward externalizePosition: 3@4). - self assert: (inverse internalizeDelta: 3@4) = (forward externalizeDelta: 3@4). - self assert: (inverse internalizeScalar: 7) = (forward externalizeScalar: 7). + | cls selector oldMethodNode methodNode newMethod oldCodeString newCodeString | + cls _ oldMethod methodClass. + selector := oldMethod selector. + oldMethodNode _ Decompiler new + decompile: selector + in: cls + method: oldMethod. + [oldMethodNode properties includesKey: #warning] + whileTrue: [oldMethodNode properties removeKey: #warning]. + oldCodeString _ oldMethodNode decompileString. + methodNode _ [ Compiler new + compile: oldCodeString + in: cls + notifying: nil + ifFail: nil] + on: SyntaxErrorNotification + do: [ :ex | + ex errorMessage = 'Cannot store into' + ifTrue: [ex return: #badStore]. + ex pass ]. + "Ignore cannot store into block arg errors; they're not our issue." + methodNode ~~ #badStore ifTrue: [ + newMethod _ methodNode generate: #(0 0 0 0). + newCodeString := (Decompiler new + decompile: selector + in: cls + method: newMethod) decompileString. + "Decompiler might move temp declarations (keeping valid, equivalent code) and therefore affect the temp numbering. + Make temp numbering cannonical in decompiler code, to avoid bogus failures" + oldCodeString _ self withFixedTempNumbering: oldCodeString. + newCodeString _ self withFixedTempNumbering: newCodeString. + "(DifferenceFinder displayPatchFrom: oldCodeString to: newCodeString tryWords: true) + editLabel: 'Decompilation Differences for ', cls name,'>>',selector." + "(DifferenceFinder displayPatchFrom: oldMethod abstractSymbolic to: newMethod abstractSymbolic tryWords: true) + editLabel: 'Bytecode Differences for ', cls name,'>>',selector." + self assert: oldCodeString = newCodeString + description: cls name asString, ' ', selector asString + resumable: true ]! ! +!DecompilerTests methodsFor: 'utilities' stamp: 'jmv 5/27/2015 13:58'! +decompileClassesSelect: aBlock + | cls | + (Smalltalk classNames select: aBlock) do: [ :cn | + cls _ Smalltalk at: cn. + cls selectorsAndMethodsDo: [ :selector :meth | + self checkDecompileMethod: meth ]]! ! - forward _ AffineTransformation withRadians: 0.25. - inverse _ forward inverseTransformation. +!DecompilerTests methodsFor: 'utilities' stamp: 'jmv 6/1/2021 14:00:00'! +withFixedTempNumbering: aString + | k code newCode tempStart startAt | + code _ aString. + `{'argm'. 'temp'}` with: `{'arg'. 'tmp'}` do: [ :a :b | + k _ 1. + startAt _ 1. + [tempStart _ code findString: a startingAt: startAt. tempStart > 0] whileTrue: [ | end | + end _ tempStart. [end <= code size and: [(code at: end) tokenish]] whileTrue: [end _ end + 1]. end _ end-1. + newCode _ code copyReplaceTokens: (code copyFrom: tempStart to: end) with: b, k printString. + code = newCode ifTrue: [startAt _ tempStart + 1]. + code _ newCode. + k _ k + 1 ]]. + ^code! ! - self assert: inverse radians = forward radians negated. - self assert: ((inverse externalizePosition: 3@4) - (forward internalizePosition: 3@4)) r < 0.0001. - self assert: ((inverse externalizeDelta: 3@4) - (forward internalizeDelta: 3@4)) r < 0.0001. - self assert: ((inverse externalizeScalar: 7) - (forward internalizeScalar: 7)) abs < 0.0001. - self assert: ((inverse internalizePosition: 3@4) - (forward externalizePosition: 3@4)) r < 0.0001. - self assert: ((inverse internalizeDelta: 3@4) - (forward externalizeDelta: 3@4)) r < 0.0001. - self assert: ((inverse internalizeScalar: 7) - (forward externalizeScalar: 7)) abs < 0.0001.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesAAtoAM + self decompileClassesSelect: [:cn| cn first = $A and: [cn second asUppercase <= $M]]! ! -!LayoutMorphTest methodsFor: 'tests' stamp: 'jmv 5/23/2022 11:29:37'! -testLayout1 - " - self new testLayout1 - " - | pane row1 row2 row3 r1c1 r1c2 r1c3 r1c4 r1c5 r2c1 r2c2 r2c3 r3c1 r3c2 r3c3 | - pane _ LayoutMorph newColumn separation: 5. - pane color: Color red. - row1 _ LayoutMorph newRow separation: 5. - row1 color: Color red; - addMorph: (r1c1 _ BoxedMorph new color: (Color h: 60 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec fixedWidth: 10); - addMorph: (r1c2 _ BoxedMorph new color: Color blue) - layoutSpec: (LayoutSpec proportionalWidth: 0.8); - addMorph: (r1c3 _ BoxedMorph new color: (Color h: 30 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec proportionalWidth: 0.4); - addMorph: (r1c4 _ BoxedMorph new color: (Color h: 30 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec proportionalWidth: 0.15); - addMorph: (r1c5 _ BoxedMorph new color: (Color h: 60 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec fixedWidth: 20 fixedHeight: 20). - pane addMorph: row1 layoutSpec: LayoutSpec useAll. - row2 _ LayoutMorph newRow separation: 5. - row2 color: Color red; - addMorph: (r2c1 _ BoxedMorph new color: Color blue) - layoutSpec: (LayoutSpec proportionalWidth: 0.8); - addMorph: (r2c2 _ BoxedMorph new color: (Color h: 30 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec proportionalWidth: 0.4); - addMorph: (r2c3 _ BoxedMorph new color: (Color h: 30 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec proportionalWidth: 0.2). - pane addMorph: row2 layoutSpec: LayoutSpec useAll. - row3 _ LayoutMorph newRow separation: 5. - row3 color: Color red; - addMorph: (r3c1 _ BoxedMorph new color: (Color h: 120 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec fixedWidth: 20 proportionalHeight: 0.8); - addMorph: (r3c2 _ BoxedMorph new color: (Color h: 90 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec proportionalWidth: 0.5 fixedHeight: 40); - addMorph: (r3c3 _ BoxedMorph new color: (Color h: 150 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec fixedWidth: 30 proportionalHeight: 1.0). - pane addMorph: row3 layoutSpec: (LayoutSpec fixedHeight: 60). - pane openInWorld: UISupervisor ui; morphExtent: 408@300. - Processor activeProcess animatedUI - ifNotNil: [ :ui | ui doOneCycleNow] - ifNil: [ | updated | - updated _ false. - UISupervisor whenUIinSafeState: [ updated _ true ]. - [updated] whileFalse: [ - Processor yield ]]. +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesANtoAZ + self decompileClassesSelect: [:cn| cn first = $A and: [cn second asUppercase > $M]]! ! - self assert: row1 morphWidth = (pane morphWidth - 10). - self assert: r1c1 morphWidth = 10. - self assert: r1c2 morphWidth rounded = 200. - self assert: r1c3 morphWidth rounded = (r1c2 morphWidth / 0.8 * 0.4) rounded. - self assert: r1c4 morphWidth rounded = (r1c2 morphWidth / 0.8 * 0.15) rounded. - self assert: r1c5 morphWidth = 20. - self assert: r1c1 morphHeight = (row1 morphHeight - 10). - self assert: r1c2 morphHeight = (row1 morphHeight - 10). - self assert: r1c3 morphHeight = (row1 morphHeight - 10). - self assert: r1c4 morphHeight = (row1 morphHeight - 10). - self assert: r1c5 morphHeight = 20. +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:57:20'! +testDecompilerInClassesBAtoBM - self assert: row2 morphWidth = (pane morphWidth - 10). - self assert: r2c1 morphWidth rounded = 216. - self assert: r2c2 morphWidth rounded = 108. - self assert: r2c3 morphWidth rounded = 54. - self assert: r2c1 morphHeight = (row2 morphHeight - 10). - self assert: r2c2 morphHeight = (row2 morphHeight - 10). - self assert: r2c3 morphHeight = (row2 morphHeight - 10). + self decompileClassesSelect: [:cn| cn first = $B and: [cn second asUppercase <= $M]]! ! - self assert: row3 morphWidth = (pane morphWidth - 10). - self assert: r3c1 morphWidth = 20. - self assert: r3c2 morphWidth = (row3 morphWidth - 10 - 20 - 10 - 30 * 0.5) rounded. - self assert: r3c3 morphWidth = 30. - self assert: row3 morphHeight = 60. - self assert: r3c1 morphHeight = 40. - self assert: r3c2 morphHeight = 40. - self assert: r3c3 morphHeight = 50. +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:57:44'! +testDecompilerInClassesBNtoBZ - pane delete! ! + self decompileClassesSelect: [:cn| cn first = $B and: [cn second asUppercase > $M]]! ! -!LayoutMorphTest methodsFor: 'tests' stamp: 'jmv 5/23/2022 11:29:45'! -testLayout2 - " - self new testLayout2 - " - | pane row c1 c2 c3 | - pane _ LayoutMorph newColumn separation: 5. - pane color: Color red. - row _ LayoutMorph newRow separation: 5. - row - color: (Color h: 270 s: 0.2 v: 0.6); - addMorph: (c1 _ BoxedMorph new color: (Color h: 120 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec fixedWidth: 20 proportionalHeight: 0.8 offAxisEdgeWeight: #rowBottom); - addMorph: (c2 _ BoxedMorph new color: (Color h: 90 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec proportionalWidth: 0.8 fixedHeight: 40 offAxisEdgeWeight: #rowTop); - addMorph: (c3 _ BoxedMorph new color: (Color h: 150 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec fixedWidth: 30 proportionalHeight: 0.7 offAxisEdgeWeight: #center). - pane addMorph: row layoutSpec: (LayoutSpec proportionalHeight: 0.9). - pane openInWorld: UISupervisor ui; morphExtent: 400@300. - Processor activeProcess animatedUI - ifNotNil: [ :ui | ui doOneCycleNow] - ifNil: [ | updated | - updated _ false. - UISupervisor whenUIinSafeState: [ updated _ true ]. - [updated] whileFalse: [ - Processor yield ]]. +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:57:51'! +testDecompilerInClassesCAtoCM - self assert: row morphWidth = (pane morphWidth - 10). - self assert: row morphHeight = 261. - self assert: c1 displayBounds bottom = (row displayBounds bottom - 5) description: 'Should be at bottom'. - self assert: c1 morphWidth = 20. - self assert: c1 morphHeight = 200.8. - self assert: c2 displayBounds top = (row displayBounds top + 5) description: 'Should be at top'. - self assert: c2 morphWidth = 256. - self assert: c2 morphHeight = 40. - self assert: ((c3 displayBounds top - row displayBounds top) - (row displayBounds bottom - c3 displayBounds bottom)) abs < 2 description: 'Should be centered'. - self assert: c3 morphWidth = 30. - self assert: c3 morphHeight rounded = 176. + self decompileClassesSelect: [:cn| cn first = $C and: [cn second asUppercase <= $M]]! ! - pane delete! ! +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:57:58'! +testDecompilerInClassesCNtoCZ -!LayoutMorphTest methodsFor: 'tests' stamp: 'jmv 5/23/2022 11:29:28'! -testLayout3 - " - self new testLayout3 - " - | pane row innerRow i1 i2 i3 c2 c3 | - pane _ LayoutMorph newColumn separation: 5. - pane color: Color red. - row _ LayoutMorph newRow separation: 5. - innerRow _ LayoutMorph newRow color: Color red; separation: 5. - innerRow - addMorph: (i1 _ BoxedMorph new) - layoutSpec: (LayoutSpec fixedWidth: 10 fixedHeight: 10); - addMorph: (i2 _ BoxedMorph new) - layoutSpec: (LayoutSpec fixedWidth: 10 fixedHeight: 10); - addMorph: (i3 _ BoxedMorph new) - layoutSpec: (LayoutSpec proportionalWidth: 1.0 fixedHeight: 10). - row - color: (Color h: 270 s: 0.2 v: 0.6); - addMorph: innerRow - layoutSpec: (LayoutSpec proportionalWidth: 0.5 fixedHeight: 30 offAxisEdgeWeight: #center); - addMorph: (c2 _ BoxedMorph new color: (Color h: 90 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec proportionalWidth: 0.5 fixedHeight: 40 offAxisEdgeWeight: #rowTop); - addMorph: (c3 _ BoxedMorph new color: (Color h: 150 s: 0.6 v: 0.6)) - layoutSpec: (LayoutSpec fixedWidth: 30 proportionalHeight: 1.0). - pane addMorph: row layoutSpec: (LayoutSpec fixedHeight: 200). - pane openInWorld: UISupervisor ui; morphExtent: 400@300. - Processor activeProcess animatedUI - ifNotNil: [ :ui | ui doOneCycleNow] - ifNil: [ | updated | - updated _ false. - UISupervisor whenUIinSafeState: [ updated _ true ]. - [updated] whileFalse: [ - Processor yield ]]. + self decompileClassesSelect: [:cn| cn first = $C and: [cn second asUppercase > $M]]! ! - self assert: row displayBounds left = (pane displayBounds left + 5). - self assert: row morphWidth = (pane morphWidth - 10). - self assert: row morphHeight = 200. - self assert: innerRow displayBounds left = (row displayBounds left + 5). - self assert: (innerRow displayBounds top - row displayBounds top) = (row displayBounds bottom - innerRow displayBounds bottom) description: 'Should be centered'. - self assert: innerRow morphWidth = 170. - self assert: innerRow morphHeight = 30. +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:06'! +testDecompilerInClassesDAtoDM - self assert: i1 displayBounds left = (innerRow displayBounds left + 5). - self assert: (i1 displayBounds top - innerRow displayBounds top) = (innerRow displayBounds bottom - i1 displayBounds bottom) description: 'Should be centered'. - self assert: i1 morphWidth = 10. - self assert: i1 morphHeight = 10. - self assert: i2 displayBounds left = (innerRow displayBounds left + 20). - self assert: (i2 displayBounds top - innerRow displayBounds top) = (innerRow displayBounds bottom - i2 displayBounds bottom) description: 'Should be centered'. - self assert: i2 morphWidth = 10. - self assert: i2 morphHeight = 10. - self assert: i3 displayBounds left = (innerRow displayBounds left + 35). - self assert: (i3 displayBounds top - innerRow displayBounds top) = (innerRow displayBounds bottom - i3 displayBounds bottom) description: 'Should be centered'. - self assert: i3 morphWidth = (innerRow morphWidth - 40). - self assert: i3 morphHeight = 10. + self decompileClassesSelect: [:cn| cn first = $D and: [cn second asUppercase <= $M]]! ! - self assert: c2 displayBounds top = (row displayBounds top + 5) description: 'Should be at top'. - self assert: c2 morphWidth = 170. - self assert: c2 morphHeight = 40. - self assert: (c3 displayBounds top - row displayBounds top) = (row displayBounds bottom - c3 displayBounds bottom) description: 'Should be centered'. - self assert: c3 morphWidth = 30. - self assert: c3 morphHeight = (row morphHeight - 10). +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:13'! +testDecompilerInClassesDNtoDZ - pane delete! ! + self decompileClassesSelect: [:cn| cn first = $D and: [cn second asUppercase > $M]]! ! -!MorphicLocationTest methodsFor: 'testing' stamp: 'jmv 1/14/2015 14:32'! -testComposition - " - MorphicLocationTest new testComposition - " - | composition inner outer | +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesEAtoEM + self decompileClassesSelect: [:cn| cn first = $E and: [cn second asUppercase <= $M]]! ! - outer _ MorphicTranslation withTranslation: 3@5. - inner _ AffineTransformation withRadians: 0.3. - composition _ outer composedWith: inner. - self assert: composition translation = outer translation. - self assert: (outer externalizePosition: (inner externalizePosition: 3@4)) = (composition externalizePosition: 3@4). - self assert: (outer externalizeDelta: (inner externalizeDelta: 3@4)) = (composition externalizeDelta: 3@4). - self assert: (outer externalizeScalar: (inner externalizeScalar: 7)) = (composition externalizeScalar: 7). - self assert: (inner internalizePosition: (outer internalizePosition: 3@4)) = (composition internalizePosition: 3@4). - self assert: (inner internalizeDelta: (outer internalizeDelta: 3@4)) = (composition internalizeDelta: 3@4). - self assert: (inner internalizeScalar: (outer internalizeScalar: 7)) = (composition internalizeScalar: 7). +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesENtoEZ + self decompileClassesSelect: [:cn| cn first = $E and: [cn second asUppercase > $M]]! ! +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:22'! +testDecompilerInClassesFAtoFM - outer _ AffineTransformation withRadians: 0.3. - inner _ MorphicTranslation withTranslation: 3@5. - composition _ outer composedWith: inner. - self assert: composition radians = outer radians. - self assert: ((outer externalizePosition: (inner externalizePosition: 3@4)) - (composition externalizePosition: 3@4)) r < 0.0001. - self assert: (outer externalizeDelta: (inner externalizeDelta: 3@4)) = (composition externalizeDelta: 3@4). - self assert: (outer externalizeScalar: (inner externalizeScalar: 7)) = (composition externalizeScalar: 7). - self assert: ((inner internalizePosition: (outer internalizePosition: 3@4)) - (composition internalizePosition: 3@4)) r < 0.0001. - self assert: (inner internalizeDelta: (outer internalizeDelta: 3@4)) = (composition internalizeDelta: 3@4). - self assert: (inner internalizeScalar: (outer internalizeScalar: 7)) = (composition internalizeScalar: 7).! ! + self decompileClassesSelect: [:cn| cn first = $F and: [cn second asUppercase <= $M]]! ! -!MorphicTranslationTest methodsFor: 'testing' stamp: 'jmv 1/12/2015 15:46'! -testComposition - " - MorphicTranslationTest new testComposition - " - | composition inner outer | +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesFNtoFZ + self decompileClassesSelect: [:cn| cn first = $F and: [cn second asUppercase > $M]]! ! - outer _ MorphicTranslation withTranslation: 3@5. - inner _ MorphicTranslation withTranslation: -1@2. - composition _ outer composedWith: inner. - self assert: composition translation = (outer translation + inner translation). - self assert: (outer externalizePosition: (inner externalizePosition: 3@4)) = (composition externalizePosition: 3@4). - self assert: (outer externalizeDelta: (inner externalizeDelta: 3@4)) = (composition externalizeDelta: 3@4). - self assert: (outer externalizeScalar: (inner externalizeScalar: 7)) = (composition externalizeScalar: 7). - self assert: (inner internalizePosition: (outer internalizePosition: 3@4)) = (composition internalizePosition: 3@4). - self assert: (inner internalizeDelta: (outer internalizeDelta: 3@4)) = (composition internalizeDelta: 3@4). - self assert: (inner internalizeScalar: (outer internalizeScalar: 7)) = (composition internalizeScalar: 7). +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesGAtoGM + self decompileClassesSelect: [:cn| cn first = $G and: [cn second asUppercase <= $M]]! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesGNtoGZ + self decompileClassesSelect: [:cn| cn first = $G and: [cn second asUppercase > $M]]! ! - outer _ MorphicTranslation withTranslation: -1@2. - inner _ MorphicTranslation withTranslation: 3@5. - composition _ outer composedWith: inner. - self assert: composition radians = outer radians. - self assert: (outer externalizePosition: (inner externalizePosition: 3@4)) = (composition externalizePosition: 3@4). - self assert: (outer externalizeDelta: (inner externalizeDelta: 3@4)) = (composition externalizeDelta: 3@4). - self assert: (outer externalizeScalar: (inner externalizeScalar: 7)) = (composition externalizeScalar: 7). - self assert: (inner internalizePosition: (outer internalizePosition: 3@4)) = (composition internalizePosition: 3@4). - self assert: (inner internalizeDelta: (outer internalizeDelta: 3@4)) = (composition internalizeDelta: 3@4). - self assert: (inner internalizeScalar: (outer internalizeScalar: 7)) = (composition internalizeScalar: 7).! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesHAtoHM + self decompileClassesSelect: [:cn| cn first = $H and: [cn second asUppercase <= $M]]! ! -!MorphicTranslationTest methodsFor: 'testing' stamp: 'len 5/9/2022 17:57:28'! -testDisplayBounds - " - MorphicTranslationTest new testDisplayBounds - " +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesHNtoHZ + self decompileClassesSelect: [:cn| cn first = $H and: [cn second asUppercase > $M]]! ! - self assert: (MorphicTranslation new externalBoundingRectOf: (-2@ 2 extent: 10@10)) - encompassingIntegerRectangle = (-2@2 corner: 8@12). - self assert: (MorphicTranslation new externalBoundingRectOf: (-12@ 12 extent: 10@10)) - encompassingIntegerRectangle = (-12@12 corner: -2@22). - self assert: ((MorphicTranslation withTranslation: 2) externalBoundingRectOf: (-4@ 2 extent: 10@10)) - encompassingIntegerRectangle = (-2@4 corner: 8@14). - self assert: ((MorphicTranslation withTranslation: -4) externalBoundingRectOf: (2@ 2 extent: 10@10)) - encompassingIntegerRectangle = (-2@ -2 corner: 8@8). - self assert: ((MorphicTranslation withTranslation: 2) externalBoundingRectOf: (-14@ 2 extent: 10@10)) - encompassingIntegerRectangle = (-12@4 corner: -2@14). - self assert: ((MorphicTranslation withTranslation: 4) externalBoundingRectOf: (-12@ 2 extent: 10@10)) - encompassingIntegerRectangle = (-8@6 corner: 2@16). - self assert: ((MorphicTranslation withTranslation: -4) externalBoundingRectOf: (12@ 2 extent: 10@10)) - encompassingIntegerRectangle = (8@ -2 corner: 18@8). - self assert: ((MorphicTranslation withTranslation: -2) externalBoundingRectOf: (4@ 2 extent: 10@10)) - encompassingIntegerRectangle = (2@0 corner: 12@10). - self assert: ((MorphicTranslation withTranslation: 4) externalBoundingRectOf: (-2@ 2 extent: 10@10)) - encompassingIntegerRectangle = (2@6 corner: 12@16).! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesIAtoIM + self decompileClassesSelect: [:cn| cn first = $I and: [cn second asUppercase <= $M]]! ! -!MorphicTranslationTest methodsFor: 'testing' stamp: 'len 5/9/2022 17:57:12'! -testInverseTransform - " - MorphicTranslationTest new testInverseTransform - " - self assert: (MorphicTranslation new inverseTransform: (-2@ 2)) = (-2@2). - self assert: ((MorphicTranslation withTranslation: 2) inverseTransform: (-4@ 2)) = (-6@0). - self assert: ((MorphicTranslation withTranslation: 4) inverseTransform: (-2@ 2)) = (-6@ -2). - self assert: ((MorphicTranslation withTranslation: -2) inverseTransform: (4@ 2)) = (6@4). - self assert: ((MorphicTranslation withTranslation: -4) inverseTransform: (2@ 2)) = (6@6)! ! +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:28'! +testDecompilerInClassesINtoIZ -!MorphicTranslationTest methodsFor: 'testing' stamp: 'jmv 1/12/2015 15:46'! -testInverseTransformation - " - MorphicTranslationTest new testInverseTransformation - " - | forward inverse | + self decompileClassesSelect: [:cn| cn first = $I and: [cn second asUppercase > $M]]! ! - forward _ MorphicTranslation withTranslation: 3@5. - inverse _ forward inverseTransformation. - - self assert: inverse translation = forward translation negated. - self assert: (inverse externalizePosition: 3@4) = (forward internalizePosition: 3@4). - self assert: (inverse externalizeDelta: 3@4) = (forward internalizeDelta: 3@4). - self assert: (inverse externalizeScalar: 7) = (forward internalizeScalar: 7). - self assert: (inverse internalizePosition: 3@4) = (forward externalizePosition: 3@4). - self assert: (inverse internalizeDelta: 3@4) = (forward externalizeDelta: 3@4). - self assert: (inverse internalizeScalar: 7) = (forward externalizeScalar: 7)! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesJAtoJM + self decompileClassesSelect: [:cn| cn first = $J and: [cn second asUppercase <= $M]]! ! -!MorphicTranslationTest methodsFor: 'testing' stamp: 'len 5/9/2022 17:57:17'! -testTransform - " - MorphicTranslationTest new testTransform - " - self assert: (MorphicTranslation new transform: (-2@ 2)) = (-2@2). - self assert: ((MorphicTranslation withTranslation: 2) transform: (-4@ 2)) = (-2@4). - self assert: ((MorphicTranslation withTranslation: 4) transform: (-2@ 2)) = (2@6). - self assert: ((MorphicTranslation withTranslation: -2) transform: (4@ 2)) = (2@0). - self assert: ((MorphicTranslation withTranslation: -4) transform: (2@ 2)) = (-2@ -2)! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesJNtoJZ + self decompileClassesSelect: [:cn| cn first = $J and: [cn second asUppercase > $M]]! ! -!WorldTest methodsFor: 'tests' stamp: 'jmv 10/24/2020 15:58:12'! -testDoOneCycleWorksWithDeferredQueue - "Ensure that nested doOneCycles don't break deferred UI messages" - | finished | - [ - UISupervisor whenUIinSafeState:[ UISupervisor ui doOneCycleNow ]. - UISupervisor whenUIinSafeState: nil "whatever". - UISupervisor ui doOneCycleNow. - finished _ true. - ] valueWithin: 1 seconds onTimeout: [finished _ false ]. - self assert: finished! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesKAtoKM + self decompileClassesSelect: [:cn| cn first = $K and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'testing' stamp: 'jmv 7/14/2011 14:26'! -testMessages - " - SmalltalkCompleterTest new testMessages - " - | fromSmalltalk fromUCompleter | - fromSmalltalk _ Smalltalk allImplementedMessages. - fromUCompleter _ Symbol allInstances select: [ :s | - SmalltalkCompleter isThereAnImplementorOf: s]. - self assert: fromSmalltalk = fromUCompleter asSet! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesKNtoKZ + self decompileClassesSelect: [:cn| cn first = $K and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 20:56:42'! -test000_AutocompletesMessagesFor_GlobalVariables_WithSelectorsFromTheirClasses - - self - assertEntriesWhenBrowsing: 'm1 SmalltalkCompleterTest ' - areSelectorsOf: SmalltalkCompleterTest class. - - self - assertEntriesWhenBrowsing: 'm1 1 < SmalltalkCompleterTest ' - areUnaryAndBinarySelectorsOf: SmalltalkCompleterTest class. - ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:37'! +testDecompilerInClassesLAtoLM -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:01:49'! -test001_AutocompletesMessagesFor_Self_WithSelectorsFromTheBrowsedClass - - self - assertEntriesWhenBrowsing: 'm1 self ' - areSelectorsOf: SmalltalkCompleterTest. - - self - assertEntriesWhenBrowsing: 'm1 1 < self ' - areUnaryAndBinarySelectorsOf: SmalltalkCompleterTest.! ! + self decompileClassesSelect: [:cn| cn first = $L and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:02:19'! -test002_AutocompletesMessagesFor_Super_WithSelectorsFromTheBrowsedClass - - self - assertEntriesWhenBrowsing: 'm1 super ' - areSelectorsOf: TestCase. - - self - assertEntriesWhenBrowsing: 'm1 1 < super ' - areUnaryAndBinarySelectorsOf: TestCase.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesLNtoLZ + self decompileClassesSelect: [:cn| cn first = $L and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:02:43'! -test003_AutocompletesMessagesFor_Super_WithSelectorsForUnknownClassesWhenTheBrowsedClassDoesNotHaveASuperclass - - self browseClass: ProtoObject. - - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 super '. - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 1 < super '.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:51'! +testDecompilerInClassesMAtoMM -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:11:29'! -test004_AutocompletesMessagesFor_True_WithSelectorsFromTrue - - self - assertEntriesWhenBrowsing: 'm1 true ' - areSelectorsOf: True. - - self - assertEntriesWhenBrowsing: 'm1 1 < true ' - areUnaryAndBinarySelectorsOf: True. ! ! + self decompileClassesSelect: [:cn| cn first = $M and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:12:17'! -test005_AutocompletesMessagesFor_False_WithSelectorsFromFalse - - self - assertEntriesWhenBrowsing: 'm1 false ' - areSelectorsOf: False. - - self - assertEntriesWhenBrowsing: 'm1 1 < false ' - areUnaryAndBinarySelectorsOf: False. ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesMNtoMZ + self decompileClassesSelect: [:cn| cn first = $M and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:12:12'! -test006_AutocompletesMessagesFor_Nil_WithSelectorsFromUndefinedObject - - self - assertEntriesWhenBrowsing: 'm1 nil ' - areSelectorsOf: UndefinedObject. - - self - assertEntriesWhenBrowsing: 'm1 1 < nil ' - areUnaryAndBinarySelectorsOf: UndefinedObject. ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesNAtoNM + self decompileClassesSelect: [:cn| cn first = $N and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:36:47'! -test007_AutocompletesMessagesFor_Characters_WithSelectorsFromCharacter - - self - assertEntriesWhenBrowsing: 'm1 $a ' - areSelectorsOf: Character. - - self - assertEntriesWhenBrowsing: 'm1 1 < $a ' - areUnaryAndBinarySelectorsOf: Character. ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesNNtoNZ + self decompileClassesSelect: [:cn| cn first = $N and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:15:01'! -test008_AutocompletesMessagesFor_Numbers_WithSelectorsFromTheirClass - - self - assertEntriesWhenBrowsing: 'm1 1 ' - areSelectorsOf: SmallInteger. - - self - assertEntriesWhenBrowsing: 'm1 1 < 1 ' - areUnaryAndBinarySelectorsOf: SmallInteger. ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:58:57'! +testDecompilerInClassesOAtoOM -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:15:25'! -test009_AutocompletesMessagesFor_Strings_WithSelectorsFromString - - self - assertEntriesWhenBrowsing: 'm1 ''a'' ' - areSelectorsOf: String. - - self - assertEntriesWhenBrowsing: 'm1 1 < ''a'' ' - areUnaryAndBinarySelectorsOf: String. ! ! + self decompileClassesSelect: [:cn| cn first = $O and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:37:45'! -test010_AutocompletesMessagesFor_Symbols_WithSelectorsFromSymbol - - self - assertEntriesWhenBrowsing: 'm1 #a ' - areSelectorsOf: Symbol. - - self - assertEntriesWhenBrowsing: 'm1 1 < #a ' - areUnaryAndBinarySelectorsOf: Symbol. ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesONtoOZ + self decompileClassesSelect: [:cn| cn first = $O and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:38:21'! -test011_AutocompletesMessagesFor_StringSymbol_WithSelectorsFromSymbol - - self - assertEntriesWhenBrowsing: 'm1 #''a'' ' - areSelectorsOf: Symbol. - - self - assertEntriesWhenBrowsing: 'm1 1 < #''a'' ' - areUnaryAndBinarySelectorsOf: Symbol. ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesPAtoPM + self decompileClassesSelect: [:cn| cn first = $P and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:42:33'! -test012_AutocompletesMessagesFor_InstanceVariables - - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 instanceVariable1 '. - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 1 + instanceVariable1 '.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesPNtoPZ + self decompileClassesSelect: [:cn| cn first = $P and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 16:42:09'! -test013_AutocompletesMessagesFor_MethodArguments_WithSelectorsForUnknownClasses - - "I reference to SmalltalkCompleterTest directly and not thru 'self class' becuase this test has subclasses - the #m1: and #m2: are defined in SmalltalkCompleterTest - Hernan" - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsingMethodWith: SmalltalkCompleterTest >> #m1:. - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsingMethodWith: SmalltalkCompleterTest >> #m2: ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesQAtoQM + self decompileClassesSelect: [:cn| cn first = $Q and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:22:39'! -test014_AutocompletesMessagesFor_TemporaryVariables_WithSelectorsForUnknownClasses - - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 |a| a '. - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 |a| 1 + a '. ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesQNtoQZ + self decompileClassesSelect: [:cn| cn first = $Q and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:25:42'! -test015_AutocompletesMessagesFor_BlockArguments_WithSelectorsForUnknownClasses - - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 [ :a | a '. - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 [ :a | 1 + a '. ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:59:04'! +testDecompilerInClassesRAtoRM -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 22:04:54'! -test016_AutocompletesMessagesFor_BlockTemporaryVariables_WithSelectorsForUnknownClasses - - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 [ | a | a '. - - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 [ | a | 1 + a '. ! ! + self decompileClassesSelect: [:cn| cn first = $R and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'NPM 3/18/2020 18:34:08'! -test017_AutocompletesMessagesFor_NilWorkspaceVariables_WithSelectorsForUnknownClasses - - self - assertEntriesAreSelectorsForUnknownClassesForWorkspaceWith: 'x ' - binding: 'x' - to: nil. - - self - assertEntriesAreSelectorsForUnknownClassesForWorkspaceWith: '1 + x ' - binding: 'x' - to: nil.! ! - -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 22:05:36'! -test017_AutocompletesMessagesFor_NonNilWorkspaceVariables_WithSelectorsFromTheirClasses - - self - assertEntriesForWorkspaceWith: 'x ' - binding: 'x' - to: 1 - areSelectorsOf: SmallInteger. - - self - assertEntriesForWorkspaceWith: '1 < x ' - binding: 'x' - to: 1 - areUnaryAndBinarySelectorsOf: SmallInteger.! ! - -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:27:14'! -test018_AutocompletesMessagesFor_ThisContext_WithSelectorsFromMethodContext - - self - assertEntriesWhenBrowsing: 'm1 thisContext ' - areSelectorsOf: MethodContext. - - self - assertEntriesWhenBrowsing: 'm1 1 < thisContext ' - areUnaryAndBinarySelectorsOf: MethodContext. ! ! - -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:27:39'! -test019_AutocompletesMessagesFor_ClassVariables_WithSelectorsFromTheirClasses - - ClassVariableForTesting _ 1. - - self - assertEntriesWhenBrowsing: 'm1 ClassVariableForTesting ' - areSelectorsOf: SmallInteger. - - self - assertEntriesWhenBrowsing: 'm1 1 < ClassVariableForTesting ' - areUnaryAndBinarySelectorsOf: SmallInteger. ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesRNtoRZ + self decompileClassesSelect: [:cn| cn first = $R and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:28:01'! -test020_AutocompletesMessagesFor_PoolConstants_WithSelectorsFromTheirClasses - - poolDictionaryForTesting at: #X put: 1. - - self - assertEntriesWhenBrowsing: 'm1 X ' - areSelectorsOf: SmallInteger. - - self - assertEntriesWhenBrowsing: 'm1 1 < X ' - areUnaryAndBinarySelectorsOf: SmallInteger.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:59:11'! +testDecompilerInClassesSAtoSM -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:39:25'! -test021_AutocompletesMessagesFor_BlockEndings_WithSelectorsFromBlockClosure - - self - assertEntriesWhenBrowsing: 'm1 [] ' - areSelectorsOf: BlockClosure. - - self - assertEntriesWhenBrowsing: 'm1 1 < [] ' - areUnaryAndBinarySelectorsOf: BlockClosure. ! ! + self decompileClassesSelect: [:cn| cn first = $S and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:39:55'! -test022_AutocompletesMessagesFor_ArrayEnds_WithSelectorsFromArray - - self - assertEntriesWhenBrowsing: 'm1 #() ' - areSelectorsOf: Array. - - self - assertEntriesWhenBrowsing: 'm1 1 < #() ' - areUnaryAndBinarySelectorsOf: Array. ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:59:18'! +testDecompilerInClassesSNtoSZ -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:04:04'! -test023_AutocompletesMessagesFor_RightBraces_WithSelectorsFromArray - - self - assertEntriesWhenBrowsing: 'm1 {} ' - areSelectorsOf: Array. - - self - assertEntriesWhenBrowsing: 'm1 1 < {} ' - areUnaryAndBinarySelectorsOf: Array. ! ! + self decompileClassesSelect: [:cn| cn first = $S and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:43:31'! -test023_AutocompletingMessagesFor_UnaryMessages - - self denyComputingEntriesIsSupportedWhenBrowsing: 'm1 self class '. - - self denyComputingEntriesIsSupportedWhenBrowsing: 'm1 1 < self class '. ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:59:24'! +testDecompilerInClassesTAtoTM -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:44:50'! -test024_AutocompletingMessagesFor_RightParenthesis - - self denyComputingEntriesIsSupportedWhenBrowsing: 'm1 (1) '. - - self denyComputingEntriesIsSupportedWhenBrowsing: 'm1 1 < (1) '.! ! + self decompileClassesSelect: [:cn| cn first = $T and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 02:08:24'! -test025_AutocompletesMessagesFor_UnknownIdentifiers_WithSelectorsForUnknownClasses - - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 Foo1234 '. - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 foo1234 '.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesTNtoTZ + self decompileClassesSelect: [:cn| cn first = $T and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:45:10'! -test026_AutocompletingMessagesFor_Cascade - - self denyComputingEntriesIsSupportedWhenBrowsing: 'm1 self class; '. - ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesUAtoUM + self decompileClassesSelect: [:cn| cn first = $U and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:13:19'! -test027_AutocompletesEntriesFor_GlobalVariables_WithIdentifiersBegginingWithThem - - self - assertEntriesWhenBrowsing: 'm1 SmalltalkCompleterTes' - areIdentifiersBeginningWith: 'SmalltalkCompleterTest'. - ! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesUNtoUZ + self decompileClassesSelect: [:cn| cn first = $U and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:14:50'! -test028_AutocompletesEntriesFor_PoolConstants_WithIdentifiersBegginingWithThem - - poolDictionaryForTesting at: #X put: 1. - - self - assertEntriesWhenBrowsing: 'm1 X' - areIdentifiersBeginningWith: 'X'.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:59:30'! +testDecompilerInClassesVAtoVM -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'NPM 3/18/2020 19:56:46'! -test029_AutocompletesEntriesFor_WorkspaceVariables_WithIdentifiersBegginingWithThem - - | completer | - completer := self - autocompleteEntriesForWorkspaceWith: 'x' - binding: 'x' - to: 1. - - self - assertEntriesOf: completer - areIdentifiersBeginningWith: 'x'.! ! + self decompileClassesSelect: [:cn| cn first = $V and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:15:11'! -test030_AutocompletesEntriesFor_ClassVariables_WithIdentifiersBegginingWithThem - - ClassVariableForTesting _ 1. - - self - assertEntriesWhenBrowsing: 'm1 ClassVariableForTestin' - areIdentifiersBeginningWith: 'ClassVariableForTesting'.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesVNtoVZ + self decompileClassesSelect: [:cn| cn first = $V and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:15:28'! -test031_AutocompletesEntriesFor_InstanceVariables_WithIdentifiersBegginingWithThem - - self - assertEntriesWhenBrowsing: 'm1 instanceVariable' - areIdentifiersBeginningWith: 'instanceVariable1'.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 9/24/2020 16:59:36'! +testDecompilerInClassesWAtoWM -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:36:46'! -test032_AutocompletesEntriesFor_MethodArguments_WithIdentifiersBegginingWithThem - - | completer | - - completer := self autocompleteEntriesBrowsingMethod: SmalltalkCompleterTest >> #m3:. - - self - assert: completer - analizedSelectorsFrom: nil - canShowDocumentation: false - detectedPossibleInvalidSelector: #() - suggested: (completer computeIdentifierEntriesBeginningWith: 'arg1').! ! + self decompileClassesSelect: [:cn| cn first = $W and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:15:54'! -test033_AutocompletesEntriesFor_TemporaryVariables_WithIdentifiersBegginingWithThem - - self - assertEntriesWhenBrowsing: 'm1 |xx| x' - areIdentifiersBeginningWith: 'xx'.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesWNtoWZ + self decompileClassesSelect: [:cn| cn first = $W and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:16:11'! -test034_AutocompletesEntriesFor_BlockArguments_WithIdentifiersBegginingWithThem - - self - assertEntriesWhenBrowsing: 'm1 [ :xx | x' - areIdentifiersBeginningWith: 'xx'.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesXAtoXM + self decompileClassesSelect: [:cn| cn first = $X and: [cn second asUppercase <= $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:16:27'! -test035_AutocompletesEntriesFor_BlockTemporaryVariables_WithIdentifiersBegginingWithThem - - self - assertEntriesWhenBrowsing: 'm1 [ | xx | x' - areIdentifiersBeginningWith: 'xx'.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesXNtoXZ + self decompileClassesSelect: [:cn| cn first = $X and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:16:43'! -test036_AutocompletesEntriesFor_IncompleteIdentifiers_WithIdentifiersBegginingWithThem +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesYAtoYM + self decompileClassesSelect: [:cn| cn first = $Y and: [cn second asUppercase <= $M]]! ! - self - assertEntriesWhenBrowsing: 'm1 Obj' - areIdentifiersBeginningWith: 'Obj'.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesYNtoYZ + self decompileClassesSelect: [:cn| cn first = $Y and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:17:34'! -test037_AutocompletesEntriesFor_ReservedNames_WithIdentifiersBegginingWithThem +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesZAtoZM + self decompileClassesSelect: [:cn| cn first = $Z and: [cn second asUppercase <= $M]]! ! - self assertEntriesWhenBrowsing: 'm1 self' areIdentifiersBeginningWith: 'self'. - self assertEntriesWhenBrowsing: 'm1 supe' areIdentifiersBeginningWith: 'super'. - self assertEntriesWhenBrowsing: 'm1 tru' areIdentifiersBeginningWith: 'true'. - self assertEntriesWhenBrowsing: 'm1 fals' areIdentifiersBeginningWith: 'false'. - self assertEntriesWhenBrowsing: 'm1 ni' areIdentifiersBeginningWith: 'nil'. - self assertEntriesWhenBrowsing: 'm1 thisContex' areIdentifiersBeginningWith: 'thisContext'.! ! +!DecompilerTests methodsFor: 'tests' stamp: 'eem 9/23/2008 11:16'! +testDecompilerInClassesZNtoZZ + self decompileClassesSelect: [:cn| cn first = $Z and: [cn second asUppercase > $M]]! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'NPM 3/18/2020 19:15:44'! -test038_DoesNotAutocompleteEntriesFor_UndefinedIdentifiers +!DecompilerTests methodsFor: 'tests' stamp: 'jmv 12/28/2013 19:04'! +testRemoteTemp + | aBlock | + aBlock := Compiler evaluate: '| x y | [:a :b | x := a. y := b. x+y]'. + self shouldnt: [aBlock decompile] raise: Error + ! ! - | completer | - completer := self createCompleterForBrowsing: 'a'. +!DecompilerTestFailuresCollector methodsFor: 'accessing' stamp: 'HAW 3/17/2019 07:26:22'! +assert: aBoolean description: aString resumable: resumableBoolean - completer computeEntries. + aBoolean ifFalse: [ + failures ifNil: [ failures := OrderedCollection new]. + failures addLast: (thisContext sender tempAt: 1) methodReference]. - self denyHasEntries: completer ! ! + ^super assert: aBoolean description: aString resumable: resumableBoolean +! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:18:55'! -test039_AutocompletesEntriesFor_BinaryMessages_WithIdentifiersBegginingWithThem +!DecompilerTestFailuresCollector methodsFor: 'accessing' stamp: 'eem 11/10/2008 15:47'! +failures + ^failures! ! - self - assertEntriesWhenBrowsing: 'm1 1 ~=' - areSelectorsOf: SmallInteger - beginningWith: '~='! ! +!MirrorPrimitiveTests methodsFor: 'tests' stamp: 'jmv 12/28/2013 19:06'! +testMirrorAt + | stackpBefore stackpAfter array byteArray | -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:19:17'! -test040_AutocompletesEntriesFor_IncompleteBinaryMessages_WithIdentifiersBegginingWithThem + Smalltalk isRunningCog ifFalse: [ + ^self assert: false description: 'Needs Cog' ]. - self - assertEntriesWhenBrowsing: 'm1 1 ~' - areSelectorsOf: SmallInteger - beginningWith: '~'! ! + stackpBefore := thisContext stackPtr. + array := { 1. 2. 3 }. + byteArray := ByteArray with: 1 with: 2 with: 3. + self assert: (thisContext object: array basicAt: 1) = 1. + self assert: (thisContext object: byteArray basicAt: 2) = 2. + thisContext object: array basicAt: 2 put: #two. + self assert: array = #(1 #two 3). + thisContext object: byteArray basicAt: 2 put: 222. + self assert: byteArray asArray = #(1 222 3). + stackpAfter := thisContext stackPtr. + self assert: stackpBefore = stackpAfter. "Make sure primitives pop all their arguments" + self should: [thisContext object: array basicAt: 4] raise: Error. + self should: [thisContext object: byteArray basicAt: 0] raise: Error. + self should: [thisContext object: byteArray basicAt: 1 put: -1] raise: Error! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:19:42'! -test041_AutocompletesEntriesFor_UnaryMessages_WithIdentifiersBegginingWithThem +!MirrorPrimitiveTests methodsFor: 'tests' stamp: 'eem 4/8/2009 19:44'! +testMirrorClass + | stackpBefore stackpAfter | + stackpBefore := thisContext stackPtr. + self assert: (thisContext objectClass: Array new) = Array. + self assert: (thisContext objectClass: 1) = 1 class. + self assert: (thisContext objectClass: ProtoObject new) = ProtoObject. + stackpAfter := thisContext stackPtr. + self assert: stackpBefore = stackpAfter "Make sure primitives pop all their arguments"! ! - self - assertEntriesWhenBrowsing: 'm1 1 not' - areSelectorsOf: SmallInteger - beginningWith: 'not'! ! +!MirrorPrimitiveTests methodsFor: 'tests' stamp: 'jmv 12/28/2013 19:06'! +testMirrorEqEq + | stackpBefore stackpAfter | -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:19:53'! -test042_AutocompletesEntriesFor_IncompleteUnaryMessages_WithIdentifiersBegginingWithThem + Smalltalk isRunningCog ifFalse: [ + ^self assert: false description: 'Needs Cog' ]. - self - assertEntriesWhenBrowsing: 'm1 1 no' - areSelectorsOf: SmallInteger - beginningWith: 'no'! ! + stackpBefore := thisContext stackPtr. + self assert: (thisContext object: Array new eqeq: Array new) == false. + self assert: (thisContext object: Array eqeq: Array) == true. + stackpAfter := thisContext stackPtr. + self assert: stackpBefore = stackpAfter "Make sure primitives pop all their arguments"! ! -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:20:03'! -test043_AutocompletesEntriesFor_KeywordMessages_WithIdentifiersBegginingWithThem +!MirrorPrimitiveTests methodsFor: 'tests' stamp: 'jmv 12/28/2013 19:06'! +testMirrorInstVarAt + | stackpBefore stackpAfter array point | - self - assertEntriesWhenBrowsing: 'm1 1 at:' - areSelectorsOf: SmallInteger - beginningWith: 'at:'! ! + Smalltalk isRunningCog ifFalse: [ + ^self assert: false description: 'Needs Cog' ]. -!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:18:26'! -test044_AutocompletesEntriesFor_IncompleteKeywordMessages_WithIdentifiersBegginingWithThem + stackpBefore := thisContext stackPtr. + array := { 1. 2. 3 }. + point := Point x: 1 y: 2. + self assert: (thisContext object: array instVarAt: 1) = 1. + self assert: (thisContext object: point instVarAt: 2) = 2. + thisContext object: array instVarAt: 2 put: #two. + self assert: array = #(1 #two 3). + thisContext object: point instVarAt: 1 put: 1/2. + self assert: point = (Point x: 1 / 2 y: 2). + stackpAfter := thisContext stackPtr. + self assert: stackpBefore = stackpAfter. "Make sure primitives pop all their arguments" + self should: [thisContext object: array instVarAt: 4] raise: Error. + self should: [thisContext object: point instVarAt: 3] raise: Error! ! - self - assertEntriesWhenBrowsing: 'm1 self firstKeyword:' - areSelectorsOf: SmalltalkCompleterTest - beginningWith: 'firstKeyword:'.! ! +!MirrorPrimitiveTests methodsFor: 'tests' stamp: 'jmv 12/28/2013 19:06'! +testMirrorPerform + | stackpBefore stackpAfter anInterval | -!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'HAW 1/27/2022 19:32:18'! -createCompleterForBrowsing: sourceCode - - | browser model | - browser := Browser new. - browser setSelectedSystemCategoryTreeItem: (SystemCategoryWrapper with: classToBrowse category name: classToBrowse category model: browser). - browser classListIndex: (browser classList indexOf: classToBrowse name). - - model := (PluggableTextModel on: browser) actualContents: sourceCode. - browser editSelection: #newMethod. + Smalltalk isRunningCog ifFalse: [ + ^self assert: false description: 'Needs Cog' ]. - ^ self createCompleterWith: model.! ! + stackpBefore := thisContext stackPtr. + anInterval := 1 to: 2. + self assert: (thisContext object: anInterval perform:# species withArguments: #() inClass: Interval) == Array. + self assert: (thisContext object: anInterval perform:# species withArguments: #() inClass: Interval superclass) == Interval. + self should: [thisContext object: anInterval perform:# species withArguments: #() inClass: Point] + raise: Error. + self should: [thisContext object: anInterval perform:# species withArguments: OrderedCollection new inClass: Interval] + raise: Error. + stackpAfter := thisContext stackPtr. + self assert: stackpBefore = stackpAfter "Make sure primitives pop all their arguments"! ! -!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'NPM 3/18/2020 19:17:59'! -createCompleterForWorkspaceWith: sourceCode binding: aVariableName to: aValue - - | model | - model := Workspace withText: sourceCode. - (model bindingOf: aVariableName) value: aValue. - - ^ self createCompleterWith: model! ! +!MirrorPrimitiveTests methodsFor: 'tests' stamp: 'jmv 12/28/2013 19:06'! +testMirrorSize + | stackpBefore stackpAfter | -!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'HAW 5/2/2020 13:14:11'! -createCompleterWith: aModel - - ^ (SmalltalkCompleter withModel: aModel) - changePositionTo: aModel actualContents size; - yourself! ! + Smalltalk isRunningCog ifFalse: [ + ^self assert: false description: 'Needs Cog' ]. -!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'HAW 5/2/2020 16:37:44'! -firstKeyword: a secondKeyword: b! ! + stackpBefore := thisContext stackPtr. + self assert: (thisContext objectSize: #(1 2 3)) = 3. + self assert: (thisContext objectSize: '123') = 3. + self assert: (thisContext objectSize: nil) = 0. + self assert: (thisContext objectSize: 1) = 0. + stackpAfter := thisContext stackPtr. + self assert: stackpBefore = stackpAfter. "Make sure primitives pop all their arguments"! ! -!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'HAW 5/2/2020 16:55:18'! -m1: arg1 arg1 ! ! +!ParseNodeEnumeratorTest methodsFor: 'tests about enumeration' stamp: 'RNG 9/27/2020 22:25:05'! +testItEnumeratesAllTheParseNodesPresentInAMethodNode -!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'HAW 5/2/2020 16:37:29'! -m2: arg1 1 + arg1 ! ! + | blockNode enumeratedNodes methodNode enumerator tempVarsDeclarationNode tempVarDeclarationNode literalNode messageNode nodesToBeEnumerated returnNode variableNode | + methodNode := [ Parser parse: 'm1 | arg | ^ arg + 2' class: self class ] + on: SyntaxErrorNotification + do: [ :anError | self fail ]. -!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'HAW 5/2/2020 16:56:16'! -m3: arg1 arg1! ! + enumeratedNodes := Set new. + enumerator := ParseNodeEnumerator ofBlock: [ :parseNode | enumeratedNodes add: parseNode ]. + methodNode accept: enumerator. + blockNode := methodNode block. + tempVarsDeclarationNode := methodNode temporariesDeclaration. + tempVarDeclarationNode := tempVarsDeclarationNode temporaryDeclarationNodes first. + returnNode := blockNode statements first. + messageNode := returnNode expr. + variableNode := messageNode receiver. + literalNode := messageNode arguments first. + nodesToBeEnumerated := { + methodNode . blockNode . tempVarsDeclarationNode . tempVarDeclarationNode. + returnNode . messageNode . variableNode . literalNode. + }. -!SmalltalkCompleterTest methodsFor: 'test support' stamp: 'NPM 3/18/2020 19:13:43'! -autocompleteEntriesBrowsing: sourceCode + self assert: (enumeratedNodes includesAllOf: nodesToBeEnumerated)! ! + +!ParserTest methodsFor: 'test' stamp: 'HAW 2/29/2020 18:09:57'! +testRangesAreOkWhenReturningAVariableWithoutSpaceAfterThat + + | methodNode ranges | - | completer | - completer := self createCompleterForBrowsing: sourceCode. + "See Parser>>#variable" - completer computeEntries. + methodNode := self class methodNodeFor: 'm1 |v| ^v'. - ^ completer! ! - -!SmalltalkCompleterTest methodsFor: 'test support' stamp: 'HAW 5/2/2020 21:51:30'! -autocompleteEntriesBrowsingMethod: aCompiledMethod + ranges := methodNode rangeForNode: methodNode tempNodes first ifAbsent: [ self fail ]. - | completer selector | + self assert: 2 equals: ranges size. + self assert: ranges includes: (5 to: 5). + self assert: ranges includes: (9 to: 9). - selector := aCompiledMethod selector. - completer := self createCompleterForBrowsing: aCompiledMethod sourceCode. - "Not nice, but does it work - Hernan" - completer textProviderOrModel instVarNamed: 'currentCompiledMethod' put: aCompiledMethod. - completer textProviderOrModel selectedMessageName: selector. - completer computeEntries. - ^ completer! ! + ! ! -!SmalltalkCompleterTest methodsFor: 'test support' stamp: 'NPM 3/18/2020 19:07:19'! -autocompleteEntriesForWorkspaceWith: sourceCode binding: aVariableName to: aValue - - | completer | - completer := self - createCompleterForWorkspaceWith: sourceCode - binding: aVariableName - to: aValue. - - completer computeEntries. - - ^ completer! ! +!ParserTest methodsFor: 'temporary variables tests' stamp: 'RNG 3/13/2020 00:39:16'! +testItGeneratesATempDeclarationNodeForEachTempInABlock -!SmalltalkCompleterTest methodsFor: 'test support' stamp: 'NPM 3/18/2020 18:32:34'! -browseClass: aClass + | methodNode blockNode tempsDeclarationNode allTempDeclarationNodes | + methodNode := self class methodNodeFor: 'm1 [ | a b c | 42 ]'. + blockNode := methodNode block statements first. + tempsDeclarationNode := blockNode temporariesDeclaration. + allTempDeclarationNodes := tempsDeclarationNode temporaryDeclarationNodes. - classToBrowse _ aClass.! ! + self + assert: allTempDeclarationNodes size equals: 3; + assert: allTempDeclarationNodes first variableName equals: 'a'; + assert: allTempDeclarationNodes second variableName equals: 'b'; + assert: allTempDeclarationNodes third variableName equals: 'c'.! ! -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 20:21:58'! -assert: aCompleter analizedSelectorsFrom: classes canShowDocumentation: aBoolean detectedPossibleInvalidSelector: selectors suggested: entries - - classes - ifNil: [ self assert: aCompleter selectorsClasses isNil ] - ifNotNil: [ self assert: aCompleter selectorsClasses asSet = classes asSet ]. - self assert: aCompleter canShowSelectorDocumentation equals: aBoolean. - self assert: aCompleter possibleInvalidSelectors asSet = selectors asSet. - entries - ifNil: [ self assert: aCompleter entries isNil ] - ifNotNil: [ self assert: (self entriesToCompareFrom: aCompleter entries) = (self entriesToCompareFrom: entries) ] - - ! ! +!ParserTest methodsFor: 'temporary variables tests' stamp: 'RNG 3/13/2020 00:38:08'! +testItGeneratesATempDeclarationNodeForEachTempInAMethod -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 20:25:15'! -assertEntriesAreSelectorsForUnknownClasses: aCompleter - - | expectedEntries expectedPossibleInvalidSelectors | - expectedPossibleInvalidSelectors _ Set new. - expectedEntries _ aCompleter computeMessageEntriesForUnknowClassAddingPossibleInvalidSelectorsTo: expectedPossibleInvalidSelectors. + | methodNode tempsDeclarationNode allTempDeclarationNodes | + methodNode := self class methodNodeFor: 'm1 | a b c | ^a + b + c'. + tempsDeclarationNode := methodNode temporariesDeclaration. + allTempDeclarationNodes := tempsDeclarationNode temporaryDeclarationNodes. self - assert: aCompleter - analizedSelectorsFrom: #() - canShowDocumentation: true - detectedPossibleInvalidSelector: expectedPossibleInvalidSelectors - suggested: expectedEntries! ! - -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 19:06:02'! -assertEntriesAreSelectorsForUnknownClassesForWorkspaceWith: sourceCode binding: aVariableName to: aValue - - | completer | - completer := self - autocompleteEntriesForWorkspaceWith: sourceCode - binding: aVariableName - to: aValue. - - self assertEntriesAreSelectorsForUnknownClasses: completer.! ! + assert: allTempDeclarationNodes size equals: 3; + assert: allTempDeclarationNodes first variableName equals: 'a'; + assert: allTempDeclarationNodes second variableName equals: 'b'; + assert: allTempDeclarationNodes third variableName equals: 'c'.! ! -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 19:07:53'! -assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: sourceCode - - | completer | - completer := self autocompleteEntriesBrowsing: sourceCode. - - self assertEntriesAreSelectorsForUnknownClasses: completer.! ! +!ParserTest methodsFor: 'temporary variables tests' stamp: 'RNG 3/13/2020 00:34:19'! +testItGeneratesAnEmptyTempsDeclarationNodeForAMethodWithoutTemps -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 21:36:46'! -assertEntriesAreSelectorsOfUnknownClassesWhenBrowsingMethodWith: aCompiledMethod - - | completer | - - completer := self autocompleteEntriesBrowsingMethod: aCompiledMethod. - - self assertEntriesAreSelectorsForUnknownClasses: completer. + | methodNode tempsDeclarationNode | + methodNode := self class methodNodeFor: 'm1 ^42'. + tempsDeclarationNode := methodNode temporariesDeclaration. - ! ! + self assert: tempsDeclarationNode allDeclaredVariableNodes isEmpty.! ! -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 19:08:09'! -assertEntriesForWorkspaceWith: sourceCode binding: aVariableName to: aValue areSelectorsOf: aClass - - | completer | - completer := self - autocompleteEntriesForWorkspaceWith: sourceCode - binding: aVariableName - to: aValue. - - self - assertEntriesOf: completer - areAllSelectorsOf: aClass.! ! +!PrettyPrintingTest methodsFor: 'testing' stamp: 'jmv 4/19/2014 17:39'! +test1 + " + self new test1 + " + | prettyPrinted source | -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 19:19:49'! -assertEntriesForWorkspaceWith: sourceCode binding: aVariableName to: aValue areUnaryAndBinarySelectorsOf: aClass - - | completer | - completer := self - autocompleteEntriesForWorkspaceWith: sourceCode - binding: aVariableName - to: aValue. - - self - assertEntriesOf: completer - areUnaryAndBinarySelectorsOf: aClass.! ! + source _ +'sample1: x + x with: [ + self print. + self print ].'. -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/17/2020 18:27:01'! -assertEntriesOf: aCompleter areAllSelectorsOf: aClass + prettyPrinted _ Compiler format: source in: PrettyPrintingTest notifying: nil. - self - assertEntriesOf: aCompleter - areAllSelectorsOf: aClass - beginningWith: ''! ! + self assert: source equals: prettyPrinted! ! -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 17:38:48'! -assertEntriesOf: aCompleter areAllSelectorsOf: aClass beginningWith: aPrefix +!PrettyPrintingTest methodsFor: 'testing' stamp: 'jmv 4/19/2014 17:39'! +test2 + " + self new test2 + " + | prettyPrinted source | - self assertEntriesOf: aCompleter areAllSelectorsOfAll: { aClass } beginningWith: aPrefix -! ! + source _ +'sample2: x + x + print; + with: [ :a :b :c | | d e f | + self print. + self print. + self do: [ :each | + self print. + self print. + x size + each size ]].'. -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 18:42:55'! -assertEntriesOf: aCompleter areAllSelectorsOfAll: classes beginningWith: aPrefix + prettyPrinted _ Compiler format: source in: PrettyPrintingTest notifying: nil. - | suggested | + self assert: source equals: prettyPrinted! ! - suggested := classes inject: Set new into: [ :suggestedCollector :aClass | - suggestedCollector - addAll: (aCompleter selectorsOf: aClass beginningWith: aPrefix); - yourself ]. - - self - assert: aCompleter - analizedSelectorsFrom: classes - canShowDocumentation: true - detectedPossibleInvalidSelector: #() - suggested: suggested.! ! +!PrettyPrintingTest methodsFor: 'testing' stamp: 'jmv 4/19/2014 17:40'! +test3 + " + self new test3 + " + | prettyPrinted source | -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 20:25:15'! -assertEntriesOf: aCompleter areIdentifiersBeginningWith: aPrefix + source _ +'sample3: x + x + print; + with: [ :a :b :c | + self print. + self print. + self do: [ :each | + self print. + self print. + x size + each size ]].'. - self - assert: aCompleter - analizedSelectorsFrom: nil - canShowDocumentation: false - detectedPossibleInvalidSelector: #() - suggested: (aCompleter computeIdentifierEntriesBeginningWith: aPrefix)! ! + prettyPrinted _ Compiler format: source in: PrettyPrintingTest notifying: nil. -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 20:10:35'! -assertEntriesOf: aCompleter areUnaryAndBinarySelectorsOf: aClass + self assert: source equals: prettyPrinted! ! - self - assert: aCompleter - analizedSelectorsFrom: {aClass} - canShowDocumentation: true - detectedPossibleInvalidSelector: #() - suggested: (self using: aCompleter addUnaryAndBinarySelectorsOf: aClass). - ! ! +!PrettyPrintingTest methodsFor: 'testing' stamp: 'jmv 4/19/2014 17:40'! +test4 + " + self new test4 + " + | prettyPrinted source | -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 19:58:16'! -assertEntriesWhenBrowsing: sourceCode areIdentifiersBeginningWith: aPrefix - - | completer | - completer := self autocompleteEntriesBrowsing: sourceCode. - - self - assertEntriesOf: completer - areIdentifiersBeginningWith: aPrefix.! ! + source _ +'sample4: x + x + print; + with: [ | d e f | + self print. + self print. + self do: [ :each | + self print. + self print. + x size + each size ]].'. -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 18:55:09'! -assertEntriesWhenBrowsing: sourceCode areSelectorsOf: aClass - - self - assertEntriesWhenBrowsing: sourceCode - areSelectorsOf: aClass - beginningWith: ''! ! + prettyPrinted _ Compiler format: source in: PrettyPrintingTest notifying: nil. -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 18:58:41'! -assertEntriesWhenBrowsing: sourceCode areSelectorsOf: aClass beginningWith: aPrefix - - self - assertEntriesOf: (self autocompleteEntriesBrowsing: sourceCode) - areAllSelectorsOf: aClass - beginningWith: aPrefix - ! ! + self assert: source equals: prettyPrinted! ! -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 17:40:10'! -assertEntriesWhenBrowsing: sourceCode areSelectorsOfAll: classes - - self - assertEntriesWhenBrowsing: sourceCode - areSelectorsOfAll: classes - beginningWith: ''! ! +!PrettyPrintingTest methodsFor: 'testing' stamp: 'jmv 4/19/2014 17:41'! +test5 + " + self new test5 + " + | prettyPrinted source | -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 17:41:09'! -assertEntriesWhenBrowsing: sourceCode areSelectorsOfAll: classes beginningWith: aPrefix - - self - assertEntriesOf: (self autocompleteEntriesBrowsing: sourceCode) - areAllSelectorsOfAll: classes - beginningWith: aPrefix - ! ! + source _ +'sample5: x + x + print; + print; + print; + + with: [ + self print. + self print ] + do: [ + self print. + self print ].'. -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 18:59:22'! -assertEntriesWhenBrowsing: sourceCode areUnaryAndBinarySelectorsOf: aClass - - self - assertEntriesOf: (self autocompleteEntriesBrowsing: sourceCode) - areUnaryAndBinarySelectorsOf: aClass. - - ! ! + prettyPrinted _ Compiler format: source in: PrettyPrintingTest notifying: nil. -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 21:33:48'! -assertEntriesWhenBrowsingMethod: aMethod areSelectorsOf: aClass - - self - assertEntriesWhenBrowsingMethod: aMethod - areSelectorsOf: aClass - beginningWith: ''! ! + self assert: source equals: prettyPrinted! ! -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 21:36:46'! -assertEntriesWhenBrowsingMethod: aMethod areSelectorsOf: aClass beginningWith: aPrefix - - self - assertEntriesOf: (self autocompleteEntriesBrowsingMethod: aMethod) - areAllSelectorsOf: aClass - beginningWith: aPrefix - ! ! +!PrettyPrintingTest methodsFor: 'testing' stamp: 'jmv 4/19/2014 17:40'! +test6 + " + self new test6 + " + | prettyPrinted source | -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 21:36:46'! -assertEntriesWhenBrowsingMethod: aMethod areUnaryAndBinarySelectorsOf: aClass + source _ +'sample6: x + x + with: [ + self print. + self print ] + do: [ + self print. + self print ].'. + + prettyPrinted _ Compiler format: source in: PrettyPrintingTest notifying: nil. + + self assert: source equals: prettyPrinted! ! + +!ReturnNodeTest methodsFor: 'tests' stamp: 'HAW 10/19/2020 16:07:48'! +test01isImplicitSelfReturnInReturnsTrueWithMethodWithOutAnySourceCode + + | methodNode returnNode | - self - assertEntriesOf: (self autocompleteEntriesBrowsingMethod: aMethod) - areUnaryAndBinarySelectorsOf: aClass. + methodNode := (self class >> #methodWithImplicitReturn) methodNode. + returnNode := methodNode block statements first. - ! ! + self assert: (returnNode isImplicitSelfReturnIn: methodNode)! ! -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 20:25:15'! -denyComputingEntriesIsSupportedWhenBrowsing: sourceCode +!ReturnNodeTest methodsFor: 'tests' stamp: 'HAW 10/19/2020 16:08:15'! +test02isImplicitSelfReturnInReturnsTrueWithMethodReferencingSelf + + | methodNode returnNode | - | completer | - completer := self createCompleterForBrowsing: sourceCode. + methodNode := (self class >> #methodReferencingSelfWithImplicitReturn) methodNode. + returnNode := self returnNodeOf: methodNode. - self - should: [ completer computeEntries ] - raise: Error. - self - assert: completer - analizedSelectorsFrom: nil - canShowDocumentation: true - detectedPossibleInvalidSelector: #() - suggested: nil.! ! - -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 20:25:15'! -denyHasEntries: aCompleter + self assert: (returnNode isImplicitSelfReturnIn: methodNode)! ! - self - assert: aCompleter - analizedSelectorsFrom: nil - canShowDocumentation: nil - detectedPossibleInvalidSelector: #() - suggested: #()! ! +!ReturnNodeTest methodsFor: 'tests' stamp: 'HAW 10/19/2020 16:09:20'! +test03isImplicitSelfReturnInReturnsFalseWithMethodReturningSelf -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 20:24:54'! -entriesToCompareFrom: aCollectionOfEntries + | methodNode returnNode | + + methodNode := (self class >> #methodWithoutImplicitReturn) methodNode. + returnNode := self returnNodeOf: methodNode. + + self deny: (returnNode isImplicitSelfReturnIn: methodNode)! ! - ^(aCollectionOfEntries reject: [ :anEntry | - anEntry beginsWith: AutoCompleterSelectorsCollector categoryEntryHeader ]) asSet! ! +!ReturnNodeTest methodsFor: 'test data' stamp: 'HAW 10/19/2020 16:06:04'! +methodReferencingSelfWithImplicitReturn -!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 20:10:35'! -using: aCompleter addUnaryAndBinarySelectorsOf: aClass + self yourself + + ! ! - ^ aCompleter unaryAndBinarySelectorsOf: aClass beginningWith: ''! ! +!ReturnNodeTest methodsFor: 'test data' stamp: 'HAW 10/19/2020 16:00:38'! +methodWithImplicitReturn + + ! ! -!SmalltalkCompleterTest methodsFor: 'setUp/tearDown' stamp: 'NPM 3/18/2020 18:32:49'! -setUp +!ReturnNodeTest methodsFor: 'test data' stamp: 'HAW 10/19/2020 16:08:38'! +methodWithoutImplicitReturn + + ^self! ! - super setUp. +!ReturnNodeTest methodsFor: 'test support' stamp: 'HAW 10/19/2020 16:03:45'! +returnNodeOf: methodNode - self browseClass: SmalltalkCompleterTest. + methodNode nodesDo: [:node | node isReturn ifTrue: [^node]]. -! ! + self error: 'No return node found'! ! -!SmalltalkCompleterTest methodsFor: 'running' stamp: 'HAW 5/2/2020 20:49:50'! -performTest +!ScannerTest methodsFor: 'testing' stamp: 'jmv 9/5/2016 20:48:53'! +testLiteralSymbols - ^SmalltalkCompleter changeEntriesLimitTo: SmallInteger maxVal during: [ super performTest ]! ! + 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: 94), (96 to: 126) collect: [:ascii | Character numericValue: ascii]) , + #(':x:yourself' '::' 'x:yourself' '123' 'x0:x1:x2:' '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']! ! -!SmalltalkCompleterTest class methodsFor: 'testing' stamp: 'HAW 5/2/2020 13:21:14'! -isAbstract +!SourceCodeIntervalTest methodsFor: 'tests - trimming' stamp: 'RNG 5/8/2020 21:02:35'! +test01TryingToTrimAnAlreadyTrimmedIntervalThatRepresentsASmalltalkExpressionDoesNotChangeTheOriginalInterval + + | originalInterval trimmedInterval sourceCode | + sourceCode := '3+4'. + originalInterval := (1 to: sourceCode size) asSourceCodeInterval. + trimmedInterval := originalInterval trimToMatchExpressionOn: sourceCode. - ^true! ! + self assert: originalInterval equals: trimmedInterval! ! -!DynamicTypingSmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:43:31'! -test023_AutocompletingMessagesFor_UnaryMessages +!SourceCodeIntervalTest methodsFor: 'tests - trimming' stamp: 'RNG 5/8/2020 21:02:27'! +test02StartingAndEndingSeparatorsAreTrimmed - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 self class '. - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 1 + self class '. ! ! + | originalInterval trimmedInterval sourceCode | + sourceCode := ' 3+4 '. + originalInterval := (1 to: sourceCode size) asSourceCodeInterval. + trimmedInterval := originalInterval trimToMatchExpressionOn: sourceCode. -!DynamicTypingSmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:44:50'! -test024_AutocompletingMessagesFor_RightParenthesis + self assert: (2 to: 4) asSourceCodeInterval equals: trimmedInterval! ! + +!SourceCodeIntervalTest methodsFor: 'tests - trimming' stamp: 'RNG 5/8/2020 21:02:09'! +test03StartingAndEndingDotsAreTrimmed - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 (1) '. - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 1 < (1) '.! ! + | originalInterval trimmedInterval sourceCode | + sourceCode := '...3+4..'. + originalInterval := (1 to: sourceCode size) asSourceCodeInterval. + trimmedInterval := originalInterval trimToMatchExpressionOn: sourceCode. -!DynamicTypingSmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:45:10'! -test026_AutocompletingMessagesFor_Cascade + self assert: (4 to: 6) asSourceCodeInterval equals: trimmedInterval! ! + +!SourceCodeIntervalTest methodsFor: 'tests - trimming' stamp: 'RNG 5/8/2020 21:01:42'! +test04GroupsOfParenthesesAreTrimmed - self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 self class; '. - ! ! + | originalInterval trimmedInterval sourceCode | + sourceCode := '((3+4))'. + originalInterval := (1 to: sourceCode size) asSourceCodeInterval. + trimmedInterval := originalInterval trimToMatchExpressionOn: sourceCode. -!DynamicTypingSmalltalkCompleterTest class methodsFor: 'testing' stamp: 'HAW 5/2/2020 16:27:37'! -isAbstract + self assert: (3 to: 5) asSourceCodeInterval equals: trimmedInterval! ! - ^DynamicTypingSmalltalkCompleter isForCurrentTypeSystem not! ! +!SourceCodeIntervalTest methodsFor: 'tests - trimming' stamp: 'RNG 5/8/2020 21:01:13'! +test05GroupsOfParenthesesIncludingSeparatorsAreTrimmed + + | originalInterval trimmedInterval sourceCode | + sourceCode := ' ( (3+4) + )'. + originalInterval := (1 to: sourceCode size) asSourceCodeInterval. + trimmedInterval := originalInterval trimToMatchExpressionOn: sourceCode. -!TaskbarTest methodsFor: 'Running' stamp: 'jmv 10/24/2020 15:55:32'! -setUp + self assert: (5 to: 7) asSourceCodeInterval equals: trimmedInterval! ! - needsDelete _ UISupervisor ui taskbar isNil. - taskbar _ UISupervisor ui hideTaskbar; showTaskbar; taskbar. - taskbar screenSizeChanged. - taskbar world runStepMethods! ! +!SourceCodeIntervalTest methodsFor: 'tests - equality' stamp: 'RNG 5/27/2020 23:59:37'! +test11AsSourceCodeIntervalMessageDoesNotCreateANewSourceCodeIntervalInstance -!TaskbarTest methodsFor: 'Running' stamp: 'jmv 12/28/2017 16:12:13'! -tearDown + | interval | + interval := (1 to: 10) asSourceCodeInterval. + + self assert: interval == interval asSourceCodeInterval! ! - needsDelete ifTrue: [ - UISupervisor ui hideTaskbar ]! ! +!SourceCodeIntervalTest methodsFor: 'tests - expanding' stamp: 'RNG 5/9/2020 15:41:07'! +test06AnIntervalThatDoesNotHaveCharactersToExpandRemainsTheSame -!TaskbarTest methodsFor: 'test cases' stamp: 'jmv 12/28/2017 16:12:16'! -testClassSingleton + | sourceCode expandedInterval originalInterval | + sourceCode := '3+4 factorial'. + originalInterval := (1 to: sourceCode size) asSourceCodeInterval. + expandedInterval := originalInterval expandToMatchExpressionOn: sourceCode. - self should: [ taskbar == UISupervisor ui taskbar ]. -! ! + self assert: originalInterval equals: expandedInterval! ! -!TaskbarTest methodsFor: 'test cases' stamp: 'jmv 9/4/2012 17:30'! -testHorizontalAlignment +!SourceCodeIntervalTest methodsFor: 'tests - expanding' stamp: 'RNG 5/9/2020 15:41:07'! +test07AnIntervalEnclosedByParenthesesCanBeExpanded - self should: [ taskbar morphPositionInWorld x = 0 ]! ! + | sourceCode expandedInterval originalInterval | + sourceCode := '(3+4 factorial)'. + originalInterval := (2 to: sourceCode size - 1) asSourceCodeInterval. + expandedInterval := originalInterval expandToMatchExpressionOn: sourceCode. -!TaskbarTest methodsFor: 'test cases' stamp: 'jmv 12/28/2017 16:12:01'! -testWidth - - self should: [ taskbar morphWidth = UISupervisor ui morphWidth ]! ! + self assert: (1 to: sourceCode size) equals: expandedInterval! ! -!TestCaseTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:47:26'! -testIsTestCase - self assert: (TestCase new is: #TestCase).! ! +!SourceCodeIntervalTest methodsFor: 'tests - expanding' stamp: 'RNG 5/9/2020 15:41:07'! +test08AnIntervalWithParenthesesOnJustOneSideCannotBeExpanded -!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 3/17/2019 07:31:39'! -testShouldFailErrorsWhenNoErrorIsSignaled + | sourceCode expandedInterval originalInterval | + sourceCode := '3 + 4 factorial)'. + originalInterval := (1 to: sourceCode size - 1) asSourceCodeInterval. + expandedInterval := originalInterval expandToMatchExpressionOn: sourceCode. - self - should: [ self shouldFail: [] ] - raise: TestResult failure! ! + self assert: originalInterval equals: expandedInterval! ! -!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 3/17/2019 07:32:19'! -testShouldFailPassesWhenAnErrorIsSignaled +!SourceCodeIntervalTest methodsFor: 'tests - expanding' stamp: 'RNG 5/9/2020 15:41:07'! +test09AnIntervalEnclosedByBackticksCanBeExpanded - self shouldFail: [ self error: 'an error' ]! ! + | sourceCode expandedInterval originalInterval | + sourceCode := '`3 + 4 factorial`'. + originalInterval := (2 to: sourceCode size - 1) asSourceCodeInterval. + expandedInterval := originalInterval expandToMatchExpressionOn: sourceCode. -!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 4/5/2018 14:32:15'! -testShouldRaiseWithExceptionDoCanExpectException + self assert: (1 to: sourceCode size) equals: expandedInterval! ! - "This test is important becuase TestFailure is a subclass of Exception, therefore if we are expecting Exception to be raised it should not - catch the TestFailure - Hernan" - - | failureRaised | - - failureRaised := false. - - [self should: [] raise: Exception ] - on: TestResult failure - do: [ :failure | failureRaised := true ]. - - self assert: failureRaised ! ! +!SourceCodeIntervalTest methodsFor: 'tests - expanding' stamp: 'RNG 5/9/2020 15:41:07'! +test10AnIntervalEnclosedMultipleBackticksAndParenthesesCanBeExpanded -!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HernanWilkinson 1/19/2017 20:52:39'! -testShouldRaiseWithExceptionDoFailsWhenNoExceptionIsSignaled - - | failureSignaled | - - failureSignaled := false. - - [self - should: [] - raise: ZeroDivide - withExceptionDo: [:signaledException | self error: 'should not evaluate this block' ]] - on: TestResult failure - do: [:failure | failureSignaled := true ]. - - self assert: failureSignaled ! ! + | sourceCode expandedInterval originalInterval | + sourceCode := '`((3 + 4 factorial))`'. + originalInterval := (4 to: sourceCode size - 3) asSourceCodeInterval. + expandedInterval := originalInterval expandToMatchExpressionOn: sourceCode. -!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HernanWilkinson 1/19/2017 20:52:31'! -testShouldRaiseWithExceptionDoFailsWhenOtherExceptionTypeIsSignaled + self assert: (1 to: sourceCode size) equals: expandedInterval! ! - | exceptionToRaise | - - exceptionToRaise := Error new. +!SourceCodeIntervalTest methodsFor: 'tests - testing' stamp: 'HAW 6/11/2022 20:09:17'! +test12AnIntervalEndingOnDotExpandsUntilStartOfNextStatementOnSameLine + + | interval sourceCode expectedExpandedInterval expandedInterval | - [self - should: [ exceptionToRaise signal ] - raise: ZeroDivide - withExceptionDo: [:signaledException | self error: 'should not evalaute this block' ]] - on: Error - do: [:anError | self assert: exceptionToRaise equals: anError ] - -! ! + sourceCode := '1 + 2. 3 + 4'. + interval := (1 to: 6) asSourceCodeInterval. + expandedInterval := interval expandUntilStartOfNextStatementOn: sourceCode. + expectedExpandedInterval := (1 to: 7) asSourceCodeInterval. + self assert: expectedExpandedInterval equals: expandedInterval.! ! -!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HernanWilkinson 1/19/2017 20:51:53'! -testShouldRaiseWithExceptionDoPassSignaledExceptionToAssertionsBlock +!SourceCodeIntervalTest methodsFor: 'tests - testing' stamp: 'HAW 6/11/2022 20:09:21'! +test13AnIntervalEndingBeforeDotExpandsUntilStartOfNextStatementOnSameLine - | exceptionToRaise | + | interval sourceCode expectedExpandedInterval expandedInterval | - exceptionToRaise := Error new. + sourceCode := '1 + 2. 3 + 4'. + interval := (1 to: 5) asSourceCodeInterval. + expandedInterval := interval expandUntilStartOfNextStatementOn: sourceCode. + expectedExpandedInterval := (1 to: 7) asSourceCodeInterval. + self assert: expectedExpandedInterval equals: expandedInterval.! ! + +!SourceCodeIntervalTest methodsFor: 'tests - testing' stamp: 'HAW 6/11/2022 20:09:24'! +test14AnIntervalEndingOnEndOfTemporariesDeclarationExpandsUntilStartOfNextStatement + + | interval sourceCode expectedExpandedInterval expandedInterval | - self - should: [ exceptionToRaise signal ] - raise: exceptionToRaise class - withExceptionDo: [:signaledException | - self assert: exceptionToRaise equals: signaledException ]. - -! ! + sourceCode := '| a b | + 1 + 2. 3 + 4'. + interval := (1 to: 8) asSourceCodeInterval. + expandedInterval := interval expandUntilStartOfNextStatementOn: sourceCode. + expectedExpandedInterval := (1 to:12) asSourceCodeInterval. + self assert: expectedExpandedInterval equals: expandedInterval. ! ! -!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HernanWilkinson 1/19/2017 20:51:45'! -testShouldRaiseWithExceptionDoValuesAssertionsBlockWhenExceptionIsRaised +!SourceCodeIntervalTest methodsFor: 'tests - testing' stamp: 'HAW 6/11/2022 20:09:30'! +test15AnIntervalEndingOnLastStatemenWithoutDottIsNotExpanded - | exceptionToRaise assertionsBlockEvaluated | + | interval sourceCode expandedInterval | - exceptionToRaise := Error new. - assertionsBlockEvaluated := false. + sourceCode := '1 + 2. + ^3 + 4'. + interval := (1 to: 16) asSourceCodeInterval. + expandedInterval := interval expandUntilStartOfNextStatementOn: sourceCode. - self - should: [ exceptionToRaise signal ] - raise: exceptionToRaise class - withExceptionDo: [:signaledException | - assertionsBlockEvaluated := true ]. - - self assert: assertionsBlockEvaluated ! ! + self assert: interval equals: expandedInterval.! ! -!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 2/6/2019 13:37:19'! -testShouldRaiseWithMessageTextDoesNotFailWithRightMessageText +!SourceCodeIntervalTest methodsFor: 'tests - testing' stamp: 'HAW 6/11/2022 20:09:32'! +test16AnIntervalEndingOnLastStatemenWithDotIsNotExpanded - | messageText | + | interval sourceCode expandedInterval | - messageText := 'some message'. + sourceCode := '1 + 2. + ^3 + 4.'. + interval := (1 to: 17) asSourceCodeInterval. + expandedInterval := interval expandUntilStartOfNextStatementOn: sourceCode. - self - shouldnt: [ - self - should: [ self error: messageText ] - raise: Error - withMessageText: messageText ] - raise: TestResult failure - ! ! - -!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 2/6/2019 13:38:00'! -testShouldRaiseWithMessageTextFailsWithDifferentMessageText + self assert: interval equals: expandedInterval.! ! - self - should: [ - self - should: [ self error: 'some message' ] - raise: Error - withMessageText: '' ] - raise: TestResult failure - ! ! +!SourceCodeIntervalTest methodsFor: 'tests - testing' stamp: 'HAW 6/11/2022 20:09:35'! +test17AnIntervalEndingBeforeStatementEndCannotBeExpanded -!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 3/17/2019 06:42:30'! -testShoulndFailErrorsWhenAnErrorIsSignaled + | interval sourceCode | + + sourceCode := '1 + 2. 3 + 4'. + interval := (1 to: 3) asSourceCodeInterval. + self should: [interval expandUntilStartOfNextStatementOn: sourceCode.] + raise: Error + withMessageText: [SourceCodeInterval canNotExpandIncompleteStatementError].! ! - self - should: [ self shouldntFail: [ self fail ]] - raise: TestResult failure! ! +!SourceCodeIntervalTest methodsFor: 'tests - testing' stamp: 'HAW 6/11/2022 20:09:38'! +test18AnIntervalEndingAfterLastStatementCannotBeExpanded -!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 3/17/2019 06:41:26'! -testShoulndFailPassesWhenNoErrorIsSignaled + | interval sourceCode | + + sourceCode := '| a b | + 1 + 2. 3 + 4'. + interval := (1 to: 20) asSourceCodeInterval. + self should: [interval expandUntilStartOfNextStatementOn: sourceCode.] + raise: Error + withMessageText: [SourceCodeInterval canNotExpandIncompleteStatementError].! ! - self shouldntFail: [ 1+2 ]! ! +!SourceCodeIntervalTest methodsFor: 'tests - testing' stamp: 'HAW 6/11/2022 20:09:41'! +test19AnIntervalEndingAfterSourceCodeEndIsNotExpanded -!TestCaseTest methodsFor: 'changes' stamp: 'HAW 5/15/2019 18:33:28'! -testAssertChangesByPassesWhenActionChangesConditionByTheSpecifiedAmount + | interval sourceCode expandedInterval | + + sourceCode := '1 + 2. 3 + 4'. + interval := (1 to: 1000) asSourceCodeInterval. + expandedInterval := interval expandUntilStartOfNextStatementOn: sourceCode. + + self assert: interval equals: expandedInterval.! ! - |aCollection| +!SourceCodeIntervalTest methodsFor: 'tests - testing' stamp: 'HAW 6/11/2022 20:09:44'! +test20AnIntervalEndingExpandsUntilStartOfNextStatementOnNextLine - aCollection := OrderedCollection new. + | interval sourceCode expandedInterval expectedInterval | - self assert: [ aCollection add: 1; add: 2 ] changes: [ aCollection size ] by: 2! ! + sourceCode := '1 + 2. + 3 + 4'. + interval := (1 to: 6) asSourceCodeInterval. + expandedInterval := interval expandUntilStartOfNextStatementOn: sourceCode. + expectedInterval := (1 to: 9) asSourceCodeInterval. + + self assert: expectedInterval equals: expandedInterval.! ! -!TestCaseTest methodsFor: 'changes' stamp: 'HAW 5/15/2019 18:34:29'! -testAssertChangesFromToPassesWhenActionChangesConditionFromAndToTheSpecifiedValues +!SystemConsistencyTest methodsFor: 'testing' stamp: 'jmv 5/7/2012 09:35'! +testMethodsWithUnboundGlobals + " + SystemConsistencyTest new testMethodsWithUnboundGlobals + " + self assert: Smalltalk methodsWithUnboundGlobals isEmpty! ! - |aCollection| +!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:29:18'! +testNewLineWhenConditionIsFalseDoesNotPutANewLineInStream - aCollection := OrderedCollection with: 1. - - self assert: [ aCollection add: 2 ] changes: [ aCollection size ] from: 1 to: 2! ! + self assertTranscriptContentsDoesNotChangeAfter: [ Transcript newLineWhen: false ] + ! ! -!TestCaseTest methodsFor: 'changes' stamp: 'HAW 5/15/2019 18:33:34'! -testAssertChangesPassesWhenConditionIsAlteredByAction +!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:38:57'! +testNewLineWhenConditionIsTruePutsANewLineInStream - |aCollection| + self assertTranscriptContentsAdded: '.' after: [ Transcript newLineWhen: true; nextPut: $. ]! ! - aCollection := OrderedCollection new. - - self assert: [ aCollection add: 1 ] changes: [ aCollection size ]! ! +!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:09:29'! +testNextPutAllWhenConditionIsFalseDoesNotPutCollectionInStream -!TestCaseTest methodsFor: 'changes' stamp: 'HAW 5/15/2019 18:33:39'! -testAssertDoeNotChangePassesWhenConditionIsNotAlteredByAction + self assertTranscriptContentsDoesNotChangeAfter: [ Transcript nextPutAll: 'other' when: false ] + ! ! - |aCollection| +!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:13:47'! +testNextPutAllWhenConditionIsTruePutsCollectionInStream - aCollection := OrderedCollection with: 1. + self assertTranscriptContentsAdded: 'other' after: [ Transcript nextPutAll: 'other' when: true ] - self assert: [ aCollection sum ] doesNotChange: [ aCollection size ]! ! + ! ! -!TestCaseTest methodsFor: 'assert is near to' stamp: 'jmv 7/1/2019 16:24:01'! -testAssertIsCloseToPassesForSameNumberDifferentToZero - - self assert: 1.5 isCloseTo: 1.5! ! +!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:11:58'! +testNextPutWhenConditionIsFalseDoesNotPutObjectInStream -!TestCaseTest methodsFor: 'assert is near to' stamp: 'jmv 7/1/2019 16:24:12'! -testAssertIsCloseToPassesWhenBothAreZero + self assertTranscriptContentsDoesNotChangeAfter: [ Transcript nextPut: $t when: false ] +! ! - self assert: 0.0 isCloseTo: 0.0! ! +!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:15:05'! +testNextPutWhenConditionIsTruePutsObjectInStream -!TestCaseTest methodsFor: 'assert is near to' stamp: 'jmv 7/1/2019 16:24:18'! -testAssertIsCloseToPassesWithSameCalculatedNumber + self assertTranscriptContentsAdded: 't' after: [ Transcript nextPut: $t when: true ] - self assert: 0.3 isCloseTo: 0.1 + 0.2! ! + ! ! -!TestCaseTest methodsFor: 'assert is near to' stamp: 'jmv 7/1/2019 16:24:24'! -testAssertIsCloseToWithPrecisionPassesWhenDifferenceIsNegativeAndLessThanPrecision - - |precision newValue originalNumber | - - precision _ 0.1. - originalNumber _ 0.3. - newValue _ originalNumber - 0.01. - - self assert: originalNumber isCloseTo: newValue withPrecision: precision! ! +!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:12:44'! +testPrintWhenConditionIsFalseDoesNotPrintObjectInStream -!TestCaseTest methodsFor: 'assert is near to' stamp: 'jmv 7/1/2019 16:24:30'! -testAssertIsCloseToWithPrecisionPassesWhenDifferenceIsPositiveAndLessThanPrecision - - |precision newValue originalNumber | - - precision _ 0.1. - originalNumber _ 0.3. - newValue _ originalNumber + 0.01. - - self assert: originalNumber isCloseTo: newValue withPrecision: precision! ! + self assertTranscriptContentsDoesNotChangeAfter: [ Transcript print: Object when: false ] +! ! -!TestCaseTest methodsFor: 'assert is near to' stamp: 'jmv 7/1/2019 16:24:39'! -testAssertIsNotCloseWithPrecisionPassesWhenDifferenceIsBiggerThanPrecision - - |precision newValue originalNumber | - - precision _ 0.1. - originalNumber _ 0.3. - newValue _ originalNumber + precision + 0.001. - - self assert: originalNumber isNotCloseTo: newValue withPrecision: precision! ! +!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:15:34'! +testPrintWhenConditionIsTruePrintsObjectInStream -!TestCaseTest methodsFor: 'includes' stamp: 'HAW 5/15/2019 18:49:51'! -testAssertIncludesFailsWhenElementIsNotIncludedInCollection - - | collection anElement | - - anElement _ 1. - collection _ #(). - - self should: [ self assert: collection includes: anElement ] - raise: TestResult failure - withMessageText: collection asString, ' does not include ', anElement asString! ! + self assertTranscriptContentsAdded: Object printString after: [ Transcript print: Object when: true ] + ! ! -!TestCaseTest methodsFor: 'includes' stamp: 'HAW 5/15/2019 18:50:04'! -testAssertIncludesShouldNotFailWhenElementIsInCollection - - | collection anElement | - - anElement _ 1. - collection _ Array with: anElement. - - self - shouldnt: [ self assert: collection includes: anElement ] - raise: TestResult failure! ! +!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:39:29'! +testSpaceWhenConditionIsFalseDoesNotPutASpaceInStream -!TestCaseTest methodsFor: 'should take less than' stamp: 'jmv 3/10/2022 11:42:41'! -testShouldNotTakeMoreThanFailsWhenClosureTakesMoreThanTheLimit + self assertTranscriptContentsDoesNotChangeAfter: [ Transcript spaceWhen: false ] + ! ! - self shouldFail: [ self should: [(Delay forMilliseconds: 50) wait ] notTakeMoreThan: 10 milliSeconds ]! ! +!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:40:09'! +testSpaceWhenConditionIsTruePutsASpaceInStream -!TestCaseTest methodsFor: 'should take less than' stamp: 'HAW 5/15/2019 19:07:04'! -testShouldNotTakeMoreThanPassesWhenClosureTakesLessThanTheLimit + self assertTranscriptContentsAdded: ' ' after: [ Transcript spaceWhen: true ] + ! ! - self shouldntFail: [ self should: [] notTakeMoreThan: 1 milliSeconds ] - ! ! +!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:40:49'! +testTabWhenConditionIsFalseDoesNotPutATabInStream -!TestSuiteTest methodsFor: 'assertions' stamp: 'HAW 2/10/2017 15:11:43'! -assert: expectedTestSuite hasSameTestsAs: resultTestSuite + self assertTranscriptContentsDoesNotChangeAfter: [ Transcript tabWhen: false ]! ! - | expectedTests resultTests | +!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:41:35'! +testTabWhenConditionIsTruePutsATabInStream + + self assertTranscriptContentsAdded: Character tab asString after: [ Transcript tabWhen: true ]! ! + +!TranscriptTest methodsFor: 'assertions' stamp: 'HAW 3/20/2019 07:14:26'! +assertTranscriptContentsAdded: expectedAddedString after: aBlock - expectedTests _ expectedTestSuite tests. - resultTests _ resultTestSuite tests. + | transcriptContentsBeforeBlockEvaluation | - self assert: expectedTests size equals: resultTests size. - self assert: (expectedTests allSatisfy: [:expectedTest | resultTests anySatisfy: [:resultTest | self is: expectedTest equalTo: resultTest ]]) - ! ! - -!TestSuiteTest methodsFor: 'assertions' stamp: 'jmv 3/12/2018 20:41:35'! -assertIncludesThisTest: aTestSuite - - | thisTestSelector | + transcriptContentsBeforeBlockEvaluation := Transcript contents. + aBlock value. - thisTestSelector _ thisContext sender selector. - ^aTestSuite tests anySatisfy: [ :aTestCase | aTestCase class = self class and: [aTestCase selector = thisTestSelector ]]! ! + self assert: transcriptContentsBeforeBlockEvaluation, expectedAddedString equals: Transcript contents! ! -!TestSuiteTest methodsFor: 'assertions' stamp: 'HAW 2/10/2017 15:20:29'! -is: expectedTest equalTo: resultTest +!TranscriptTest methodsFor: 'assertions' stamp: 'HAW 3/20/2019 07:15:48'! +assertTranscriptContentsDoesNotChangeAfter: aBlock + + self assertTranscriptContentsAdded: '' after: aBlock! ! - ^expectedTest class = resultTest class and: [ expectedTest selector = resultTest selector ]! ! +!TrieTest methodsFor: 'aux' stamp: 'jmv 6/21/2011 22:05'! +assert: subject isEquivalentToDictionary: controlGroup + "Test #size, #do:, " + | count subjectAsDictionary someRandomString | + self assert: subject isEmpty = controlGroup isEmpty. + self assert: subject size = controlGroup size. + controlGroup keysDo: [ :each | + self assert: (subject includesKey: each) ]. + subject keysDo: [ :each | + self assert: (controlGroup includesKey: each) ]. + controlGroup keysAndValuesDo: [ :k :v | + self assert: (subject at: k) = v ]. + subject keysAndValuesDo: [ :k :v | + self assert: (controlGroup at: k) = v ]. + someRandomString _ 'someRandomStringZZZ'. + self assert: (subject includesKey: someRandomString) + = (controlGroup includesKey: someRandomString). + subjectAsDictionary _ Dictionary new. + count _ 0. + subject keysAndValuesDo: [ :k :v | + subjectAsDictionary at: k put: v. + count _ count + 1 ]. + self assert: subjectAsDictionary size = controlGroup size. + self assert: count = controlGroup size. + self assert: subjectAsDictionary = controlGroup.! ! -!TestSuiteTest methodsFor: 'test support' stamp: 'HAW 10/29/2019 11:13:21'! -hardCodedReferenceToSelfClass +!TrieTest methodsFor: 'aux' stamp: 'jmv 6/15/2011 09:58'! +assert: subject isEquivalentToSet: controlGroup + "Test #size, #do:, " + | count subjectAsSet someRandomString | + self assert: subject isEmpty = controlGroup isEmpty. + self assert: subject size = controlGroup size. + controlGroup do: [ :each | + self assert: (subject includes: each) ]. + someRandomString _ 'someRandomStringZZZ'. + self assert: (subject includes: someRandomString) + = (controlGroup includes: someRandomString). + subjectAsSet _ Set new. + count _ 0. + subject do: [ :element | + subjectAsSet add: element. + count _ count + 1 ]. + self assert: subjectAsSet size = controlGroup size. + self assert: count = controlGroup size. + self assert: subjectAsSet = controlGroup.! ! - ^TestSuiteTest ! ! +!TrieTest methodsFor: 'aux' stamp: 'jmv 6/22/2011 12:51'! +assert: subject prefixSelection: aString isEquivalentToSet: controlGroup + | selection1 selection2 | + selection1 _ OrderedCollection new. + subject forPrefix: aString keysAndValuesDo: [ :k :v | + selection1 add: k ]. + selection2 _ (controlGroup select: [ :each | + aString isEmpty or: [ + each asLowercase asUnaccented beginsWith: aString asLowercase asUnaccented]]) asOrderedCollection + sort: [ :a :b | a asLowercase asUnaccented < b asLowercase asUnaccented ]. + self assert: selection1 = selection2.! ! -!TestSuiteTest methodsFor: 'test support' stamp: 'HAW 3/3/2017 16:37:00'! -quickMethodTest +!TrieTest methodsFor: 'testing' stamp: 'jmv 6/21/2011 22:14'! +testAllMesssagesLikeDicionary + " + TrieTest new testAllMesssagesLikeDicionary + " + | subject controlGroup allMessages copy c set1 set2 | + subject _ Trie new. + controlGroup _ Dictionary new. + allMessages _ Smalltalk allImplementedMessages. + c _ 0. + 3 timesRepeat: [ + allMessages do: [ :symbol | + subject at: symbol put: c. + controlGroup at: symbol put: c. + c _ c + 1 ]]. + self assert: subject isEquivalentToDictionary: controlGroup. - "stub for a quick method - Hernan"! ! + copy _ Dictionary new. + set1 _ Set new. + subject keysAndValuesDo: [ :symbol :number | + copy at: symbol put: number. + set1 add: number ]. -!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 15:22:49'! -test01SuiteForTestCaseClassHasTheSameTestAsCreatingTheSuiteFromTheTestCaseClass + set2 _ Set new. + subject do: [ :number | + set2 add: number ]. - self assert: self class buildSuite hasSameTestsAs: (TestSuite forClass: self class)! ! + self assert: subject isEquivalentToDictionary: copy. + self assert: copy isEquivalentToDictionary: controlGroup. + self assert: set1 = set2! ! -!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 15:24:17'! -test02SuiteForNoTestCaseClassUsesTestClassWithSameNameEndingWithTest +!TrieTest methodsFor: 'testing' stamp: 'jmv 6/21/2011 22:01'! +testAllMesssagesLikeSet + " + TrieTest new testAllMesssagesLikeSet + " + | subject controlGroup allMessages copy| + subject _ Trie new. + controlGroup _ Set new. + allMessages _ Smalltalk allImplementedMessages. + 3 timesRepeat: [ + allMessages do: [ :symbol | + subject add: symbol. + controlGroup add: symbol ]]. + self assert: subject isEquivalentToSet: controlGroup. - self assert: self class buildSuite hasSameTestsAs: (TestSuite forClass: TestSuite)! ! + copy _ Set new. + subject do: [ :symbol | + copy add: symbol ]. -!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 10/29/2019 11:12:11'! -test03SuiteForNoTestCaseClassAndNoTestClassLooksForReferencesInTests + self assert: subject isEquivalentToSet: copy. + self assert: copy isEquivalentToSet: controlGroup.! ! - | objectTestSuite referencesToObject testCaseClasses | - - "I need to be sure that Object has no test class for the test to make sense - Hernan" - self assert: self class testCaseClass isNil. +!TrieTest methodsFor: 'testing' stamp: 'HAW 6/12/2019 17:38:28'! +testIncludesReturnsFalseForObjectsThatAreNotString - objectTestSuite _ TestSuite forClass: self class. - referencesToObject _ self class allCallsOn collect: [:aMethodReference | aMethodReference actualClass ]. - testCaseClasses _ (objectTestSuite tests collect: [:aTestCase | aTestCase class ]) asSet. - - self assert: objectTestSuite tests notEmpty. - self assert: (testCaseClasses allSatisfy: [:aTestCaseClass | (aTestCaseClass is: #TestCaseClass) and: [ referencesToObject includes: aTestCaseClass ]]) + self deny: ((Trie with: 'hello') includes: 1) ! ! -!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 15:41:52'! -test04SuiteForTestMethodIncludesOnlyTheMethod - - self assert: (TestSuite new addTest: (self class selector: thisContext selector)) hasSameTestsAs: (TestSuite forCompiledMethod: thisContext method)! ! - -!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 15:56:00'! -test05SuiteForNoTestMethodIncludesTestCaseSendingTheCompiledMethodSelector - - | compiledMethodSuite compiledMethodSelector senders | - - compiledMethodSelector _ #addTest:. - compiledMethodSuite _ TestSuite forCompiledMethod: (TestSuite compiledMethodAt: compiledMethodSelector). - senders _ (Smalltalk allCallsOn: compiledMethodSelector) collect: [:aMethodReference | aMethodReference selector ]. +!TrieTest methodsFor: 'testing' stamp: 'HAW 6/12/2019 17:38:51'! +testIncludesReturnsFalseForStringsNotIncluded - self assert: compiledMethodSuite tests notEmpty. - self assert: (compiledMethodSuite tests allSatisfy: [:aTestCase | (aTestCase class is: #TestCaseClass) and: [ senders includes: aTestCase selector]])! ! - -!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 16:39:30'! -test06ForSystemCategoryWithTestCasesIncludesOnlyTestCasesClasses + self deny: ((Trie with: 'hello') includes: 'bye') + ! ! - | suite | - - suite _ TestSuite forSystemCategoryNamed: self class category using: SystemOrganization. +!TrieTest methodsFor: 'testing' stamp: 'HAW 6/12/2019 17:39:09'! +testIncludesReturnsTrueForIncludedStrings - "I just make a simple assertion that verifies this test is included - Hernan" - self assertIncludesThisTest: suite ! ! + self assert: ((Trie with: 'hello') includes: 'hello') + ! ! -!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 16:41:00'! -test07ForSystemCategoryWithNoTestCasesIncludesTestClassesTests +!TrieTest methodsFor: 'testing' stamp: 'HAW 4/4/2019 08:18:55'! +testKeyNotFoundSignalTheRightMessage - | suite | - - suite _ TestSuite forSystemCategoryNamed: TestSuite category using: SystemOrganization. - - "I just make a simple assertion that verifies this test is included - Hernan" - self assertIncludesThisTest: suite ! ! + self + should: [ Trie new errorKeyNotFound ] + raise: Error + withMessageText: Dictionary keyNotFoundErrorDescription ! ! -!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 16:41:08'! -test08ForMessageCategoryContainingTestCasesIncludesThoseTestCases +!TrieTest methodsFor: 'testing' stamp: 'jmv 6/22/2011 12:30'! +testPrefixIteration + " + TrieTest new testPrefixIteration + " + | subject controlGroup | + subject _ Trie new. + controlGroup _ Set new. - | suite classOrganizer | - - classOrganizer _ self class organization. - suite _ TestSuite forMessageCategoryNamed: (classOrganizer categoryOfElement: thisContext selector) of: self class categorizedWith: classOrganizer. + self assert: subject prefixSelection: '' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'c' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'ca' isEquivalentToSet: controlGroup. - "I just make a simple assertion that verifies this test is included - Hernan" - self assertIncludesThisTest: suite ! ! + subject add: 'car'. + controlGroup add: 'car'. + subject add: 'car'. + controlGroup add: 'car'. + subject add: 'cat'. + controlGroup add: 'cat'. + subject add: 'cart'. + controlGroup add: 'cart'. -!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 16:38:46'! -test09ForMessageCategoryWihoutTestIsEmpty + self assert: subject prefixSelection: '' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'c' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'ca' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'car' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'cat' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'cart' isEquivalentToSet: controlGroup. - | suite classOrganizer | + subject add: 'ñandú'. + controlGroup add: 'ñandú'. + subject add: 'ñandues'. + controlGroup add: 'ñandues'. + subject add: 'ÑANDÚSES'. + controlGroup add: 'ÑANDÚSES'. - classOrganizer _ self class organization. - suite _ TestSuite forMessageCategoryNamed: (classOrganizer categoryOfElement: #assert:hasSameTestsAs:) of: self class categorizedWith: classOrganizer. - - self assert: suite tests isEmpty! ! - -!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 3/3/2017 18:53:02'! -test10CanNotDebugAsFailureQuickMethods - - self class debugAsFailure: #quickMethodTest ifCanNot: [ ^self ]. - self fail! ! + self assert: subject prefixSelection: '' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'c' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'ca' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'car' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'cat' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'cart' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'ñ' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'ñan' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'ñandu' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'ñandú' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'Ñ' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'ÑANDÚ' isEquivalentToSet: controlGroup.! ! -!DifferenceFinderTest methodsFor: 'all' stamp: 'LC 1/24/2010 11:29'! -testCharacters - | lcs | - lcs := DifferenceFinder charactersOf: 'GAC' and: 'AGCAT'. - lcs compute. - self - assert: (lcs lcsAt: 1 at: 1) anyOne size = 0; - assert: (lcs lcsAt: 1 at: 2) anyOne size = 1; - assert: (lcs lcsAt: 1 at: 3) anyOne size = 1; - assert: (lcs lcsAt: 1 at: 4) anyOne size = 1; - assert: (lcs lcsAt: 1 at: 5) anyOne size = 1; - assert: (lcs lcsAt: 2 at: 1) anyOne size = 1; - assert: (lcs lcsAt: 2 at: 2) anyOne size = 1; - assert: (lcs lcsAt: 2 at: 3) anyOne size = 1; - assert: (lcs lcsAt: 2 at: 4) anyOne size = 2; - assert: (lcs lcsAt: 2 at: 5) anyOne size = 2; - assert: (lcs lcsAt: 3 at: 1) anyOne size = 1; - assert: (lcs lcsAt: 3 at: 2) anyOne size = 1; - assert: (lcs lcsAt: 3 at: 3) anyOne size = 2; - assert: (lcs lcsAt: 3 at: 4) anyOne size = 2; - assert: (lcs lcsAt: 3 at: 5) anyOne size = 2 -! ! +!TrieTest methodsFor: 'testing' stamp: 'jmv 6/22/2011 12:50'! +testPrefixIteration2 + " + TrieTest new testPrefixIteration2 + " + | subject controlGroup allMsg toAvoid | + subject _ Trie new. + controlGroup _ Set new. -!DifferenceFinderTest methodsFor: 'all'! -testCharacters2 - | finder x y | - finder := DifferenceFinder charactersOf: 'GAC' and: 'AGCAT'. - finder compute. - self assert: finder differences size = 3. - finder differences do: [:diff | - x := String streamContents: [:strm | - diff - do: [:char :condition | (#(#removed #unchanged) includes: condition) - ifTrue: [strm nextPut: char]]]. - self assert: x = 'GAC'. - y := String streamContents: [:strm | - diff - do: [:char :condition | (#(#inserted #unchanged) includes: condition) - ifTrue: [strm nextPut: char]]]. - self assert: y = 'AGCAT'] -! ! + allMsg _ Smalltalk allImplementedMessages. + toAvoid _ (allMsg asArray collect: [ :each | each asLowercase asUnaccented ]) asBag. + allMsg do: [ :symbol | + (toAvoid occurrencesOf: symbol) = 1 ifTrue: [ + subject add: symbol. + controlGroup add: symbol ]]. + + self assert: subject prefixSelection: '' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'a' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'at' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'at:' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'at:p' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'at:pu' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'at:put' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'at:put:' isEquivalentToSet: controlGroup. + self assert: subject prefixSelection: 'at:put:nonExistant:' isEquivalentToSet: controlGroup.! ! -!DifferenceFinderTest methodsFor: 'all'! -testCode - | old new finder | - old := 'differencesText - | change sourceString current diff rtf selectedString | - change := self selectedMethod ifNil: [self currentClass]. - current := change currentVersion. - sourceString := current isNil - ifTrue: [''] - ifFalse: [current isCompiledMethod ifTrue: [(self - formatSource: current sourceString - inClass: current classField) - sourceCode] ifFalse: [current sourceString]]. - selectedString := (current isNil or: [current isCompiledMethod not]) - ifTrue: [change sourceString] - ifFalse: [((self - formatSource: change sourceString - inClass: current classField) ifNil: [change]) sourceCode]. - diff := TextDiffBuilder from: sourceString to: selectedString. - rtf := RTFText new setFont: TextFont. - rtf setTabStops: self tabStops. - diff run; printPatchSequenceOn: rtf. - ^rtf contents contents'. - new := 'differencesText - | change sourceString current finder rtf selectedString | - change := self selectedMethod ifNil: [self currentClass]. - current := change currentVersion. - sourceString := current isNil ifTrue: [''] ifFalse: [ - current isCompiledMethod - ifTrue: [(self - formatSource: current sourceString - inClass: current classField) - sourceCode] - ifFalse: [current sourceString]]. - selectedString := (current isNil or: [current isCompiledMethod not]) - ifTrue: [change sourceString] - ifFalse: [((self - formatSource: change sourceString - inClass: current classField) - ifNil: [change]) - sourceCode]. - finder := DifferenceFinder wordsOf: sourceString and: selectedString. - finder compute. - rtf := RTFText new setFont: TextFont. - rtf setTabStops: self tabStops. - finder differences first printTextOn: rtf. - ^rtf contents contents'. - finder := DifferenceFinder wordsOf: old and: new. - finder compute -! ! +!TrieTest methodsFor: 'testing' stamp: 'jmv 6/23/2011 11:02'! +testRemoveLikeDicionary + " + TrieTest new testRemoveLikeDicionary + " + | subject controlGroup allMessages copy c set1 set2 | + subject _ Trie new. + controlGroup _ Dictionary new. + allMessages _ Smalltalk allImplementedMessages. -!DifferenceFinderTest methodsFor: 'all'! -testLines - | finder alan ian x y | - alan := 'The best way to - predict - the future is to - invent - it. - A. Kay'. - ian := 'The best way to - invent - the future is to - not predicting - it. - Ian Piumarta'. - finder := DifferenceFinder linesOf: alan and: ian. - finder compute. - finder differences do: [:diff | - x := String streamContents: [:strm | - diff - do: [:chunk :condition | (#(#removed #unchanged) includes: condition) - ifTrue: [strm nextPutAll: chunk]]]. - self assert: x = alan. - y := String streamContents: [:strm | - diff - do: [:chunk :condition | (#(#inserted #unchanged) includes: condition) - ifTrue: [strm nextPutAll: chunk]]]. - self assert: y = ian] -! ! + subject at: 'doNotRemove' put: 'this'. + controlGroup at: 'doNotRemove' put: 'this'. + + c _ 0. + 3 timesRepeat: [ + allMessages do: [ :symbol | + subject at: symbol put: c. + controlGroup at: symbol put: c. + c _ c + 1 ]]. -!DifferenceFinderTest methodsFor: 'all'! -testWords - | finder alan ian x y | - alan := 'The best way to - predict - the future is to - invent - it. - A. Kay'. - ian := 'The best way to - invent the future is to - not predicting - it. - Ian Piumarta'. - finder := DifferenceFinder wordsOf: alan and: ian. - finder compute. - finder differences do: [:diff | - x := String streamContents: [:strm | - diff - do: [:chunk :condition | (#(#removed #unchanged) includes: condition) - ifTrue: [strm nextPutAll: chunk]]]. - self assert: x = alan. - y := String streamContents: [:strm | - diff - do: [:chunk :condition | (#(#inserted #unchanged) includes: condition) - ifTrue: [strm nextPutAll: chunk]]]. - self assert: y = ian] -! ! + subject at: 'doNotRemove2' put: 'this2'. + controlGroup at: 'doNotRemove2' put: 'this2'. -!TestValueWithinFix methodsFor: 'tests' stamp: 'jmv 4/17/2013 12:11'! -testValueWithinNonLocalReturnFixReal - "self run: #testValueWithinNonLocalReturnFixReal" - "The real test for the fix is just as obscure as the original problem" - | startTime | - self valueWithinNonLocalReturn. - startTime := Time localMillisecondClock. - [[] repeat] valueWithin: 100 milliSeconds onTimeout:[ | deltaTime | - "This *should* timeout after 100 msecs but the pending process from - the previous invokation will signal timeout after 20 msecs already - which will in turn cut this invokation short." - deltaTime := Time localMillisecondClock - startTime. - self deny: deltaTime < 90. - ]. -! ! + self assert: subject isEquivalentToDictionary: controlGroup. + + allMessages do: [ :symbol | + subject removeKey: symbol. + controlGroup removeKey: symbol ]. -!TestValueWithinFix methodsFor: 'tests' stamp: 'ar 8/17/2007 13:38'! -testValueWithinNonLocalReturnFixSimply - "self run: #testValueWithinNonLocalReturnFixSimply" - "The simple version to test the fix" - self valueWithinNonLocalReturn. - self shouldnt:[(Delay forMilliseconds: 50) wait] raise: TimedOut.! ! + copy _ Dictionary new. + set1 _ Set new. + subject keysAndValuesDo: [ :symbol :number | + copy at: symbol put: number. + set1 add: number ]. -!TestValueWithinFix methodsFor: 'tests' stamp: 'jmv 5/31/2022 16:44:39'! -testValueWithinTimingBasic - "Test timing of valueWithin:onTimeout:" - | time | - time := [ - [1000 milliSeconds asDelay wait] - valueWithin: 100 milliSeconds onTimeout: [] - ] durationToRun. - self assert: time < 200 milliSeconds.! ! + set2 _ Set new. + subject do: [ :number | + set2 add: number ]. -!TestValueWithinFix methodsFor: 'tests' stamp: 'jmv 11/7/2019 18:18:10'! -testValueWithinTimingNestedInner - "Test nested timing of valueWithin:onTimeout:" - | time | - time := [ - [ - [5 seconds asDelay wait] - valueWithin: 100 milliSeconds onTimeout: [] - ] valueWithin: 500 milliSeconds onTimeout: [] - ] durationToRun. - self assert: time < 200 milliSeconds.! ! + self assert: subject isEquivalentToDictionary: copy. + self assert: copy isEquivalentToDictionary: controlGroup. + self assert: set1 = set2. + self assert: subject isEmpty = controlGroup isEmpty. -!TestValueWithinFix methodsFor: 'tests' stamp: 'ar 12/4/2012 20:35'! -testValueWithinTimingNestedOuter - "Test nested timing of valueWithin:onTimeout:" - | time | - time := [ - [ - 3 timesRepeat: [ - [5 seconds asDelay wait] - valueWithin: 100 milliSeconds onTimeout: []] - ] valueWithin: 150 milliSeconds onTimeout: [] - ] durationToRun. - self assert: time > 100 milliSeconds. - self assert: time < 200 milliSeconds. - ! ! + subject removeKey: 'doNotRemove'. + controlGroup removeKey: 'doNotRemove'. -!TestValueWithinFix methodsFor: 'tests' stamp: 'jmv 5/31/2022 16:45:10'! -testValueWithinTimingRepeat - "Test timing of valueWithin:onTimeout:" - | time | - time := [ - 3 timesRepeat: [ - [500 milliSeconds asDelay wait] - valueWithin: 100 milliSeconds onTimeout: []] - ] durationToRun. - self assert: time < 400 milliSeconds. -! ! + self assert: subject isEquivalentToDictionary: controlGroup. + self deny: subject isEmpty. + self deny: controlGroup isEmpty. -!TestValueWithinFix methodsFor: 'tests' stamp: 'ar 8/17/2007 13:37'! -valueWithinNonLocalReturn - "Do a non-local return from a valueWithin: block" - [^self] valueWithin: 20 milliSeconds onTimeout:[]. -! ! + subject removeKey: 'doNotRemove2'. + controlGroup removeKey: 'doNotRemove2'. -!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:31:27'! -allClassCategoriesOfTestData + self assert: subject isEquivalentToDictionary: controlGroup. + self assert: subject isEmpty. + self assert: controlGroup isEmpty.! ! - ^Array with: self classCategoryOfTestData ! ! +!TrieTest methodsFor: 'testing' stamp: 'jmv 6/22/2011 15:54'! +testRemoveLikeSet + " + TrieTest new testRemoveLikeSet + " + | subject controlGroup allMessages copy | + subject _ Trie new. + controlGroup _ Set new. + allMessages _ Smalltalk allImplementedMessages. -!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:31:31'! -classCategoryOfTestData - - "I can not call it testDataClassCategory becuase it will be taken as test!! - Hernan" + subject add: 'doNotRemove'. + controlGroup add: 'doNotRemove'. - ^self class classCategoryOfTestData! ! - -!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/18/2019 19:55:52'! -createClassNamed: aName - - ^self - createClassNamed: aName asSymbol "Just in case it is a string... - Hernan" - subclassOf: RefactoringClassTestData - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: self classCategoryOfTestData. -! ! - -!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/18/2019 19:55:56'! -createClassNamed: aName category: aCategory - - ^self - createClassNamed: aName - subclassOf: RefactoringClassTestData - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: aCategory -! ! - -!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/18/2019 19:56:00'! -createClassNamed: aName instanceVariableNames: instanceVariables - - ^self - createClassNamed: aName - subclassOf: RefactoringClassTestData - instanceVariableNames: instanceVariables - classVariableNames: '' - poolDictionaries: '' - category: self classCategoryOfTestData. - -! ! - -!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:31:49'! -createClassNamed: aName subclassOf: superclass - - ^self - createClassNamed: aName - subclassOf: superclass - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: self classCategoryOfTestData. -! ! - -!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:31:53'! -createClassNamed: aName subclassOf: superclass category: aCategory - - ^self - createClassNamed: aName - subclassOf: superclass - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: aCategory -! ! - -!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:31:58'! -createClassNamed: aName subclassOf: superclass instanceVariableNames: instanceVariables - - ^self - createClassNamed: aName - subclassOf: superclass - instanceVariableNames: instanceVariables - classVariableNames: '' - poolDictionaries: '' - category: self classCategoryOfTestData. -! ! + 3 timesRepeat: [ + allMessages do: [ :symbol | + subject add: symbol. + controlGroup add: symbol ]]. -!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:32:28'! -createClassNamed: aName subclassOf: superclass instanceVariableNames: instanceVariables classVariableNames: classVariables poolDictionaries: poolDictionaries category: category + subject add: 'doNotRemove2'. + controlGroup add: 'doNotRemove2'. - self assert: (Smalltalk classNamed: aName) isNil description: 'Class ', aName, ' already exists'. - - classCategories add: category. + self assert: subject isEquivalentToSet: controlGroup. - ^superclass - subclass: aName - instanceVariableNames: instanceVariables - classVariableNames: classVariables - poolDictionaries: poolDictionaries - category: category -! ! - -!DynamicallyCodeCreationTest methodsFor: 'assertions' stamp: 'HAW 12/17/2019 10:32:57'! -assertAllClassCategoriesAreExpectedToBeRemoved + allMessages do: [ :symbol | + subject remove: symbol. + controlGroup remove: symbol ]. - "I'm using a halt instead of assert or error becuase I want the programmer to see what class category - was not defined in allClassCategoriesOfTestData - Hernan" - (classCategories difference: self allClassCategoriesOfTestData) notEmpty ifTrue: [ self halt: #allClassCategoriesOfTestData asString, ' is not implemented correctly' ] - ! ! + copy _ Set new. + subject do: [ :symbol | + copy add: symbol ]. -!DynamicallyCodeCreationTest methodsFor: 'assertions' stamp: 'HAW 12/17/2019 10:33:05'! -assertCanRunTest - - self assertNoTestDataClassCategoryExist. - ! ! + self assert: subject isEquivalentToSet: copy. + self assert: copy isEquivalentToSet: controlGroup. -!DynamicallyCodeCreationTest methodsFor: 'assertions' stamp: 'HAW 12/17/2019 10:33:17'! -assertNoTestDataClassCategoryExist + subject remove: 'doNotRemove'. + controlGroup remove: 'doNotRemove'. - self allClassCategoriesOfTestData do: [ :aClassCategory | self denyExistsClassCategory: aClassCategory ] - ! ! + self assert: subject isEquivalentToSet: controlGroup. + self deny: subject isEmpty. + self deny: controlGroup isEmpty. -!DynamicallyCodeCreationTest methodsFor: 'assertions' stamp: 'HAW 12/17/2019 10:33:26'! -denyExistsClassCategory: aClassCategory - - self deny: (SystemOrganization hasCategory: aClassCategory) description: 'Can not run test because class category ', aClassCategory, ' already exists'! ! + subject remove: 'doNotRemove2'. + controlGroup remove: 'doNotRemove2'. -!DynamicallyCodeCreationTest methodsFor: 'setup/teardown' stamp: 'HAW 12/17/2019 10:33:36'! -setUp + self assert: subject isEquivalentToSet: controlGroup. + self assert: subject isEmpty. + self assert: controlGroup isEmpty.! ! - "If the authorInitials are not set, they will be asked - Hernan" - UISupervisor whenUIinSafeState: [ Utilities authorInitials ]. - "Because I'm using the same system to create classes and removed them with its category at tearDown, I want to be sure - I will not remove something I don't have too - Hernan" - setUpAssertionsPassed := false. - self assertCanRunTest. - setUpAssertionsPassed := true. +!TrieTest methodsFor: 'testing' stamp: 'jmv 6/22/2011 15:42'! +testSetProtocol + " + TrieTest new testSetProtocol + " + | subject controlGroup | + subject _ Trie new. + controlGroup _ Set new. + self assert: subject isEquivalentToSet: controlGroup. - classCategories := Set new.! ! - -!DynamicallyCodeCreationTest methodsFor: 'setup/teardown' stamp: 'HAW 12/17/2019 10:33:41'! -tearDown + subject add: 'car'. + controlGroup add: 'car'. + self assert: subject isEquivalentToSet: controlGroup. - setUpAssertionsPassed ifTrue: [ - self assertAllClassCategoriesAreExpectedToBeRemoved. - SystemOrganization removeSystemCategories: classCategories. - "I commented this becuase it took too much time and the only ones runing these tests - are the ones developing refactorings that know about creating/removing test data category - Hernan - Browser allInstancesDo: [:aBrowser | aBrowser changed: #systemCategoryList ]"]! ! + subject add: 'car'. + controlGroup add: 'car'. + self assert: subject isEquivalentToSet: controlGroup. -!DynamicallyCodeCreationTest class methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:34:07'! -classCategoryOfTestData - - ^ '__Refactoring-TestData__'! ! + subject add: 'cat'. + controlGroup add: 'cat'. + self assert: subject isEquivalentToSet: controlGroup. -!CompilerTest methodsFor: 'emulating' stamp: 'HAW 12/17/2019 11:00:59'! -correctFrom: start to: end with: aReplacement - - | newSourceCode | - - newSourceCode := sourceCode first: start - 1. - newSourceCode := newSourceCode, aReplacement. - newSourceCode := newSourceCode, (sourceCode copyFrom: end + 1 to: sourceCode size). - - sourceCode := newSourceCode ! ! + subject add: 'cart'. + controlGroup add: 'cart'. + self assert: subject isEquivalentToSet: controlGroup. -!CompilerTest methodsFor: 'emulating' stamp: 'cwp 8/25/2009 20:23'! -selectFrom: start to: end - ! ! + subject add: 'ñandú'. + controlGroup add: 'ñandú'. + self assert: subject isEquivalentToSet: controlGroup. -!CompilerTest methodsFor: 'emulating' stamp: 'HAW 6/18/2020 15:27:24'! -selectInvisiblyFrom: start to: stop -! ! + subject add: 'ñandu'. + controlGroup add: 'ñandu'. + self assert: subject isEquivalentToSet: controlGroup. -!CompilerTest methodsFor: 'emulating' stamp: 'cwp 8/25/2009 20:22'! -selectionInterval - ^ 1 to: 0! ! + subject add: 'ÑANDÚ'. + controlGroup add: 'ÑANDÚ'. + self assert: subject isEquivalentToSet: controlGroup.! ! -!CompilerTest methodsFor: 'emulating' stamp: 'HAW 12/17/2019 10:53:27'! -text - - ^ sourceCode ! ! - -!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 15:44:13'! -testCanNotDefineVarsInsideBackTick +!TrieUnicodeTest methodsFor: 'testing' stamp: 'jmv 6/6/2022 11:47:11'! +test01 + | t all | + t _ Trie new. + t add: #toto. + t at: #toton put: 47. + t add: 'carrr'. + t at: 'car' put: Float pi. + t at: 'cat' put: Date today. + self assert: (t includesKey: 'car'). + self deny: (t includes: 'car'). + self assert: (t includesKey: 'cat'). + self deny: (t includes: 'cat'). + self assert: (t includes: #toto). + self assert: (t includes: 'toto'). + all _ Array streamContents: [ :strm | + t keysAndValuesDo: [ :k :v | strm nextPut: {k. k class. v. v class} ]]. + self assert: all size = 5. + self assert: (all includes: {#toto. Symbol. #toto. Symbol}). + self assert: (all includes: {#toton. Symbol. 47. SmallInteger}). + self assert: (all includes: {'carrr'. String. 'carrr'. String}). + self assert: (all includes: {'car'. String. Float pi. SmallFloat64}). + self assert: (all includes: {'cat'. String. Date today. Date}).! ! - self - should: [ self class compile: 'm1 `|v1| v1 := 1`' ] - raise: SyntaxErrorNotification - withExceptionDo: [ :anError | - self assert: (anError messageText includesSubString: 'expression expected') ]! ! +!TrieUnicodeTest methodsFor: 'testing' stamp: 'jmv 6/6/2022 12:13:02'! +test02 + | t all | + t _ Trie new. + t add: #toto. + t at: #toton put: 47. + t add: 'carrrs'. + t add: 'carrr' asUtf8String. + t at: 'car' asUtf8String put: Float pi. + t at: 'cat' put: Date today. + self assert: (t includesKey: 'carrrs'). + self assert: (t includes: 'carrrs'). + self assert: (t includesKey: 'carrrs' asUtf8String). + self assert: (t includes: 'carrrs' asUtf8String). + self assert: (t includesKey: 'carrr'). + self assert: (t includes: 'carrr'). + self assert: (t includesKey: 'carrr' asUtf8String). + self assert: (t includes: 'carrr' asUtf8String). + self assert: (t includesKey: 'car'). + self deny: (t includes: 'car'). + self assert: (t includesKey: 'cat'). + self deny: (t includes: 'cat'). + self assert: (t includes: #toto). + self assert: (t includes: 'toto'). + all _ Array streamContents: [ :strm | + t keysAndValuesDo: [ :k :v | strm nextPut: {k. k class. v. v class} ]]. + self assert: all size = 6. + self assert: (all includes: {#toto. Symbol. #toto. Symbol}). + self assert: (all includes: {#toton. Symbol. 47. SmallInteger}). + self assert: (all includes: {'carrrs'. String. 'carrrs'. String}). + self assert: (all includes: {'carrr'. Utf8String. 'carrr'. Utf8String}). + self assert: (all includes: {'car'. Utf8String. Float pi. SmallFloat64}). + self assert: (all includes: {'cat'. String. Date today. Date}).! ! -!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 16:08:17'! -testCanNotHaveMoreThanOneExpressionInsideBackTick +!TrieUnicodeTest methodsFor: 'testing' stamp: 'jmv 6/6/2022 12:09:17'! +test03 + | t all s1 s2 | + t _ Trie new. + s1 _ ('totoU', Random next mantissaPart printString) asUtf8String asSymbol. + t add: s1. + s2 _ ('totoUn', Random next mantissaPart printString) asUtf8String asSymbol. + t at: s2 put: 47. + t add: 'carrr' asUtf8String. + t at: 'car' put: Float pi. + t at: 'cat' asUtf8String put: Date today. + self assert: (t includesKey: 'car'). + self deny: (t includes: 'car'). + self assert: (t includesKey: 'cat'). + self deny: (t includes: 'cat'). + self assert: (t includes: s1). + self assert: (t includes: s1 asString). + all _ Array streamContents: [ :strm | + t keysAndValuesDo: [ :k :v | strm nextPut: {k. k class. v. v class} ]]. + self assert: all size = 5. + self assert: (all includes: {s1. Utf8Symbol. s1. Utf8Symbol}). + self assert: (all includes: {s2. Utf8Symbol. 47. SmallInteger}). + self assert: (all includes: {'carrr'. Utf8String. 'carrr'. Utf8String}). + self assert: (all includes: {'car'. String. Float pi. SmallFloat64}). + self assert: (all includes: {'cat'. Utf8String. Date today. Date}).! ! - self - should: [ self class compile: 'm1 `1 factorial. 1 factorial`' ] - raise: SyntaxErrorNotification - withExceptionDo: [ :anError | - self assert: (anError messageText includesSubString: 'backtick expected') ]! ! +!FileIOAccessorTest methodsFor: 'private' stamp: 'jmv 5/31/2016 10:30'! +defaultDirectoryPath + ^DirectoryEntry currentDirectory pathName! ! -!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 16:09:28'! -testCanNotHaveReturnInsideBackTick +!FileIOAccessorTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:48'! +testDirectoryExists + "FileIOAccessorTest debug: #testDirectoryExists" + | subDirString dirString | + subDirString := 99999 atRandom asString. + dirString := self defaultDirectoryPath, FileIOAccessor default slash, subDirString. - self - should: [ self class compile: 'm1 `^10`' ] - raise: SyntaxErrorNotification - withExceptionDo: [ :anError | - self assert: (anError messageText includesSubString: 'expression expected') ]! ! + FileIOAccessor default createDirectory: dirString. -!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 15:41:08'! -testCanNotReferenceSelfInsideBackTick + self should: [ dirString asDirectoryEntry exists ]. - self - should: [ self class compile: 'm1 `self`' ] - raise: SyntaxErrorNotification - withExceptionDo: [ :anError | - self assert: (anError messageText includesSubString: - (BacktickNode canNotReferencePseudoVarInsideBacktickErrorDescriptionFor: 'self')) ]! ! + FileIOAccessor default deleteDirectory: dirString. -!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 15:41:13'! -testCanNotReferenceSuperInsideBackTick + self shouldnt: [ dirString asDirectoryEntry exists ].! ! - self - should: [ self class compile: 'm1 `super`' ] - raise: SyntaxErrorNotification - withExceptionDo: [ :anError | - self assert: (anError messageText includesSubString: - (BacktickNode canNotReferencePseudoVarInsideBacktickErrorDescriptionFor: 'super')) ]! ! +!FileManTest methodsFor: 'private' stamp: 'jmv 5/31/2016 10:28'! +directoryEntryForTest + ^'./fmTestDir' asDirectoryEntry! ! -!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 15:45:04'! -testCanNotReferenceTempVarsInsideBackTick +!FileManTest methodsFor: 'private' stamp: 'jmv 5/31/2016 10:28'! +randomFileName + ^100000 atRandom asString, '.fmtst'! ! - self - should: [ self class compile: 'm1 |v1| `v1 := 1`' ] - raise: SyntaxErrorNotification - withExceptionDo: [ :anError | - self assert: (anError messageText includesSubString: 'Can not evaluate code') ]! ! +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:49'! +testAbsolutePath + "FileManTest debug: #testAbsolutePath" + | dirEntry dirEntry1 dirEntry2 dirEntry3 dirEntry4 | + dirEntry := '/' asDirectoryEntry. + self should: [dirEntry = ':' asDirectoryEntry]. + self should: [dirEntry = '\' asDirectoryEntry]. + + dirEntry1 := '/temp/' asDirectoryEntry. + self should: [dirEntry1 = ':temp' asDirectoryEntry]. + self should: [dirEntry1 = '\temp' asDirectoryEntry]. -!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 15:41:18'! -testCanNotReferenceThisContextInsideBackTick + dirEntry2 := '/temp/a' asDirectoryEntry. + self should: [dirEntry2 = ':temp:a' asDirectoryEntry]. + self should: [dirEntry2 = '\temp\a' asDirectoryEntry]. - self - should: [ self class compile: 'm1 `thisContext`' ] - raise: SyntaxErrorNotification - withExceptionDo: [ :anError | - self assert: (anError messageText includesSubString: - (BacktickNode canNotReferencePseudoVarInsideBacktickErrorDescriptionFor: 'thisContext')) ]! ! + dirEntry3 := 'C:/temp/b' asDirectoryEntry. + self should: [dirEntry3 = 'C:\temp\b' asDirectoryEntry]. + self should: [dirEntry3 = 'C::temp:b' asDirectoryEntry]. -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'EB 12/20/2019 20:54:26'! -testAddsMoreThanOneUndeclaredVariableCorrectlyInBlock + "Platform specific path tests" + FileIOAccessor default onMacClassic ifTrue: [ + dirEntry4 := 'Macintosh HD:tmp' asDirectoryEntry. + self should: [dirEntry4 = 'Macintosh HD/tmp' asDirectoryEntry]. + self should: [dirEntry4 = 'Macintosh HD\tmp' asDirectoryEntry]. + ]. - | testClass | - testClass := self createTestClass. - sourceCode := 'griffle [ var1 := 1. goo := 1. ^goo + var1 ]'. - [ testClass compile: sourceCode notifying: self ] - on: UndeclaredVariable - do: [ :anUndeclaredVariable | - anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. - - self assert: 'griffle [ | goo var1 | var1 := 1. goo := 1. ^goo + var1 ]' equals: sourceCode -! ! + ! ! -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 17:15:47'! -testAddsUndeclaredVariableCorrectlyInBlockWhenNoSpaceBetweenLastOneAndPipe +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:49'! +testAtPut + "FileManTest debug: #testAtPut" + | dir bytes | + dir := self directoryEntryForTest. + dir at: 'test1' put: 'Hello'. + self should: [(dir at: 'test1') = 'Hello']. + self should: [dir includesKey: 'test1']. - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle [|var1| var1 := 1.goo := 1.^ goo + var1]'. - - [ testClass compile: sourceCode notifying: self ] - on: UndeclaredVariable - do: [ :anUndeclaredVariable | - anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. - - self assert: 'griffle [|var1 goo | var1 := 1.goo := 1.^ goo + var1]' equals: sourceCode! ! + bytes := #(1 2 3 4 5 6) asByteArray. + dir binaryAt: 'test2' put: bytes. + self should: [(dir binaryAt: 'test2') = bytes]. + self should: [dir includesKey: 'test2']. -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'EB 1/27/2020 00:10:26'! -testAddsUndeclaredVariableCorrectlyInBlockWhenTheresAnArgumentAlready + dir removeKey: 'test1'. - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle [ :var1 | goo := 1.^ goo + var1]'. - - [ testClass compile: sourceCode notifying: self ] - on: UndeclaredVariable - do: [ :anUndeclaredVariable | - anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. - - self assert: 'griffle [ :var1 | | goo | goo := 1.^ goo + var1]' equals: sourceCode! ! + self shouldnt: [dir includesKey: 'test1']. -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'EB 1/27/2020 02:46:02'! -testAddsUndeclaredVariableCorrectlyInBlockWhenTheresArgumentsAndTempDeclarationPipesWithNoTemps + dir recursiveDelete. + self should: [dir exists not]! ! - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle [ :var1 | | | goo := 1.^ goo + var1]'. - - [ testClass compile: sourceCode notifying: self ] - on: UndeclaredVariable - do: [ :anUndeclaredVariable | - anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. - - self assert: 'griffle [ :var1 | | goo | goo := 1.^ goo + var1]' equals: sourceCode! ! +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:49'! +testConcatenation + " + FileManTest debug: #testConcatenation + " + | dir | + dir := ('./subDir' asDirectoryEntry / 'aaa/bbb' / 'ccc' / 'ddd\eee' / 'fff:ggg'). + dir at: 'test1' put: 'RecursiveDeleted!!'. -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'EB 12/20/2019 20:55:29'! -testAddsUndeclaredVariableCorrectlyInMethodAndInBlock + self assert: dir name = 'ggg'. + self assert: dir parent name = 'fff'. + self assert: dir parent parent name = 'eee'. + self assert: dir parent parent parent name = 'ddd'. + self assert: dir parent parent parent parent name = 'ccc'. + self assert: dir parent parent parent parent parent name = 'bbb'. + self assert: dir parent parent parent parent parent parent name = 'aaa'. - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle var1 := 1. [ goo := 1. ^goo + var1 ]'. - - [ testClass compile: sourceCode notifying: self ] - on: UndeclaredVariable - do: [ :anUndeclaredVariable | - anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. - - self assert: 'griffle | var1 |', String newLineString, 'var1 := 1. [ | goo | goo := 1. ^goo + var1 ]' equals: sourceCode! ! + './subDir' asDirectoryEntry recursiveDelete. + self shouldnt: [dir exists]. + self shouldnt: ['./subDir' asDirectoryEntry exists].! ! -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 17:15:27'! -testAddsUndeclaredVariableCorrectlyInMethodWhenNoSpaceBetweenLastOneAndPipe +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:49'! +testCopy + "FileManTest debug: #testCopy" + | file1 file2 | + file1 := self randomFileName asFileEntry. + file2 := file1 parent // self randomFileName. - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle |var1| var1 := 1.goo := 1.^ goo + var1'. - - [ testClass compile: sourceCode notifying: self ] - on: UndeclaredVariable - do: [ :anUndeclaredVariable | - anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. - - self assert: 'griffle |var1 goo | var1 := 1.goo := 1.^ goo + var1' equals: sourceCode! ! + file1 fileContents: 'This is a test'. -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 17:18:11'! -testAddsUndeclaredVariableInRightBlock - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle [|goo| goo := 1. ^goo ]. [goo1:=1.^ goo1]'. - - [ testClass compile: sourceCode notifying: self ] - on: UndeclaredVariable - do: [ :anUndeclaredVariable | - anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. - - self assert: 'griffle [|goo| goo := 1. ^goo ]. [ | goo1 |goo1:=1.^ goo1]' equals: sourceCode! ! +" self should: [file2 fileContents isEmpty]." + self should: [file2 exists not]. -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'EB 1/27/2020 00:31:46'! -testAddsUndeclaredVariableWithAnArgumentAndTempAlreadyInBlock + file1 copyTo: file2 pathName. - | testClass | + self should: [file2 fileContents = 'This is a test']. + + file1 delete. + file2 delete. + self should: [file1 exists not]. + self should: [file2 exists not] - testClass := self createTestClass. - sourceCode := 'griffle [ :var1 | | foo | foo := 2. goo := 1.^ goo + var1 + foo ]'. - [ testClass compile: sourceCode notifying: self ] - on: UndeclaredVariable - do: [ :anUndeclaredVariable | - anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. - - self assert: 'griffle [ :var1 | | foo goo | foo := 2. goo := 1.^ goo + var1 + foo ]' equals: sourceCode! ! - -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:06:40'! -testDoesNotConfusesVariablesWithSameNameOfDifferentBlocksWhenRemoving + ! ! - | testClass counter | +!FileManTest methodsFor: 'testing' stamp: 'jmv 6/1/2016 17:17'! +testDefaultDirectory + " + FileManTest debug: #testDefaultDirectory + " - testClass := self createTestClass. - sourceCode := 'griffle [ | goo | ]. [ | goo | ]'. - counter := 0. - [testClass compile: sourceCode notifying: self] - on: UnusedVariable - do: [ :unusedVariable | - self assert: 'goo' equals: unusedVariable name. - counter := counter + 1. - unusedVariable resume: counter = 1 ]. - - self assert: 'griffle [ ]. [ | goo | ]' equals: sourceCode.! ! + | pathComponents | -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:07:39'! -testDoesNotRemoveUnusedVariableIfSaidSo + " + See #asAbsolutePathName. See #isAbsolutePathName + self assert: '' asDirectoryEntry = DirectoryEntry currentDirectory. + " - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle | goo |'. - - [testClass compile: sourceCode notifying: self] - on: UnusedVariable - do: [ :unusedVariable | - self assert: 'goo' equals: unusedVariable name. - unusedVariable resume: false ]. - - self assert: 'griffle | goo |' equals: sourceCode.! ! + pathComponents := '' asDirectoryEntry pathComponents. + self assert: pathComponents = DirectoryEntry currentDirectory pathComponents! ! -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:12:44'! -testKeepsVariableDefinitionWhenThereAreUsedTemporaries +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:49'! +testFileContents + "FileManTest debug: #testFileContents" + | file1 file2 bytes | + file1 := self randomFileName asFileEntry. + file1 fileContents: 'This is a test'. + self should: [file1 fileContents = 'This is a test']. + file1 delete. + self should: [file1 exists not]. - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle | goo a | a := 1. ^a'. + file2 := self randomFileName asFileEntry. + bytes := #(1 2 3 4 5 6) asByteArray. + file2 fileContents: bytes. + self should: [file2 fileContents = bytes asString]. + self should: [file2 binaryContents = bytes]. + file2 delete. + self should: [file2 exists not]! ! + +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:49'! +testIsAbsolutePathName + " + FileManTest debug: #testIsAbsolutePathName + " + self assert: '/' isAbsolutePathName. + self assert: '/temp/' isAbsolutePathName. + self assert: '/temp/a' isAbsolutePathName. + Smalltalk platformName = 'Win32' ifTrue: [ + self assert: 'C:/temp/b' isAbsolutePathName ]. + FileIOAccessor default onMacClassic ifTrue: [ + self assert: 'Macintosh HD/tmp' isAbsolutePathName ]. - [testClass compile: sourceCode notifying: self] - on: UnusedVariable - do: [ :unusedVariable | - self assert: 'goo' equals: unusedVariable name. - unusedVariable resume: true ]. - - self assert: 'griffle | a | a := 1. ^a' equals: sourceCode.! ! + self deny: './' isAbsolutePathName. + self deny: '../' isAbsolutePathName. + self deny: 'afile' isAbsolutePathName.! ! -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:03:46'! -testRemovesUnusedVariablesFromBlocks +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:50'! +testIsRelativePathName + " + FileManTest debug: #testIsRelativePathName + " + self assert: './' isRelativePathName. + self assert: '../' isRelativePathName. +" self assert: 'afile' isRelativePathName." + self deny: '/' isRelativePathName. + self deny: '/temp/' isRelativePathName. + self deny: '/temp/a' isRelativePathName. + self deny: 'C:/temp/b' isRelativePathName. + self deny: 'Macintosh HD/tmp' isRelativePathName.! ! - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle [ | goo | ]'. - - [testClass compile: sourceCode notifying: self] - on: UnusedVariable - do: [ :unusedVariable | - self assert: 'goo' equals: unusedVariable name. - unusedVariable resume: true ]. - - self assert: 'griffle [ ]' equals: sourceCode.! ! +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:50'! +testPathComponents + " + FileManTest debug: #testPathComponents + " + | pathComponents | -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:01:28'! -testRemovesVariableDefinitionWhenNoMoreUnusedTemporaries + pathComponents := './aaa/bbb\ccc:ddd' asDirectoryEntry pathComponents. + pathComponents := pathComponents last: 4. + self assert: pathComponents asArray = #('aaa' 'bbb' 'ccc' 'ddd'). - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle | goo |'. - - [testClass compile: sourceCode notifying: self] - on: UnusedVariable - do: [ :unusedVariable | - self assert: 'goo' equals: unusedVariable name. - unusedVariable resume: true ]. - - self assert: 'griffle ' equals: sourceCode.! ! + pathComponents := '/aaa/bbb\ccc:ddd' asDirectoryEntry pathComponents. + pathComponents := pathComponents last: 4. + self assert: pathComponents asArray = #('aaa' 'bbb' 'ccc' 'ddd'). -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 17:13:33'! -testReusesBlockTempDeclarationWhenEmptyForUndeclaredVariable + pathComponents := 'aaa/bbb\ccc:ddd' asDirectoryEntry pathComponents. + pathComponents := pathComponents last: 4. + self assert: pathComponents asArray = #('aaa' 'bbb' 'ccc' 'ddd')! ! - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle [ || goo := 1.^ goo ]'. - - [ testClass compile: sourceCode notifying: self ] - on: UndeclaredVariable - do: [ :anUndeclaredVariable | - anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. - - self assert: 'griffle [ | goo | goo := 1.^ goo ]' equals: sourceCode! ! +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:50'! +testPipe + "FileManTest debug: #testPipe" + | reverseFilter file1 file2 file3 | -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 17:12:52'! -testReusesMethodTempDeclarationWhenEmptyForUndeclaredVariable + reverseFilter := [:in :out | out nextPutAll: (in upToEnd reverse)]. - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle || goo := 1.^ goo'. - - [ testClass compile: sourceCode notifying: self ] - on: UndeclaredVariable - do: [ :anUndeclaredVariable | - anUndeclaredVariable resume: anUndeclaredVariable declareMethodTempAction ]. - - self assert: 'griffle | goo | goo := 1.^ goo' equals: sourceCode! ! + file1 := self randomFileName asFileEntry. + file2 := self randomFileName asFileEntry. + file3 := self randomFileName asFileEntry. -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 17:12:34'! -testUndeclaredVariableIsSignaledForUndeclaredVariables + file1 fileContents: 'This is a pipe test'. - | testClass | - - testClass := self createTestClass. - - self - should: [ testClass compile: 'griffle ^ goo' notifying: self ] - raise: UndeclaredVariable - withExceptionDo: [ :anUndeclaredVariable | - self assert: 'goo' equals: anUndeclaredVariable name ]! ! + file1 pipe: reverseFilter to: file2 pathName. -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:09:35'! -testUndefinedVariableIsSignaledForVariablesDefinedButNotInitialized + self should: [('.' asDirectoryEntry at: file1 name) = 'This is a pipe test']. + self should: [(file2 fileContents) = 'tset epip a si sihT']. +" self should: [(file3 fileContents) isEmpty]." + self should: [file3 exists not]. - | testClass | + file2 pipe: reverseFilter to: file3 pathName. + self should: [(file3 fileContents) = 'This is a pipe test']. + + file1 delete. + file2 delete. + file3 delete. + self should: [file1 exists not]. + self should: [file2 exists not]. + self should: [file3 exists not] - testClass := self createTestClass. + + ! ! - self - should: [testClass compile: 'griffle | goo | ^ goo' notifying: self] - raise: UndefinedVariable - withExceptionDo: [ :anUndefinedVariable | - self assert: 'goo' equals: anUndefinedVariable name ]! ! +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:50'! +testRecursiveDelete + "FileManTest debug: #testRecursiveDelete" + | dir | + dir := ('./subDir' asDirectoryEntry / 'aaa\bbb' / 'ccc' / 'ddd\eee' / 'fff:ggg'). + dir at: 'test1' put: 'RecursiveDelete!!'. + self should: [(dir at: 'test1') = 'RecursiveDelete!!']. -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:10:53'! -testUnknownSelectorIsSignalForMessagesSendNotImplemented + dir removeKey: 'test1'. - | testClass unknowSelector | - - testClass := self createTestClass. - unknowSelector := 'reallyHopeThisIsntImplementedAnywhere'. - - self - should: [ testClass - compile: 'griffle self ', unknowSelector - notifying: self] - raise: UnknownSelector - withExceptionDo: [ :anUnknowSelector | - self assert: unknowSelector equals: anUnknowSelector name ]! ! + self shouldnt: [(dir // 'test1') exists]. -!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:11:49'! -testUnusedVariableIsSignaledForUnusedVariables + './subDir' asDirectoryEntry recursiveDelete. + self shouldnt: [dir exists]. + self shouldnt: ['./subDir' asDirectoryEntry exists]. - | testClass | - - testClass := self createTestClass. - sourceCode := 'griffle | goo |'. - - self - should: [testClass compile: sourceCode notifying: self] - raise: UnusedVariable - withExceptionDo: [ :unusedVariable | - self assert: 'goo' equals: unusedVariable name ] -! ! + ! ! -!CompilerTest methodsFor: 'private' stamp: 'HAW 12/17/2019 10:38:10'! -createTestClass +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:50'! +testRefresh + "FileManTest debug: #testRefresh" + | file1 | + file1 := self randomFileName asFileEntry. + + file1 fileContents: '1234567890'. + self should: [file1 fileSize = 10]. + + file1 fileContents: '123'. + self should: [file1 fileSize = 3]. - ^self createClassNamed: #CompilerTestDataClass__! ! -!CompilerTest methodsFor: 'private' stamp: 'cwp 8/25/2009 20:28'! -unusedVariableSource - ^ 'griffle - | goo | - ^ nil'! ! + file1 delete. + self should: [file1 exists not]. + ! ! -!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/5/2021 22:02:42'! -test01FindsSelectionOnSourceMethod +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 10:50'! +testRename + "FileManTest debug: #testRename" + | file1 | + file1 := self randomFileName asFileEntry. + file1 fileContents: 'ToBeRenamed'. - | sourceMethodName finder methodsToExtractFrom sourceMethod | - - sourceMethodName := classToRefactor compile: 'm1 10'. - - sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. - finder := ExtractMethodReplacementsFinder ofCodeIn: (4 to: 5) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). - finder value. - - self assert: finder hasOneReplacement. - methodsToExtractFrom := finder replacements. - - self assert: 1 equals: methodsToExtractFrom size. - self assert: (4 to: 5) equals: methodsToExtractFrom first intervalToExtract. - self assert: sourceMethod equals: methodsToExtractFrom first methodToExtractFrom.! ! + self shouldnt: [file1 name = 'newName1']. -!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/5/2021 22:02:49'! -test02FindsRepetitionsAfterSelection + file1 rename: 'newName1'. - | sourceMethodName finder methodsToExtractFrom sourceMethod replacement | - - sourceMethodName := classToRefactor compile: 'm1 10. 10'. - - sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. - finder := ExtractMethodReplacementsFinder ofCodeIn: (4 to: 5) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). - finder value. - - self deny: finder hasOneReplacement. - methodsToExtractFrom := finder replacements. - - self assert: 2 equals: methodsToExtractFrom size. - replacement := methodsToExtractFrom first. - self assert: (4 to: 5) equals: replacement intervalToExtract. - self assert: (replacement isOf: sourceMethod). - - replacement := methodsToExtractFrom second. - self assert: (8 to: 9) equals: replacement intervalToExtract. - self assert: (replacement isOf: sourceMethod).! ! + self should: [file1 name = 'newName1']. + self should: [file1 exists]. -!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/5/2021 22:02:58'! -test03FindsRepetitionsBeforeSelection + self should: [file1 fileContents = 'ToBeRenamed']. - | sourceMethodName finder methodsToExtractFrom sourceMethod replacement | - - sourceMethodName := classToRefactor compile: 'm1 10. 10'. - - sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. - finder := ExtractMethodReplacementsFinder ofCodeIn: (8 to: 9) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). - finder value. - - self deny: finder hasOneReplacement. - methodsToExtractFrom := finder replacements. - - self assert: 2 equals: methodsToExtractFrom size. - replacement := methodsToExtractFrom first. - self assert: (4 to: 5) equals: replacement intervalToExtract. - self assert: (replacement isOf: sourceMethod). - - replacement := methodsToExtractFrom second. - self assert: (8 to: 9) equals: replacement intervalToExtract. - self assert: (replacement isOf: sourceMethod). + file1 delete. + self should: [file1 exists not]. ! ! -!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/5/2021 22:03:07'! -test04DoesNotIncludeComments +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 12:02'! +testRoot + "FileManTest debug: #testRoot" + | root | + root := DirectoryEntry roots first. + self should: [root pathComponents isEmpty]. + FileIOAccessor default onUnix ifTrue: [ + self should: [root = '\' asDirectoryEntry]. + self should: [root = ':' asDirectoryEntry]. + self should: [root = '/' asDirectoryEntry]]! ! - | sourceMethodName finder methodsToExtractFrom sourceMethod replacement | - - sourceMethodName := classToRefactor compile: 'm1 10. "10"'. - - sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. - finder := ExtractMethodReplacementsFinder ofCodeIn: (4 to: 5) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). - finder value. - - self assert: finder hasOneReplacement. - methodsToExtractFrom := finder replacements. - - self assert: 1 equals: methodsToExtractFrom size. - replacement := methodsToExtractFrom first. - self assert: (4 to: 5) equals: replacement intervalToExtract. - self assert: (replacement isOf: sourceMethod). - - ! ! +!FileManTest methodsFor: 'testing' stamp: 'jmv 5/31/2016 11:19'! +testStream + "FileManTest debug: #testStream" + | file1 contents formerContents allContents | + file1 := self randomFileName asFileEntry. + file1 writeStreamDo: [:str | str nextPutAll: 'HELLO!!']. + contents := file1 readStreamDo: [:str | str upToEnd]. + self should: [contents = 'HELLO!!']. -!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/5/2021 22:03:14'! -test05DoesNotIncludeNotExtractableSourceCode + file1 appendStreamDo: [:str | str nextPutAll: 'AGAIN!!']. - | sourceMethodName finder methodsToExtractFrom sourceMethod replacement | - - sourceMethodName := classToRefactor compile: 'm1 10. 100'. - - sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. - finder := ExtractMethodReplacementsFinder ofCodeIn: (4 to: 5) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). - finder value. - - self assert: finder hasOneReplacement. - methodsToExtractFrom := finder replacements. - - self assert: 1 equals: methodsToExtractFrom size. - replacement := methodsToExtractFrom first. - self assert: (4 to: 5) equals: replacement intervalToExtract. - self assert: (replacement isOf: sourceMethod).! ! + formerContents := file1 readStreamDo: [:str | str upTo:$!!]. + self should: [formerContents = 'HELLO']. -!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/8/2021 21:34:35'! -test06FindsRepetitionsInOtherClassMethods + allContents := file1 readStreamDo: [:str | str upToEnd]. + self should: [allContents = 'HELLO!!AGAIN!!']. - | sourceMethodName finder methodsToExtractFrom sourceMethod replacement | - - sourceMethodName := classToRefactor compile: 'm1 10'. - classToRefactor compile: 'm1b 100+10'. - - sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. - finder := ExtractMethodReplacementsFinder ofCodeIn: (4 to: 5) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). - finder value. - - self deny: finder hasOneReplacement. - methodsToExtractFrom := finder replacements. - - self assert: 2 equals: methodsToExtractFrom size. - replacement := methodsToExtractFrom detect: [ :aReplacement | aReplacement isOf: sourceMethod ]. - self assert: (4 to: 5) equals: replacement intervalToExtract. - - replacement := methodsToExtractFrom detect: [ :aReplacement | aReplacement isOf: (classToRefactor >> #m1b) asMethodReference ]. - self assert: (9 to: 10) equals: replacement intervalToExtract. - + file1 delete. + self should: [file1 exists not]. ! ! -!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/8/2021 21:36:53'! -test07FindsRepetitionsInSubclassesMethods - - | sourceMethodName finder methodsToExtractFrom sourceMethod replacement subclassToRefactor | +!CuisSourceFileArrayTest methodsFor: 'testing' stamp: 'jmv 5/22/2011 23:57'! +testAddressRange + "Test source pointer to file position address translation across the full address range" - sourceMethodName := classToRefactor compile: 'm1 10. 10'. - classToRefactor compile: 'm1b 100+10'. - subclassToRefactor := self createClassNamed: self subclassToRefactorName subclassOf: classToRefactor. - subclassToRefactor compile: 'm3 10'. - - sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. - finder := ExtractMethodReplacementsFinder ofCodeIn: (4 to: 5) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). - finder value. - - self deny: finder hasOneReplacement. - methodsToExtractFrom := finder replacements. - - self assert: 4 equals: methodsToExtractFrom size. - replacement := (methodsToExtractFrom select: [ :aReplacement | aReplacement isOf: sourceMethod ]) first. - self assert: (4 to: 5) equals: replacement intervalToExtract. - - replacement := (methodsToExtractFrom select: [ :aReplacement | aReplacement isOf: sourceMethod ]) second. - self assert: (8 to: 9) equals: replacement intervalToExtract. - - replacement := methodsToExtractFrom detect: [ :aReplacement | aReplacement isOf: (classToRefactor >> #m1b) asMethodReference ]. - self assert: (9 to: 10) equals: replacement intervalToExtract. - - replacement := methodsToExtractFrom detect: [ :aReplacement | aReplacement isOf: (subclassToRefactor >> #m3) asMethodReference ]. - self assert: (4 to: 5) equals: replacement intervalToExtract. - self assert:(replacement isOf: (subclassToRefactor >> #m3) asMethodReference) - ! ! - -!ExtractMethodFinderTest methodsFor: 'setup/teardown' stamp: 'HAW 9/2/2021 18:02:12'! -setUp - - super setUp. - classToRefactor := self createClassNamed: self classToRefactorName! ! - -!ExtractMethodFinderTest methodsFor: 'class names' stamp: 'HAW 9/2/2021 16:54:18'! -classToRefactorName - - ^#ClassToExtractMethod! ! + | sf | + sf := CuisSourceFileArray new. + (16r1000000 to: 16r4FFFFFF by: 811) do: [:e | | i a p | + i := sf fileIndexFromSourcePointer: e. + p := sf filePositionFromSourcePointer: e. + a := sf sourcePointerFromFileIndex: i andPosition: p. + self assert: a = e] +! ! -!ExtractMethodFinderTest methodsFor: 'class names' stamp: 'HAW 9/4/2021 20:53:12'! -subclassToRefactorName +!CuisSourceFileArrayTest methodsFor: 'testing' stamp: 'jmv 5/23/2011 00:08'! +testChangesFileAddressRange + "Test file position to source pointer address translation for the changes file" - ^#SubclassToExtractMethod! ! - -!RefactoringTest methodsFor: 'assertions' stamp: 'HAW 6/1/2017 19:01:00'! -assertCreation: aCreationBlock failsWith: aMessageTextCreator - - self - should: aCreationBlock - raise: self refactoringError - withMessageText: aMessageTextCreator ! ! - -!RefactoringTest methodsFor: 'assertions' stamp: 'HAW 6/1/2017 14:30:58'! -assertCreation: aCreationBlock warnsWith: aMessageTextCreator - - self - should: aCreationBlock - raise: self refactoringWarning - withMessageText: aMessageTextCreator ! ! + | sf a e | + sf := CuisSourceFileArray new. + (0 to: 16r1FFFFFF by: 811) do: [:ee | | a2 i p | + e _ ee // 32 * 32. + a := sf sourcePointerFromFileIndex: 2 andPosition: e. + i := sf fileIndexFromSourcePointer: a. + self assert: i = 2. + p := sf filePositionFromSourcePointer: a. + self assert: p = e. + a2 := sf sourcePointerFromFileIndex: 2 andPosition: p. + self assert: a2 = a]. + (0 to: 16rFFFFFF by: 811) do: [:ee | + e _ ee // 32 * 32. + a := sf sourcePointerFromFileIndex: 2 andPosition: e. + self assert: (a between: 16r3000000 and: 16r3FFFFFF)]. + (16r1000000 to: 16r1FFFFFF by: 811) do: [:ee | + e _ ee // 32 * 32. + a := sf sourcePointerFromFileIndex: 2 andPosition: e. + self assert: (a between: 16r3000000 and: 16r4FFFFFF)] -!RefactoringTest methodsFor: 'exceptions' stamp: 'HAW 8/17/2018 16:38:44'! -canNotRefactorDueToReferencesRefactoringError - - ^ Refactoring canNotRefactorDueToReferencesErrorClass - MessageNotUnderstood.! ! -!RefactoringTest methodsFor: 'exceptions' stamp: 'HAW 6/3/2017 11:58:26'! -refactoringError +! ! - ^ Refactoring refactoringErrorClass - MessageNotUnderstood.! ! +!CuisSourceFileArrayTest methodsFor: 'testing' stamp: 'jmv 5/23/2011 00:06'! +testFileIndexFromSourcePointer + "Test derivation of file index for sources or changes file from source pointers" -!RefactoringTest methodsFor: 'exceptions' stamp: 'HAW 6/3/2017 12:05:52'! -refactoringWarning + | sf | + sf := CuisSourceFileArray new. + "sources file mapping" + self assert: 1 = (sf fileIndexFromSourcePointer: 16r1000000). + self assert: 1 = (sf fileIndexFromSourcePointer: 16r1000013). + self assert: 1 = (sf fileIndexFromSourcePointer: 16r1FFFFFF). + self assert: 1 = (sf fileIndexFromSourcePointer: 16r2000000). + self assert: 1 = (sf fileIndexFromSourcePointer: 16r2000013). + self assert: 1 = (sf fileIndexFromSourcePointer: 16r2FFFFFF). + (16r1000000 to: 16r1FFFFFF by: 811) do: [:e | self assert: 1 = (sf fileIndexFromSourcePointer: e)]. + (16r2000000 to: 16r2FFFFFF by: 811) do: [:e | self assert: 1 = (sf fileIndexFromSourcePointer: e)]. + "changes file mapping" + self assert: 2 = (sf fileIndexFromSourcePointer: 16r3000000). + self assert: 2 = (sf fileIndexFromSourcePointer: 16r3000013). + self assert: 2 = (sf fileIndexFromSourcePointer: 16r3FFFFFF). + self assert: 2 = (sf fileIndexFromSourcePointer: 16r4000000). + self assert: 2 = (sf fileIndexFromSourcePointer: 16r4000013). + self assert: 2 = (sf fileIndexFromSourcePointer: 16r4FFFFFF). + (16r3000000 to: 16r3FFFFFF by: 811) do: [:e | self assert: 2 = (sf fileIndexFromSourcePointer: e)]. + (16r4000000 to: 16r4FFFFFF by: 811) do: [:e | self assert: 2 = (sf fileIndexFromSourcePointer: e)] - ^ Refactoring refactoringWarningClass - MessageNotUnderstood.! ! -!RefactoringTest methodsFor: 'exceptions' stamp: 'HAW 12/18/2019 16:02:50'! -referencesRefactoringWarning +! ! - ^ Refactoring referencesWarningClass - MessageNotUnderstood.! ! +!CuisSourceFileArrayTest methodsFor: 'testing' stamp: 'jmv 5/23/2011 00:09'! +testFilePositionFromSourcePointer + "Test derivation of file position for sources or changes file from source pointers" -!AddInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 6/11/2017 18:12:55'! -classToRefactorName + | sf | + sf := CuisSourceFileArray new. + "sources file" + self assert: 0 = (sf filePositionFromSourcePointer: 16r1000000). + "changes file" + self assert: 0 = (sf filePositionFromSourcePointer: 16r3000000).! ! - ^#ClassToAddInstVar! ! +!CuisSourceFileArrayTest methodsFor: 'testing' stamp: 'jmv 5/23/2011 00:10'! +testSourcePointerFromFileIndexAndPosition + "Test valid input ranges" -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:42:17'! -test01NewVariableNameCanNotBeEmpty + | sf | + sf := CuisSourceFileArray new. + self should: [sf sourcePointerFromFileIndex: 0 andPosition: 0] raise: Error. + self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 0] raise: Error. + self shouldnt: [sf sourcePointerFromFileIndex: 2 andPosition: 0] raise: Error. + self should: [sf sourcePointerFromFileIndex: 0 andPosition: 3] raise: Error. + self should: [sf sourcePointerFromFileIndex: 1 andPosition: -1] raise: Error. + self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF] raise: Error. + self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 16r2000000] raise: Error. + self should: [sf sourcePointerFromFileIndex: 3 andPosition: 0] raise: Error. + self should: [sf sourcePointerFromFileIndex: 4 andPosition: 0] raise: Error. - newVariable := ' '. - self - assertCreation: [ AddInstanceVariable named: newVariable to: self class ] - failsWith: [NewInstanceVariablePrecondition newVariableCanNotBeEmptyErrorMessage ] -! ! + self assert: 16r1000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 0). + self assert: 16r3000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 0).! ! -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:42:21'! -test02NewVariableNameCanNotContainBlanks +!CuisSourceFileArrayTest methodsFor: 'testing' stamp: 'jmv 5/23/2011 00:11'! +testSourcesFileAddressRange + "Test file position to source pointer address translation for the sources file" - newVariable := 'a b'. - self - assertCreation: [ AddInstanceVariable named: newVariable to: self class ] - failsWith: [NewInstanceVariablePrecondition errorMessageForInvalidInstanceVariable: newVariable ] - - ! ! - -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:42:25'! -test03NewVariableNameCanNotContainInvalidCharacters - - newVariable := '2a'. - self - assertCreation: [ AddInstanceVariable named: newVariable to: self class ] - failsWith: [NewInstanceVariablePrecondition errorMessageForInvalidInstanceVariable: newVariable ] + | sf a e | + sf := CuisSourceFileArray new. + (0 to: 16r1FFFFFF by: 811) do: [:ee | | a2 p i | + e _ ee // 32 * 32. + a := sf sourcePointerFromFileIndex: 1 andPosition: e. + i := sf fileIndexFromSourcePointer: a. + self assert: i = 1. + p := sf filePositionFromSourcePointer: a. + self assert: p = e. + a2 := sf sourcePointerFromFileIndex: 1 andPosition: p. + self assert: a2 = a]. + (0 to: 16rFFFFFF by: 811) do: [:ee | + e _ ee // 32 * 32. + a := sf sourcePointerFromFileIndex: 1 andPosition: e. + self assert: (a between: 16r1000000 and: 16r1FFFFFF)]. + (16r1000000 to: 16r1FFFFFF by: 811) do: [:ee | + e _ ee // 32 * 32. + a := sf sourcePointerFromFileIndex: 1 andPosition: e. + self assert: (a between: 16r1000000 and: 16r2FFFFFF)] ! ! -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 6/11/2017 18:38:49'! -test04ValidNewVariableNameGetBlanksTrimmed +!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:15:22'! +testUpTo1ShortRecords + ". this test ensures the upTo: delim method behaves as specified by the ANSI standard: + Delimiter is considered a separator (and therefore not required for the last chunk)." + |path fs| + path _ 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . + path asFileEntry fileContents: 'record-1Xrecord-2Xrecord-incomplete'. + fs _ path asFileEntry readStream . + self assert: ((fs upTo: $X) = 'record-1'). + self assert: ((fs upTo: $X) = 'record-2'). + self assert: ((fs upTo: $X) = 'record-incomplete'). + self assert: ((fs upTo: $X) = ''). + ". the stream has been all consumed" + self assert: (fs position = 35). + fs close . + path asFileEntry delete. - newVariable := ' a '. - - self assert: newVariable withBlanksTrimmed equals: (AddInstanceVariable named: newVariable to: self class) newVariable! ! + ! ! -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:42:31'! -test05NewVariableNameCanNotBeDefinedInClass +!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:14:45'! +testUpTo2IncompleteRecords + " + . This test stresses the motivation for introducing upTo:delimiterIsTerminator: + . if two separate processes are reading and writing records into the same file + upTo can potentially create a bit a of a mess by reading in half records and complete records. + . please compare to the equivalent testUpToTerminatorX to see what is probably the behaviour your are looking for + " + |path fs| + path _ 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . + " a process starts to write data into a file but it does not end cleanly the writing " + path asFileEntry fileContents: 'record-1Xrec'. + fs _ path asFileEntry readStream . + " upTo reads 'record-1' and the second time reads half a token " + self assert: ((fs upTo: $X) = 'record-1'). + self assert: ((fs upTo: $X) = 'rec'). + ". the writing process comes back online and terminates its record writing " + path asFileEntry appendContents: 'ord-2Xrecord-3X'. + ". upTo reads an half token and then a complete one " + self assert: ((fs upTo: $X) = 'ord-2'). + self assert: ((fs upTo: $X) = 'record-3'). + ". when there is nothing more to read upTo returns the empty string " + self assert: ((fs upTo: $X) = ''). + fs close . + path asFileEntry delete. - | classToRefactor | - - newVariable := 'a'. - classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: newVariable. - - self - assertCreation: [AddInstanceVariable named: newVariable to: classToRefactor ] - failsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariable: newVariable alreadyDefinedInAll: (Array with: classToRefactor )] ! ! -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:42:43'! -test06NewVariableNameCanNotBeDefinedInSuperclasses - - | classToRefactorSuperclass classToRefactor | +!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:01:55'! +testUpTo3LongUnterminatedRecord + "Long input, no delimiter found, expected to return all the data chunk up to the end of file. " + | path longString fs read | + path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . + longString _ ((1 to: 100) inject: '' into: [ :prev :each | prev, 'A lot of stuff, needs over 2000 chars!! ']). + path asFileEntry fileContents: longString . + fs := path asFileEntry readStream. + read := fs upTo: $X. + self assert: (read = longString ). + fs close. + path asFileEntry delete.! ! - newVariable := 'a'. - classToRefactorSuperclass := self createClassNamed: #SuperclassWithInstVar instanceVariableNames: newVariable. - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass. - - self - assertCreation: [AddInstanceVariable named: newVariable to: classToRefactor ] - failsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariable: newVariable alreadyDefinedInAll: (Array with: classToRefactorSuperclass)] -! ! +!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:02:02'! +testUpTo4LongUnterminatedRecord + "Big chunk, not delimiter found, expected return all the chunk " + | path fs read | + path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . + fs _ path asFileEntry forceWriteStream . + 1 to: 5000 do: [ :i | + (i < 3000) ifTrue: [ fs nextPut: $a ]. + (i >= 3000) ifTrue: [ fs nextPut: $b ]. + ]. + fs close. + fs := path asFileEntry readStream. + read := fs upTo: $X. + self assert: (read size = 5000). + fs close. + path asFileEntry delete.! ! -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:42:47'! -test07NewVariableNameCanNotBeDefinedInAnySubclass +!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:02:08'! +testUpTo5TerminatedAndUnterminatedLongRecords + "Two big chunks, one delimiter in the middle, expected to return + the first time a big chunk, the second time the second block up to EOF. " + | path fs read | + path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . + fs _ path asFileEntry forceWriteStream . + 1 to: 6000 do: [ :i | + (i < 3000) ifTrue: [ fs nextPut: $a ]. + (i = 3000) ifTrue: [ fs nextPut: $X ]. + (i > 3000) ifTrue: [ fs nextPut: $b ]. + ]. + fs close. + fs := path asFileEntry readStream. + " first scan, the delimiter is found but not printed. " + read := fs upTo: $X. + self assert: (read size = 2999). + self assert: ((read at: 1) = $a). + " second scan. the delimiter is not found, all second chunk is returned " + read := fs upTo: $X. + self assert: (read size = 3000). + self assert: (read at: 1) = $b. + fs close. + path asFileEntry delete.! ! - | classToRefactor classToRefactorSubclass | - - newVariable := 'a'. - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactorSubclass := self createClassNamed: #SubclassWithInstVar subclassOf: classToRefactor instanceVariableNames: newVariable. - - self - assertCreation: [AddInstanceVariable named: newVariable to: classToRefactor ] - failsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariable: newVariable alreadyDefinedInAll: (Array with: classToRefactorSubclass)] - - ! ! +!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:02:13'! +testUpTo6TerminatedLongRecords + "Two big chunks, one delimiter in the middle, one at the end. expected to return + two big chunks in two read, delimiters excluded. " + | path fs read | + path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . + fs _ path asFileEntry forceWriteStream . + 1 to: 6000 do: [ :i | + (i < 3000) ifTrue: [ fs nextPut: $a ]. + (i = 3000) ifTrue: [ fs nextPut: $X ]. + ((Interval from: 3001 to: 5999) includes: i) ifTrue: [ fs nextPut: $b ]. + (i = 6000) ifTrue: [ fs nextPut: $X ] . + ]. + fs close. + fs := path asFileEntry readStream. + " first scan, delimiter is found, return all the block delimiter excluded " + read := fs upTo: $X. + self assert: (read size = 2999). + self assert: ((read at: 1) = $a). + " second scan, return chunk, delimiter excluded. " + read := fs upTo: $X. + self assert: (read size = 2999). + self assert: ((read at: 1) = $b). + fs close. + path asFileEntry delete.! ! -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 12:33:14'! -test08AddCreatesNewInstanceVariable +!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:17:41'! +testUpToTerminator1ShortRecords + " + . Read a file stream up to 'delim' in a strict way. + . If delim is found returns everything up to the first occurrence of 'delim' included. + . if delim is not found returns nil and set the FileStream position where it was before + the call was made. This ensures if another process writes into the file another delim + limited token we will fully read it on next upTo call. + This means Delimiter is a Terminator: a chunk is only considered well formed if it ends with it. + " + |path fs| + path _ 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . + path asFileEntry fileContents: 'record-1Xrecord-2Xrecord-incomplete'. + fs _ path asFileEntry readStream . + self assert: ((fs upTo: $X delimiterIsTerminator: true) = 'record-1X'). + self assert: ((fs upTo: $X delimiterIsTerminator: true) = 'record-2X'). + self assert: ((fs upTo: $X delimiterIsTerminator: true) = nil). + ". we are not at the end of the stream, but just after the last delim was found. + we are ready to receive other delim limitated tokens. if they get written. + " + self assert: (fs position = 18). + fs close . + path asFileEntry delete . + ! ! - | classToRefactor add | - - newVariable := 'a'. - classToRefactor := self createClassNamed: self classToRefactorName. +!StandardFileStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:18:12'! +testUpToTerminator2IncompleteRecords + " + . This test stresses the motivation for introducing upTo:delimiterIsTerminator: + . if two separate processes are reading and writing records into the same file + upTo:delimiterIsTerminator:true will not loose any token and will never return half written tokens. + " + |path fs| + path _ 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . + " a process starts to write data into a file but it does not end cleanly the writing " + path asFileEntry fileContents: 'record-1Xrec'. + fs _ path asFileEntry readStream . + " upTo:strict reads upto what it can find and ignores the rest " + self assert: ((fs upTo: $X delimiterIsTerminator: true) = 'record-1X'). + self assert: ((fs upTo: $X delimiterIsTerminator: true) = nil). + ". the writing process comes back online and terminates its record writing " + path asFileEntry appendContents: 'ord-2Xrecord-3X'. + ". upTo:strict is ready and reads just completed tokens and brand new ones. " + self assert: ((fs upTo: $X delimiterIsTerminator: true) = 'record-2X'). + self assert: ((fs upTo: $X delimiterIsTerminator: true) = 'record-3X'). + self assert: ((fs upTo: $X delimiterIsTerminator: true) = nil). + fs close . + path asFileEntry delete. - add := AddInstanceVariable named: newVariable to: classToRefactor. - add apply. - - self assert: (classToRefactor definesInstanceVariableNamed: newVariable). ! ! -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:43:31'! -test09FailsWhenNewVariableEqualsTemporaryVariableOfAMethodInClass +!StandardFileStreamTest methodsFor: 'tests' stamp: 'jmv 10/25/2021 10:12:02'! +testUpToTerminator3LongUnterminatedRecord + "Long input, no delimiter found, expected to return nil. " + | path fs read | + path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . + path asFileEntry fileContents: ((1 to: 100) inject: '' into: [ :prev :each | prev, 'A lot of stuff, needs over 2000 chars!! ']). + fs := path asFileEntry readStream. + read := fs upTo: $X delimiterIsTerminator: true. + self assert: (read = nil). + fs close. + path asFileEntry delete.! ! - | selector classToRefactor | +!StandardFileStreamTest methodsFor: 'tests' stamp: 'jmv 10/25/2021 10:12:08'! +testUpToTerminator4LongUnterminatedRecord + "Big chunk, not delimiter found, expected return nil " + | path fs read | + path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . + fs _ path asFileEntry forceWriteStream . + 1 to: 5000 do: [ :i | + (i < 3000) ifTrue: [ fs nextPut: $a ]. + (i >= 3000) ifTrue: [ fs nextPut: $b ]. + ]. + fs close. + fs := path asFileEntry readStream. + read := fs upTo: $X delimiterIsTerminator: true. + self assert: (read = nil). + fs close. + path asFileEntry delete.! ! - newVariable := 'a'. - classToRefactor := self createClassNamed: self classToRefactorName. - selector := #m1. - classToRefactor compile: selector, ' | ', newVariable, ' | ', newVariable, ' := 10.'. - - self - assertCreation: [ AddInstanceVariable named: newVariable to: classToRefactor ] - failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. - ! ! +!StandardFileStreamTest methodsFor: 'tests' stamp: 'jmv 10/25/2021 10:12:14'! +testUpToTerminator5TerminatedAndUnterminatedLongRecords + "Two big chunks, one delimiter in the middle, expected to return + the first time a big chunk, the second time nil. " + | path fs read | + path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . + fs _ path asFileEntry forceWriteStream . + 1 to: 6000 do: [ :i | + (i < 3000) ifTrue: [ fs nextPut: $a ]. + (i = 3000) ifTrue: [ fs nextPut: $X ]. + (i > 3000) ifTrue: [ fs nextPut: $b ]. + ]. + fs close. + fs := path asFileEntry readStream. + " first scan, delimiter is found, return all the block delimiter included " + read := fs upTo: $X delimiterIsTerminator: true. + self assert: (read size = 3000). + self assert: ((read at: 1) = $a). + " second scan, delimiter not found, returns nil " + read := fs upTo: $X delimiterIsTerminator: true. + self assert: (read = nil). + fs close. + path asFileEntry delete.! ! -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:43:45'! -test10FailsWhenNewVariableEqualsArgumentOfAMethodInClass +!StandardFileStreamTest methodsFor: 'tests' stamp: 'jmv 10/25/2021 10:12:22'! +testUpToTerminator6TerminatedLongRecords + "Two big chunks, one delimiter in the middle, one at the end expected to return + two big chunks in two read, delimiters included. " + | path fs read | + path := 'test-{1}.txt' format: {(Float pi * 10e10) floor. } . + fs _ path asFileEntry forceWriteStream . + 1 to: 6000 do: [ :i | + (i < 3000) ifTrue: [ fs nextPut: $a ]. + (i = 3000) ifTrue: [ fs nextPut: $X ]. + ((Interval from: 3001 to: 5999) includes: i) ifTrue: [ fs nextPut: $b ]. + (i = 6000) ifTrue: [ fs nextPut: $X ] . + ]. + fs close. + fs := path asFileEntry readStream. + " first scan, delimiter is found, return all the block delimiter included " + read := fs upTo: $X delimiterIsTerminator: true. + self assert: (read size = 3000). + self assert: ((read at: 1) = $a). + " second scan, delimiter found, return chunk, delimiter included " + read := fs upTo: $X delimiterIsTerminator: true. + self assert: (read size = 3000). + self assert: ((read at: 1) = $b). + fs close. + path asFileEntry delete.! ! - | selector classToRefactor | +!ReferenceStreamTest methodsFor: 'testing' stamp: 'jmv 9/25/2012 22:42'! +testDiskProxy + " + ReferenceStreamTest new testDiskProxy + " + | newInstance oldInstance | + self flag: #jmvVer2. + oldInstance _ { Smalltalk . Display . Morph}. + newInstance _ ReferenceStream unStream: (ReferenceStream streamedRepresentationOf: oldInstance). + 1 to: oldInstance size do: [ :i | + self assert: (newInstance at: i) == (oldInstance at: i) ]! ! - newVariable := 'a'. - classToRefactor := self createClassNamed: self classToRefactorName. - selector := #m1:. - classToRefactor compile: selector, newVariable. - - self - assertCreation: [ AddInstanceVariable named: newVariable to: classToRefactor ] - failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. - ! ! - -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:44:12'! -test11FailsWhenNewVariableEqualsArgumentOfABlockInAMethodInClass - - | selector classToRefactor | - - newVariable := 'a'. - classToRefactor := self createClassNamed: self classToRefactorName. - selector := #m1. - classToRefactor compile: selector, ' [ :', newVariable, ' | ] value: 1'. - - self - assertCreation: [ AddInstanceVariable named: newVariable to: classToRefactor ] - failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. - ! ! - -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:44:28'! -test12FailsWhenNewVariableEqualsTemporaryOfABlockInAMethodInClass - - | selector classToRefactor | +!ReferenceStreamTest methodsFor: 'testing' stamp: 'jmv 12/6/2011 08:19'! +testSortedCollection + " + ReferenceStreamTest new testSortedCollection + " + | newInstance oldInstance | + oldInstance _ SortedCollection sortBlock: [ :a :b | a printString < b printString ]. + oldInstance add: 'hi'; add: 'there'; add: 'you'; add: 'all'. + newInstance _ ReferenceStream unStream: (ReferenceStream streamedRepresentationOf: oldInstance). + self assert: newInstance asArray = oldInstance asArray! ! - newVariable := 'a'. - classToRefactor := self createClassNamed: self classToRefactorName. - selector := #m1. - classToRefactor compile: selector, ' [ | ', newVariable, ' | ] value'. - - self - assertCreation: [ AddInstanceVariable named: newVariable to: classToRefactor ] - failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. +!ReferenceStreamTest methodsFor: 'testing' stamp: 'jmv 8/21/2012 17:02'! +testWeakDumps + "Test that if we serialize a model with weak references to views, only the model is serialized and not the views. - ! ! - -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:44:46'! -test13FailsWhenNewVariableIsHiddenInAnyMethodOfAnySubclass - - | selector classToRefactor subclass | - - newVariable := 'a'. - classToRefactor := self createClassNamed: self classToRefactorName. - subclass := self createClassNamed: #SubclassOfClassToRefactor subclassOf: classToRefactor. - selector := #m1. - subclass compile: selector, ' | ', newVariable, ' | '. - - self - assertCreation: [ AddInstanceVariable named: newVariable to: classToRefactor ] - failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (subclass>>selector)) ]. + Note: The bug became apparent only when dumping a model to a SmartRefStream, that calls #references, and the serialized stream + was later materialized in an image where the view classes had been deleted. In such rare cases, materialization would fail when trying to reference these + absent classes. If serializing to a ReferenceStream, the bug didn't become apparent (views were never serialized). If serializing to a SmartRefStream, but + view classes still existed, the bug didn't really become apparent (because views were not actually deserialized), the only effect was a larger file. - ! ! - -!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:43:17'! -test14NewVariableNameCanNotBeAReservedName - - | classToRefactor | + ReferenceStreamTest new testWeakDumps + " + | oldInstance window refStream | + oldInstance _ TextModel withText: 'This is a text'. + window _ SystemWindow editText: oldInstance label: 'old instance' wrap: true. + refStream _ ReferenceStream on: (DummyStream on: nil). + refStream nextPut: oldInstance. + self deny: (refStream references keys anySatisfy: [ :dumpedObject | dumpedObject isKindOf: Morph ]). + window delete! ! - classToRefactor := self createClassNamed: self classToRefactorName. - - ClassBuilder reservedNames do: [ :aReservedName | - self - assertCreation: [AddInstanceVariable named: aReservedName to: classToRefactor ] - failsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariableCanNotBeAReservedName: aReservedName ]] - ! ! +!SmartRefStreamTest methodsFor: 'testing' stamp: 'jmv 9/25/2012 22:42'! +testDiskProxy + " + SmartRefStreamTest new testDiskProxy + " + | newInstance oldInstance | + self flag: #jmvVer2. + oldInstance _ { Smalltalk . Display . Morph}. + newInstance _ SmartRefStream unStream: (SmartRefStream streamedRepresentationOf: oldInstance). + 1 to: oldInstance size do: [ :i | + self assert: (newInstance at: i) == (oldInstance at: i) ]! ! -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! -test01AddingParameterToUnaryMessageAddsColonAndParameter +!SmartRefStreamTest methodsFor: 'testing' stamp: 'jmv 12/6/2011 08:34'! +testSortedCollection + " + SmartRefStreamTest new testSortedCollection + " + | newInstance oldInstance | + oldInstance _ SortedCollection sortBlock: [ :a :b | a printString < b printString ]. + oldInstance add: 'hi'; add: 'there'; add: 'you'; add: 'all'. + newInstance _ SmartRefStream unStream: (SmartRefStream streamedRepresentationOf: oldInstance). + self assert: newInstance asArray = oldInstance asArray! ! - | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod | - - oldSelector := 'm1' asSymbol. - newSelector := (oldSelector, ':') asSymbol. - newParameter := 'newParam'. - newParameterValue := '1'. - senderSelector := 'sender_m1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString. - classToRefactor compile: senderSelector asString, ' self ', oldSelector asString. - - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue toUnarySelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). - - newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. - self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). +!SmartRefStreamTest methodsFor: 'testing' stamp: 'jmv 8/21/2012 17:00'! +testWeakDumps + "Test that if we serialize a model with weak references to views, only the model is serialized and not the views. - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). + Note: The bug became apparent only when dumping a model to a SmartRefStream, that calls #references, and the serialized stream + was later materialized in an image where the view classes had been deleted. In such rare cases, materialization would fail when trying to reference these + absent classes. If serializing to a ReferenceStream, the bug didn't become apparent (views were never serialized). If serializing to a SmartRefStream, but + view classes still existed, the bug didn't really become apparent (because views were not actually deserialized), the only effect was a larger file. - self assert: newParameterValue equals: (senderMethod methodNode block statements first arguments first literalValue) printString + SmartRefStreamTest new testWeakDumps + " + | oldInstance window refStream | + oldInstance _ TextModel withText: 'This is a text'. + window _ SystemWindow editText: oldInstance label: 'old instance' wrap: true. + refStream _ SmartRefStream on: (DummyStream on: nil). + refStream nextPut: oldInstance. + self deny: (refStream references keys anySatisfy: [ :dumpedObject | dumpedObject isKindOf: Morph ]). + window delete! ! +!BitBltTest methodsFor: 'bugs' stamp: 'jmv 3/11/2010 08:40'! +testAllAlphasRgbAdd + "self run: #testAllAlphasRgbAdd" + | sourceForm destForm blt correctAlphas | + correctAlphas _ 0. + 0 to: 255 do: [:sourceAlpha | + sourceForm _ Form extent: 1 @ 1 depth: 32. + sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. + 0 to: 255 do: [:destAlpha | + destForm _ Form extent: 1 @ 1 depth: 32. + destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. + blt _ BitBlt new. + blt sourceForm: sourceForm. + blt sourceOrigin: 0 @ 0. + blt setDestForm: destForm. + blt destOrigin: 0 @ 0. + blt combinationRule: 20. "rgbAdd" + blt copyBits. + correctAlphas _ correctAlphas + + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha + sourceAlpha min: 255) + ifTrue: [1] + ifFalse: [0]) + ]]. + self assert: correctAlphas = 65536 description: 'Some incorrect alpha values computed for BitBlt rule rgbAdd'! ! -! ! +!BitBltTest methodsFor: 'bugs' stamp: 'jmv 3/11/2010 08:40'! +testAllAlphasRgbMax + "self run: #testAllAlphasRgbMax" + | sourceForm destForm blt correctAlphas | + correctAlphas _ 0. + 0 to: 255 do: [:sourceAlpha | + sourceForm _ Form extent: 1 @ 1 depth: 32. + sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. + 0 to: 255 do: [:destAlpha | + destForm _ Form extent: 1 @ 1 depth: 32. + destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. + blt _ BitBlt new. + blt sourceForm: sourceForm. + blt sourceOrigin: 0 @ 0. + blt setDestForm: destForm. + blt destOrigin: 0 @ 0. + blt combinationRule: 27. "rgbMax" + blt copyBits. + correctAlphas _ correctAlphas + + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha max: sourceAlpha) + ifTrue: [1] + ifFalse: [0]) + ]]. + self assert: correctAlphas = 65536 description: 'Some incorrect alpha values computed for BitBlt rule rgbMax'! ! -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! -test02AddingParameterToKeywordMessageAddsNewKeywordAndParameter +!BitBltTest methodsFor: 'bugs' stamp: 'jmv 3/11/2010 08:40'! +testAllAlphasRgbMin + "self run: #testAllAlphasRgbMin" + | sourceForm destForm blt correctAlphas | + correctAlphas _ 0. + 0 to: 255 do: [:sourceAlpha | + sourceForm _ Form extent: 1 @ 1 depth: 32. + sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. + 0 to: 255 do: [:destAlpha | + destForm _ Form extent: 1 @ 1 depth: 32. + destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. + blt _ BitBlt new. + blt sourceForm: sourceForm. + blt sourceOrigin: 0 @ 0. + blt setDestForm: destForm. + blt destOrigin: 0 @ 0. + blt combinationRule: 28. "rgbMin" + blt copyBits. + correctAlphas _ correctAlphas + + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha min: sourceAlpha) + ifTrue: [1] + ifFalse: [0]) + ]]. + self assert: correctAlphas = 65536 description: 'Some incorrect alpha values computed for BitBlt rule rgbMin'! ! - | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword | - - oldSelector := 'm1:' asSymbol. - newSelectorAddedKeyword := 'm2:' asSymbol. - newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. - newParameter := 'newParam'. - newParameterValue := '2'. - senderSelector := 'sender_m1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: (oldSelector asString, ' oldParam'). - classToRefactor compile: senderSelector asString, ' self ', oldSelector asString, ' 1'. - - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). - - newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. - self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). - - self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments second literalValue) +!BitBltTest methodsFor: 'bugs' stamp: 'jmv 3/11/2010 08:39'! +testAllAlphasRgbMinInvert + "self run: #testAllAlphasRgbMinInvert" + | sourceForm destForm blt correctAlphas | + correctAlphas _ 0. + 0 to: 255 do: [:sourceAlpha | + sourceForm _ Form extent: 1 @ 1 depth: 32. + sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. + 0 to: 255 do: [:destAlpha | + destForm _ Form extent: 1 @ 1 depth: 32. + destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. + blt _ BitBlt new. + blt sourceForm: sourceForm. + blt sourceOrigin: 0 @ 0. + blt setDestForm: destForm. + blt destOrigin: 0 @ 0. + blt combinationRule: 29. "rgbMinInvert" + blt copyBits. + correctAlphas _ correctAlphas + + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha min: 255-sourceAlpha) + ifTrue: [1] + ifFalse: [0]) + ]]. + self assert: correctAlphas = 65536 description: 'Some incorrect alpha values computed for BitBlt rule rgbMinInvert'! ! +!BitBltTest methodsFor: 'bugs' stamp: 'jmv 3/11/2010 08:39'! +testAllAlphasRgbMul + "self run: #testAllAlphasRgbMul" + | sourceForm destForm blt correctAlphas | + correctAlphas _ 0. + 0 to: 255 do: [:sourceAlpha | + sourceForm _ Form extent: 1 @ 1 depth: 32. + sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. + 0 to: 255 do: [:destAlpha | + destForm _ Form extent: 1 @ 1 depth: 32. + destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. + blt _ BitBlt new. + blt sourceForm: sourceForm. + blt sourceOrigin: 0 @ 0. + blt setDestForm: destForm. + blt destOrigin: 0 @ 0. + blt combinationRule: 37. "rgbMul" + blt copyBits. + correctAlphas _ correctAlphas + + (((blt destForm bits at: 1) digitAt: 4) = ((destAlpha+1) * (sourceAlpha+1)- 1 // 256) + ifTrue: [1] + ifFalse: [0]) + ]]. + self assert: correctAlphas = 65536 description: 'Some incorrect alpha values computed for BitBlt rule rgbMul'! ! -! ! +!BitBltTest methodsFor: 'bugs' stamp: 'jmv 3/11/2010 08:39'! +testAllAlphasRgbSub + "self run: #testAllAlphasRgbSub" + | sourceForm destForm blt correctAlphas | + correctAlphas _ 0. + 0 to: 255 do: [:sourceAlpha | + sourceForm _ Form extent: 1 @ 1 depth: 32. + sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. + 0 to: 255 do: [:destAlpha | + destForm _ Form extent: 1 @ 1 depth: 32. + destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. + blt _ BitBlt new. + blt sourceForm: sourceForm. + blt sourceOrigin: 0 @ 0. + blt setDestForm: destForm. + blt destOrigin: 0 @ 0. + blt combinationRule: 21. "rgbSub" + blt copyBits. + correctAlphas _ correctAlphas + + (((blt destForm bits at: 1) digitAt: 4) = (destAlpha - sourceAlpha) abs + ifTrue: [1] + ifFalse: [0]) + ]]. + self assert: correctAlphas = 65536 description: 'Some incorrect alpha values computed for BitBlt rule rgbSub'! ! -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! -test03AddingParameterToKeywordMessageMultipleSendsInSameMethodSameLiteral +!BitBltTest methodsFor: 'bugs' stamp: 'jmv 7/12/2015 22:27'! +testAlphaCompositing + " + BitBltTest new testAlphaCompositing + " - | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword collaboration | - - oldSelector := 'm1:' asSymbol. - newSelectorAddedKeyword := 'm2:' asSymbol. - newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. - newParameter := 'newParam'. - newParameterValue := '2'. - senderSelector := 'sender_m1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: (oldSelector asString, ' oldParam'). - collaboration := ' self ', oldSelector asString, ' 1.'. - classToRefactor compile: senderSelector asString, collaboration, collaboration. - - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). - - newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. - self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). - - self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments second literalValue) + | bb f1 f2 mixColor result eps | + f1 := Form extent: 1@1 depth: 32. + f2 := Form extent: 1@1 depth: 32. + eps := 0.5 / 255. + 0 to: 255 do:[:i| + f1 colorAt: 0@0 put: (Color r: 0 g: 0 b: 1). + mixColor := Color r: 1 g: 0 b: 0 alpha: i / 255.0. + f2 colorAt: 0@0 put: mixColor. + mixColor := f2 colorAt: 0@0. + bb := BitBlt toForm: f1. + bb sourceForm: f2. + bb combinationRule: Form blend. + bb copyBits. + result := f1 colorAt: 0@0. + self assert: (result red - mixColor alpha) abs < eps. + self assert: (result blue - (1.0 - mixColor alpha)) abs < eps. + self assert: result alpha = 1.0. + ].! ! +!BitBltTest methodsFor: 'bugs' stamp: 'jmv 7/12/2015 22:27'! +testAlphaCompositing2 + " + BitBltTest new testAlphaCompositing2 + " -! ! + | bb f1 f2 mixColor result eps | + f1 := Form extent: 1@1 depth: 32. + f2 := Form extent: 1@1 depth: 32. + eps := 0.5 / 255. + 0 to: 255 do:[:i| + f1 colorAt: 0@0 put: Color transparent. + mixColor := Color r: 1 g: 0 b: 0 alpha: i / 255.0. + f2 colorAt: 0@0 put: mixColor. + mixColor := f2 colorAt: 0@0. + bb := BitBlt toForm: f1. + bb sourceForm: f2. + bb combinationRule: Form blend. + bb copyBits. + result := f1 colorAt: 0@0. + self assert: (result red - mixColor alpha) abs < eps. + self assert: result alpha = mixColor alpha. + ].! ! -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! -test04AddingParameterToKeywordMessageWithMessageSendAsLastFormalParameter +!RectangleTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:52:04'! +testIsRectangle + self assert: (Rectangle new is: #Rectangle)! ! - | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword collaboration | - - oldSelector := 'm1:' asSymbol. - newSelectorAddedKeyword := 'm2:' asSymbol. - newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. - newParameter := 'newParam'. - newParameterValue := '2'. - senderSelector := 'sender_m1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: (oldSelector asString, ' oldParam'). - collaboration := ' self ', oldSelector asString, ' self size.'. - classToRefactor compile: senderSelector asString, collaboration. - - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). - - newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. - self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). - - self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments second literalValue) +!ColorFormTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:30:35'! +testIsColorForm + self assert: (ColorForm new is: #ColorForm).! ! +!GrayFormTest methodsFor: 'as yet unclassified' stamp: 'jpb 8/2/2019 23:36:06'! +testIsGrayForm + self assert: (GrayForm new is: #GrayForm)! ! -! ! +!StrikeFontTest methodsFor: 'testing' stamp: 'jmv 6/11/2020 16:30:55'! +testBaseAndDerivedFont + " + StrikeFontTest new testBaseAndDerivedFont + " -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! -test05AddingParameterToKeywordMessageWithBinaryMessageSendAsLastFormalParameter - - | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword collaboration | - - oldSelector := 'm1:' asSymbol. - newSelectorAddedKeyword := 'm2:' asSymbol. - newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. - newParameter := 'newParam'. - newParameterValue := '2'. - senderSelector := 'sender_m1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: (oldSelector asString, ' oldParam'). - collaboration := ' self ', oldSelector asString, ' self size + 4.'. - classToRefactor compile: senderSelector asString, collaboration. - - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). - - newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. - self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). - - self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments second literalValue) + | base italic italicItalic boldItalic italicBold boldItalic2 underlined underlinedItalic italicUnderlined struckThrough1 struckThrough2 | + base _ FontFamily defaultFamilyPointSize: 14. + self assert: base isBaseFont. + italic _ base italic. + self deny: italic isBaseFont. + italicItalic _ italic italic. + self assert: italicItalic == italic. + boldItalic _ base bold italic. + self deny: boldItalic isBaseFont. + boldItalic2 _ base boldItalic. + italicBold _ italic bold. + self assert: boldItalic == italicBold. + self assert: boldItalic == boldItalic2. + underlined _ base underlined. + self deny: underlined isBaseFont. + underlinedItalic _ underlined italic. + italicUnderlined _ italic underlined. + self assert: underlinedItalic == italicUnderlined. + struckThrough1 _ base italic underlined bold struckThrough. + struckThrough2 _ base bold underlined italic struckThrough. + self assert: struckThrough1 == struckThrough2! ! +!StrikeFontTest methodsFor: 'testing' stamp: 'jmv 6/11/2020 16:25:48'! +testBaseAndDerivedFontSanity + " + StrikeFontTest new testBaseAndDerivedFontSanity + " -! ! + StrikeFont allInstances do: [ :f | + f isBaseFont + ifTrue: [ + self assert: (f instVarNamed: 'baseFont') isNil. + self assert: f baseFont == f. + self assert: (f instVarNamed: 'derivativeFonts') notNil ] + ifFalse: [ + self assert: f baseFont notNil. + self assert: (f instVarNamed: 'derivativeFonts') isNil. + self assert: (f baseFont emphasized: f emphasis) == f ] ]! ! -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! -test06AddingParameterToKeywordMessageWithKeywordMessageSendAsLastFormalParameter +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:20'! +test16bpp + | form n read | + form _ JpegTest lenaColor64 asFormOfDepth: 16. + self assert: form nativeDepth = 16. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read depth = 32. - | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword collaboration | - - oldSelector := 'm1:' asSymbol. - newSelectorAddedKeyword := 'm2:' asSymbol. - newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. - newParameter := 'newParam'. - newParameterValue := '2'. - senderSelector := 'sender_m1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: (oldSelector asString, ' oldParam'). - collaboration := ' self ', oldSelector asString, ' (self at: 1 put: 2).'. - classToRefactor compile: senderSelector asString, collaboration. - - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). - - newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. - self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). - - self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments second literalValue) + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:16'! +test16bpp61 + | form n read | + form _ (JpegTest lenaColor64 asFormOfDepth: 16) copy: (0@0 extent: 61@61). + self assert: form nativeDepth = 16. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read depth = 32. + self assert: read extent = (61@61). -! ! + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! -test07AddingParameterToUnaryMessageChangesReferencesToSelector +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:13'! +test16bpp62 + | form n read | + form _ (JpegTest lenaColor64 asFormOfDepth: 16) copy: (0@0 extent: 62@62). + self assert: form nativeDepth = 16. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read depth = 32. + self assert: read extent = (62@62). - | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod | - - oldSelector := 'm1' asSymbol. - newSelector := (oldSelector, ':') asSymbol. - newParameter := 'newParam'. - newParameterValue := '1'. - senderSelector := 'sender_m1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString. - classToRefactor compile: senderSelector asString, ' #', oldSelector asString, ' size'. - - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue toUnarySelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). - - newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. - self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: 0 equals: (senderMethod indexOfLiteral: oldSelector). - self assert: 1 equals: (senderMethod indexOfLiteral: newSelector). - - -! ! + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! -test08AddingParameterToKeywordMessageChangesReferencesToSelector +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:10'! +test16bpp63 + | form n read | + form _ (JpegTest lenaColor64 asFormOfDepth: 16) copy: (0@0 extent: 63@63). + self assert: form nativeDepth = 16. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read depth = 32. + self assert: read extent = (63@63). - | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword collaboration | - - oldSelector := 'm1:' asSymbol. - newSelectorAddedKeyword := 'm2:' asSymbol. - newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. - newParameter := 'newParam'. - newParameterValue := '2'. - senderSelector := 'sender_m1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: (oldSelector asString, ' oldParam'). - collaboration := ' #', oldSelector asString, ' size.'. - classToRefactor compile: senderSelector asString, collaboration. - - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). - - newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. - self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: 0 equals: (senderMethod indexOfLiteral: oldSelector). - self assert: 1 equals: (senderMethod indexOfLiteral: newSelector). - + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:07'! +test16bppLE + | form n read | + form _ JpegTest lenaColor64 asFormOfDepth: -16. + self assert: form nativeDepth = -16. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read depth = 32. -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 12:24:53'! -test09FailsIfNewParameterValueCanNotBeCompiled + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - self - assertCreation: [ AddParameter - named: 'newParam' initializedWith: '+' toUnarySelector: thisContext selector - implementors: {thisContext method} senders: {} ] - failsWith: [ AddParameter newParameterValueDoesNotCompileErrorMessage ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:04'! +test16bppLE61 + | form n read | + form _ (JpegTest lenaColor64 asFormOfDepth: -16) copy: (0@0 extent: 61@61). + self assert: form nativeDepth = -16. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read depth = 32. + self assert: read extent = (61@61). -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 12:25:16'! -test10FailsIfNewParameterValueIsEmpty + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - self - assertCreation: [ AddParameter - named: 'newParam' initializedWith: ' ' toUnarySelector: thisContext selector - implementors: {thisContext method} senders: {} ] - failsWith: [ AddParameter newParameterValueCanNotBeEmptyErrorMessage ] -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:00'! +test16bppLE62 + | form n read | + form _ (JpegTest lenaColor64 asFormOfDepth: -16) copy: (0@0 extent: 62@62). + self assert: form nativeDepth = -16. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read depth = 32. + self assert: read extent = (62@62). -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 16:57:23'! -test11NewParameterNameCanNotBeEmpty + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | newParameter | - - newParameter := ' '. - self - assertCreation: [ AddParameter - named: newParameter initializedWith: '1' toUnarySelector: thisContext selector - implementors: {thisContext method} senders: {} ] - failsWith: [ AddParameter errorMessageForInvalidParameterName: newParameter withBlanksTrimmed ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:57'! +test16bppLE63 + | form n read | + form _ (JpegTest lenaColor64 asFormOfDepth: -16) copy: (0@0 extent: 63@63). + self assert: form nativeDepth = -16. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read depth = 32. + self assert: read extent = (63@63). -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 12:34:07'! -test12NewParameterNameCanNotStartWithNumber + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | newParameter | - - newParameter := '1x'. - self - assertCreation: [ AddParameter - named: newParameter initializedWith: '1' toUnarySelector: thisContext selector - implementors: {thisContext method} senders: {} ] - failsWith: [ AddParameter errorMessageForInvalidParameterName: newParameter ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:53'! +test32bpp + | form n read | + form _ JpegTest lenaColor64. + self assert: form depth = 32. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read depth = 32. -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 12:34:28'! -test13NewParameterNameCanNotContainSpaces + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | newParameter | - - newParameter := 'an Integer'. - self - assertCreation: [ AddParameter - named: newParameter initializedWith: '1' toUnarySelector: thisContext selector - implementors: {thisContext method} senders: {} ] - failsWith: [ AddParameter errorMessageForInvalidParameterName: newParameter ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:50'! +test32bpp63 + | form n read | + form _ JpegTest lenaColor64 copy: (0@0 extent: 63@63). + self assert: form depth = 32. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read depth = 32. + self assert: read extent = (63@63). -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 15:14:45'! -test14NewParameterCanNotBeDefinedAsInstanceVariableInAnyImplementor + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | classToRefactor oldSelector newParameter | - - oldSelector := 'm1' asSymbol. - newParameter := 'newParam'. - - classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: newParameter. - classToRefactor compile: oldSelector asString. - - self - assertCreation: [ AddParameter - named: newParameter initializedWith: '1' toUnarySelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {} ] - failsWith: [ AddParameter errorMessageForNewParameter: newParameter definedAsInstanceVariableIn: {classToRefactor} ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:47'! +test32bppLE63 + | form n read | + form _ JpegTest lenaColor64 copy: (0@0 extent: 63@63). + self assert: form depth = 32. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read depth = 32. + self assert: read extent = (63@63). -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 9/2/2018 19:59:27'! -test15NewParameterCanNotBeDefinedAsParameterInAnyImplementor + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | classToRefactor oldSelector newParameter implementors | - - oldSelector := 'm1:' asSymbol. - newParameter := 'newParam'. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, newParameter. - implementors := {classToRefactor>>oldSelector}. - - self - assertCreation: [ AddParameter - named: newParameter initializedWith: '1' using: 'm2:' asSymbol toKeywordSelector: oldSelector - implementors: implementors senders: {} ] - failsWith: [ AddParameter errorMessageForNewParameterDefinedAsLocal: newParameter ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:44'! +testBA16bpp + | form n read bytes | + form _ JpegTest lenaColor64 asFormOfDepth: 16. + self assert: form nativeDepth = 16. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ Form extent: form extent depth: 16. + JPEGReadWriter2 new uncompress: bytes into: read. -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 12:21:52'! -test16WhenCreatedForUnarySelectorMustBeUnary + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - self - assertCreation: [ AddParameter - named: 'newParam' initializedWith: '1' toUnarySelector: 'm1:' asSymbol - implementors: {thisContext method} senders: {} ] - failsWith: [ AddParameter selectorMustBeUnaryErrorMessage ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:41'! +testBA16bpp61 + | form n read bytes | + form _ (JpegTest lenaColor64 asFormOfDepth: 16) copy: (0@0 extent: 61@61). + self assert: form nativeDepth = 16. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ Form extent: form extent depth: 16. + JPEGReadWriter2 new uncompress: bytes into: read. -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 12:27:42'! -test17WhenCreatedForBinarySelectorMustBeBinary + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - self - assertCreation: [ AddParameter - named: 'newParam' initializedWith: '1' using: 'm1:' asSymbol toKeywordSelector: thisContext selector - implementors: {thisContext method} senders: {} ] - failsWith: [ AddParameter selectorMustBeKeywordErrorMessage ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:37'! +testBA16bpp62 + | form n read bytes | + form _ (JpegTest lenaColor64 asFormOfDepth: 16) copy: (0@0 extent: 62@62). + self assert: form nativeDepth = 16. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ Form extent: form extent depth: 16. + JPEGReadWriter2 new uncompress: bytes into: read. -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 9/4/2018 20:10:41'! -test18CanNotAddParameterToBinaryKeyword + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - self - assertCreation: [ AddParameter - named: 'newParam' at: 1 addingLast: true initializedWith: '1' to: '+' asSymbol implementing: 'm1:' asSymbol - addingToImplementors: '' addingToSenders: '' - implementors: {} senders: {} ] - failsWith: [ AddParameter selectorCanNotBeBinaryErrorMessage ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:34'! +testBA16bpp63 + | form n read bytes | + form _ (JpegTest lenaColor64 asFormOfDepth: 16) copy: (0@0 extent: 63@63). + self assert: form nativeDepth = 16. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ Form extent: form extent depth: 16. + JPEGReadWriter2 new uncompress: bytes into: read. -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 15:48:13'! -test19AllImplementorsMustImplementOldSelector + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | implementors | - - implementors := {thisContext method}. - self - assertCreation: [ AddParameter - named: 'newParam' initializedWith: '1' toUnarySelector: (thisContext selector, 'x') asSymbol - implementors: implementors senders: {} ] - failsWith: [ AddParameter errorMessageForInvalidImplementors: implementors ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:31'! +testBA16bppLE + | form n read bytes | + form _ JpegTest lenaColor64 asFormOfDepth: -16. + self assert: form nativeDepth = -16. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ Form extent: form extent depth: 16. + JPEGReadWriter2 new uncompress: bytes into: read. -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 15:53:37'! -test20AllSendersShouldSendOldSelector + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | oldSelector invalidSenders | - - oldSelector := thisContext selector. - invalidSenders := {thisContext method}. - self - assertCreation: [ AddParameter - named: 'newParam' initializedWith: '1' toUnarySelector: oldSelector - implementors: {thisContext method} senders: invalidSenders ] - failsWith: [ AddParameter errorMessageForInvalidSenders: invalidSenders of: oldSelector ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:28'! +testBA16bppLE61 + | form n read bytes | + form _ (JpegTest lenaColor64 asFormOfDepth: -16) copy: (0@0 extent: 61@61). + self assert: form nativeDepth = -16. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ Form extent: form extent depth: 16. + JPEGReadWriter2 new uncompress: bytes into: read. -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 16:24:22'! -test21NewKeywordToAddToOldSelectorCanNotBeUnary + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - self - assertCreation: [ AddParameter - named: 'newParam' initializedWith: '1' using: 'm1' asSymbol toKeywordSelector: 'm1:' asSymbol - implementors: {} senders: {} ] - failsWith: [ AddParameter notValidKeywordForNewParameterErrorMessage ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:25'! +testBA16bppLE62 + | form n read bytes | + form _ (JpegTest lenaColor64 asFormOfDepth: -16) copy: (0@0 extent: 62@62). + self assert: form nativeDepth = -16. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ Form extent: form extent depth: 16. + JPEGReadWriter2 new uncompress: bytes into: read. -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 16:26:55'! -test22NewKeywordToAddToOldSelectorCanNotBeBinary + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - self - assertCreation: [ AddParameter - named: 'newParam' initializedWith: '1' using: '+' asSymbol toKeywordSelector: 'm1:' asSymbol - implementors: {} senders: {} ] - failsWith: [ AddParameter notValidKeywordForNewParameterErrorMessage ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:20'! +testBA16bppLE63 + | form n read bytes | + form _ (JpegTest lenaColor64 asFormOfDepth: -16) copy: (0@0 extent: 63@63). + self assert: form nativeDepth = -16. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ Form extent: form extent depth: 16. + JPEGReadWriter2 new uncompress: bytes into: read. -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 16:27:58'! -test23NewKeywordToAddToOldSelectorCanNotBeKeywordWithMoreThanOneParameter + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - self - assertCreation: [ AddParameter - named: 'newParam' initializedWith: '1' using: 'm1:m2:' asSymbol toKeywordSelector: 'm1:' asSymbol - implementors: {} senders: {} ] - failsWith: [ AddParameter notValidKeywordForNewParameterErrorMessage ] - -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:16'! +testBA32bpp + | form n read bytes | + form _ JpegTest lenaColor64. + self assert: form depth = 32. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ JPEGReadWriter2 new uncompress: bytes into: nil. + self assert: read depth = 32. -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/24/2018 17:10:04'! -test24AddingParameterToSendersTakeCaresOfSeparators + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | refactoring classToRefactor oldSelector newSelector newParameter newParameterValue senderSelector | - - oldSelector := 'm1' asSymbol. - newSelector := (oldSelector, ':') asSymbol. - newParameter := 'newParam'. - newParameterValue := '1'. - senderSelector := 'sender_m1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString. - classToRefactor compile: senderSelector asString, ' self ', oldSelector asString, Character newLineCharacter asString,' '. +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:07'! +testBA32bpp63 + | form n read bytes | + form _ JpegTest lenaColor64 copy: (0@0 extent: 63@63). + self assert: form depth = 32. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ JPEGReadWriter2 new uncompress: bytes into: nil. + self assert: read depth = 32. + self assert: read extent = (63@63). - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue toUnarySelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - self shouldnt: [ refactoring apply ] raise: Error. - - ! ! - -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 5/24/2019 10:06:10'! -test25IfNewParameterValueIsKeywordMessageSendAddParenthesisToItForUnaryMessages + n _ form boundingBox width * form boundingBox height * 3. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | refactoring classToRefactor oldSelector newParameter newParameterValue senderSelector newSelector senderMethod senderMethodNode senderSourceCode senderSourceRange | - - oldSelector := 'm1' asSymbol. - newSelector := (oldSelector, ':') asSymbol. - newParameter := 'newParam'. - newParameterValue := 'self at: 1'. - senderSelector := 'sender_m1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString. - classToRefactor compile: senderSelector asString, ' self ', oldSelector asString. +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:03'! +testGray + | form n read | + form _ JpegTest lenaColor64 asGrayForm. + self assert: form nativeDepth = -8. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read nativeDepth = -8. - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue toUnarySelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: (senderMethod sendsOrRefersTo: newSelector). - - senderMethodNode := senderMethod methodNode. - senderSourceRange := senderMethodNode encoder rangeForNode: senderMethodNode block statements first ifAbsent: [ self fail ]. - senderSourceCode := senderMethodNode sourceText copyFrom: senderSourceRange first to: senderSourceRange last. - self assert: (senderSourceCode endsWith: '(',newParameterValue,')') - - ! ! + n _ form boundingBox width * form boundingBox height. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 5/24/2019 10:06:40'! -test26IfNewParameterValueIsKeywordMessageSendAddParenthesisToItForKeywordMessages +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:01'! +testGray61 + | form n read | + form _ JpegTest lenaColor64 asGrayForm copy: (0@0 extent: 61@61). + self assert: form nativeDepth = -8. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read nativeDepth = -8. + self assert: read extent = (61@61). - | refactoring classToRefactor oldSelector newParameter newParameterValue senderSelector newSelector senderMethod newSelectorAddedKeyword senderMethodNode senderSourceCode senderSourceRange | - - oldSelector := 'm1:' asSymbol. - newSelectorAddedKeyword := 'm2:' asSymbol. - newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. - newParameter := 'newParam'. - newParameterValue := 'self at: 1'. - senderSelector := 'sender_m1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' oldParam'. - classToRefactor compile: senderSelector asString, ' self ', oldSelector asString, ' 1'. + n _ form boundingBox width * form boundingBox height. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: (senderMethod sendsOrRefersTo: newSelector). - - senderMethodNode := senderMethod methodNode. - senderSourceRange := senderMethodNode encoder rangeForNode: senderMethodNode block statements first ifAbsent: [ self fail ]. - senderSourceCode := senderMethodNode sourceText copyFrom: senderSourceRange first to: senderSourceRange last. - self assert: (senderSourceCode endsWith: '(',newParameterValue,')') - - ! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:57:57'! +testGray62 + | form n read | + form _ JpegTest lenaColor64 asGrayForm copy: (0@0 extent: 62@62). + self assert: form nativeDepth = -8. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read nativeDepth = -8. + self assert: read extent = (62@62). -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/25/2018 11:23:42'! -test27NewParameterValueCanNotHaveMoreThanOneStatement + n _ form boundingBox width * form boundingBox height. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - self - assertCreation: [ AddParameter - named: 'newParameter' initializedWith: 'self m1. self m2.' toUnarySelector: thisContext selector - implementors: {thisContext method} senders: {} ] - failsWith: [ AddParameter newParameterValueCanNotHaveMoreThanOneStatementErrorMessage ]. - - ! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:57:54'! +testGray63 + | form n read | + form _ JpegTest lenaColor64 asGrayForm copy: (0@0 extent: 63@63). + self assert: form nativeDepth = -8. + form writeJPEGfileNamed: 'test.jpg'. + read _ 'test.jpg' asFileEntry formContents. + self assert: read nativeDepth = -8. + self assert: read extent = (63@63). -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 5/24/2019 10:07:01'! -test28WhenSenderLastParameterIsABlockAddedParameterIsNotAddedInsideTheBlock + n _ form boundingBox width * form boundingBox height. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | refactoring classToRefactor oldSelector newParameter newParameterValue senderSelector newSelector senderMethod newSelectorAddedKeyword senderMethodNode senderSourceCode senderSourceRange senderFirstParameterValue | +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:57:48'! +testGrayBA + | form n read bytes | + form _ JpegTest lenaColor64 asGrayForm. + self assert: form nativeDepth = -8. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ JPEGReadWriter2 new uncompress: bytes into: nil. + self assert: read nativeDepth = -8. - oldSelector := 'm1:' asSymbol. - newSelectorAddedKeyword := 'm2:' asSymbol. - newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. - newParameter := 'newParam'. - newParameterValue := '1'. - senderSelector := 'sender_m1' asSymbol. - senderFirstParameterValue := '[ 1 factorial ]'. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' oldParam'. - classToRefactor compile: senderSelector asString, ' self ', oldSelector asString, senderFirstParameterValue. + n _ form boundingBox width * form boundingBox height. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: (senderMethod sendsOrRefersTo: newSelector). - - senderMethodNode := senderMethod methodNode. - senderSourceRange := senderMethodNode encoder rangeForNode: senderMethodNode block statements first arguments first closureCreationNode ifAbsent: [ self fail ]. - senderSourceCode := senderMethodNode sourceText copyFrom: senderSourceRange first to: senderSourceRange last. - self assert: senderFirstParameterValue equals: senderSourceCode - ! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:57:44'! +testGrayBA61 + | form n read bytes | + form _ JpegTest lenaColor64 asGrayForm copy: (0@0 extent: 61@61). + self assert: form nativeDepth = -8. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ JPEGReadWriter2 new uncompress: bytes into: nil. + self assert: read nativeDepth = -8. + self assert: read extent = (61@61). -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:42:08'! -test29AddingParameterAsFirstOneWorksAsExpected + n _ form boundingBox width * form boundingBox height. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword | - - oldSelector := 'm1:' asSymbol. - newSelectorAddedKeyword := 'm2:' asSymbol. - newSelector := 'm2:m1:' asSymbol. - newParameter := 'newParam'. - newParameterValue := '2'. - senderSelector := 'sender' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: 'm1: p1'. - classToRefactor compile: senderSelector asString, ' self m1: 1'. - - refactoring := AddParameter - named: newParameter at: 1 initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). - - newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. - self assert: (newImplementorMethodNode arguments at: 1) name equals: newParameter. - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). - - self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments first literalValue). - self assert: senderMethod sourceCode equals: senderSelector asString, ' self m2: 2 m1: 1'. -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:57:40'! +testGrayBA62 + | form n read bytes | + form _ JpegTest lenaColor64 asGrayForm copy: (0@0 extent: 62@62). + self assert: form nativeDepth = -8. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ JPEGReadWriter2 new uncompress: bytes into: nil. + self assert: read nativeDepth = -8. + self assert: read extent = (62@62). -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:45:09'! -test30AddingParameterInTheMiddleWorksAsExpected + n _ form boundingBox width * form boundingBox height. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword | - - oldSelector := 'm1:m3:' asSymbol. - newSelectorAddedKeyword := 'm2:' asSymbol. - newSelector := 'm1:m2:m3:' asSymbol. - newParameter := 'newParam'. - newParameterValue := '2'. - senderSelector := 'sender' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: 'm1: p1 m3: p3'. - classToRefactor compile: senderSelector asString, ' self m1: 1 m3: 3'. - - refactoring := AddParameter - named: newParameter at: 2 initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). - - newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. - self assert: (newImplementorMethodNode arguments at: 2) name equals: newParameter. - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). - - self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments second literalValue). - self assert: senderMethod sourceCode equals: senderSelector asString, ' self m1: 1 m2: 2 m3: 3'. -! ! +!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:57:35'! +testGrayBA63 + | form n read bytes | + form _ JpegTest lenaColor64 asGrayForm copy: (0@0 extent: 63@63). + self assert: form nativeDepth = -8. + bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. + read _ JPEGReadWriter2 new uncompress: bytes into: nil. + self assert: read nativeDepth = -8. + self assert: read extent = (63@63). -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:45:01'! -test31AddingParameterInTheMiddleWithManySendersWorksAsExpected + n _ form boundingBox width * form boundingBox height. + self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! - | refactoring classToRefactor oldSelector newSelector newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword | - - oldSelector := 'm1:m3:' asSymbol. - newSelectorAddedKeyword := 'm2:' asSymbol. - newSelector := 'm1:m2:m3:' asSymbol. - newParameter := 'newParam'. - newParameterValue := '2'. - senderSelector := 'sender' asSymbol. +!JpegTest class methodsFor: 'test examples' stamp: 'jmv 2/21/2019 16:55:22'! +lenaColor64 + " + ('LenaColor64.bmp' asFileEntry readStreamDo: [ :strm | strm binary. Base64MimeConverter mimeEncode: strm ]) upToEnd + JpegTest lenaColor64 display + " + ^Form fromBinaryStream: + 'Qk02MAAAAAAAADYAAAAoAAAAQAAAAEAAAAABABgAAAAAAAAwAADwCgAA8AoAAAAAAAAAAAAA +QWCvUXXHUHfGRGi/OTZkIB8tHx0qHx0oISArHh4pIyEtIR8vIB4qHx0pJyQxJB8vNCo9TjpI +V0NOHR0rHh4qHR4qHR0xISlbJTx/Kzl7IidFMUSPNU6lOlOsPVWtPlaxQFm3Qly4QFu4QFq4 +PVayOlWvP1myRWC3RmO3Um6/XnnJZIHNhJjbmKXhnqvmo67nmKXcKC9TLzlhKzJaLC5RJihG +ISNAR2ioYJbdQmaxJSxTHiA5IiNCKCtPLC1RJyZDQl+uUXTETnTDRmrAOjtrIyEwIB4qIB4q +JiQyJCIrJCIvJSExIB4qHRwoJyQyMSg1XkZSUkJUT0FmHRwqHh4uHR0tHR4sHyE6JjJzLD+K +Jjd6JSlIN06hOlOsPlSsP1a0Qlu4Q1y4Pli3PVe1P1q0QVuzQ1y1R2O6UGrAV3PEZH/OcYrR +h53dm6rln63moq/naG+gLDZdLzhkJitSJCVGHh80HR4wSG+vSoDJY5TdSnrJISZTJCVEJSdJ +KzBZKy5VR2S0UHPFUnbIQ2a7MzZzJyM2Hx0qIB4oJCAtJiMvJSItISAuHhwoJiQwNCw4UzxK +RTQ+JiEsLiY4KSU1HB4uHh8tHh4uHh4wHyVOLT6HL0KLKDJqLzluOVGnO1CpPle0QFq1Q1y5 +OlSxPVexP1m0Q164SWO7SmW7U27AVnPDbIXPfJPWkaXknKvloa7po7HpOUh1KzJVIyhKIidK +KCtLKS1MMTlgQl6cRXK2VIHEcajtNFKeJStTIihWIyhQMDRgSWm8UnbJVXrKQ2a6Mjl1JiQ6 +IB8pJCM0Hx0pJCAuIyEsIyIwJiMyJyMwJyEyRDVALCg5STlGLCQ2X01WRT5PHR8zHyA0HiAx +Hx43KTd1L0OTL0SWKSlTOE2gPlSrP1ezP1q1QVq1NlOtPFiyQFu1RF63SmW7Tmq/VnHBX3vJ +cYrRgZfZk6blorHvo7Ltoa3mMUJ6LDRaMTplOkdyQU99RFJ/R1iHR2OiOlaaSW2vfrHuS37L +Jzh5JitaJjBiJipRTGy/U3fJUXbHO1+0QkZ1ISEwHx4pHhwnJB8vKCUwIB4rIB8qIh8qJSIu +MiY2Oy88WkRLXkhQSTdEPTU/Hh4oHiI2HRs0HCA2HR0yICRPLkCHNUmbJCxfNkOHPlOrP1ay +QFq2P1e0O1WwO1ayQFu0RWC4Sma9U27CXHbHZYDMeZPXiZ7glqjnna7robDrY2ubRl6ZSluH +SluKRlmISluKSVmGR1aCQVaPOFafRnO+fq7vZZvkMEqTJzd2KzRnISlcTGy+U3bGUHG+RmGx +Rj9tISArHx8pIyEuJiMzMi06KSY2JCEuIyEvIB0pLyc0HxonSjdEZU9fU0RUUkZUUktfKylM +NDtvJyM5HR4zHyE7KDh8M0iaLjt7LDZtOE+mPlWuP1i1PFaxOlOsPli0RV22SmO7TGi9Um7C +X3nJaobRgJjbj6Tjmazrna/qnq7oSk9zR1yaU2maTF6NS16NSFmJRlmHRFOAQVOGUnm/canx +d6rsc6frPF6sJjt+JjNqLTt2TW7AVHnNVHrMQ2S6MDdnIiEuIR4rIR8rIiEqRC9BJyQyIB0n +ISAuIB4pLSk2SztJPCo5YEtUVU1lfWiCV1BgFhgoIiNAHB4yICE1ICE1KjFcMUaXKTqAKS1b +OE6kPFOuPVWwP1ewQFaxQ1y2SGC4S2S7VW/CWHPGZ4LRc47XhZ3gkKfnobDtoLDoprfvIB80 +Q12fTGOZSl6RSV2RRViIRViIRFKAO06BUHK0gLTweqvvfq/uToDMLECBKDNsKjp1Tmy9VnvP +UnbKP2O4SUp6HiApIiArHx0pICAqNCgyLSo7KCY0JCAuNC4+MSEzTTdHSDZGY0taaFFkGhoq +X1x1HBwpIydFHhwvHh4xHyE0HiE9KjmBJzZ4JyhLMkiePVOrP1WxPVWxPFavQ123R2C3TGa9 +V3LEWnfIZ4POdI7WhJ/kkqnqobLsprXsbHqpICE4Q1qZSV+VSl6VR1ySSFuLR1eGQlF/PEpz +P1iUe6nsa6Dpg7Xwap7iME+VKDNmKTZuTWu9UnbIVXfKPmK4Sk2LExgkISAnKCc3Hx8nJB8u +PS9BJCAuOC8/LSQxOCs7SzZFQjBAZk9bcV1uQzxQT1FtHR8kIyRBHyAzHh0vHyA2ICI3LDdx +KzZyKi1KMkSYPFGoPFKsP1WsQVmxQ1uzSWK6T2u+VnLCYn7NaofTc5LcgqDljqfon7HtpbLn +OTtaISM7Lz9vS1+TTWGYSl+URliKQlOEQ1ODRVOAN0l+QmatW4fNfq/sdafoUYDHJSxfJC1i +S2m6VXfLTXLGQl63bG2TJCE5JCExJCEwIB8wJyMzMCc4IB4rJiIuSThIMSQ0QzFAWURVZlNg +RTZHYl2DPTpLHR8mKCpHHB4uICAxIiM5Jic+KTFjIihdMDFZO0yYNkmYP1atQliuQViuRl20 +UGq/Vm/BYnzLY3/KaIjTdZXehKPoj6rpoLLsWl+DHR83IyZDPUh2S2CTS2CWR12SSFmKRliK +RlWFQk95QE13Mk6RPF2jfq/ue6zrZ5fYLUJ7JytTT23AUXLGTnLIQV61XWCRPEBpISErKykz +LSg8OzBJOi9DKiMuMio+SjtLMCIyRzRDalJgaFJZUVFwOi1FKChFHR4pJShFHRwuHh4wHyEz +Hh40JipRIiNBLTNiM0ONNkePPlGfQ1muQVesQ1qwT2a4WHLBZH/Jb4vTdJLYfZvgh6LkkKfj +eoCjIyc+HR46JCZIR1F3RVuTSl+SSVyPSFqNRFKCRVGAP0tzNj9pMUqHLkSBa5rcd6rqcaHh +TXK1ISE8UG3AU3LHVnTFU23AKipTQDxVIB8pJyQyLyU3KiQ0NCw/KyQyVkBQUz9NVkROSzlH +SjNAUz1STUJZOzFIICA+Hx8tISQ+Hx8wHx8zHh4wHyA1HyA/IyU+KC9gNkWMOkuYPE6bP1Sk +RFmsRlutR12uVW68cIjOe5XWgZvdh5/fi5/ZR01qIiE6IylIIyRFJSlNPkBhP1WTSlyORFeM +P058OUp/Mj5rLDVfKTBWMUBuKjNdV3m7b6TreKbnZJPXPlqZUG7AVHPFUHTHQFqqYWeUKiFD +JydEKSM1KSU4KyY0Ix8sVz1KXURPJyExb1RbUT1LZExRQz1RXlJrHx4rISE6Hx8yISQ7Hx8w +HR4wHh4xICE2HyA8HSA6KTJkNkWTOEmYPU+fPFKdSF2vT2OySV2pUmaxaoXEf5fVd4i5TVZ5 +ISEuHyAzISM5ICVEJihKISZIKypEQFKQOUl7MUF0M0B0LDloMTtmND9pO0VvQEhvQklrZYjI +canvb6Lmc6PkYYzTUW/BVXbIT3PIPFquIytXTERnNjlRKSE4KCQzKSM0IRwocVFPPTA+QTA/ +YUlRY0tdW1ByST1UHR4pHR4rICI3ISI2IiM6Hh0wHh4wHh40ICI5ICI9HiJDICRGICZTNT16 +N0aCOEqLTFusVmm7WGy7XG29XmqlMjdgHxw1ISAzIyI5ICE1IiM6LzVWJilLJCdGIyA9Qlyd +MD5qNkV3QEt/RlWDSlmFSluISlqFRlN6QUpvYHyzhLXyea3sdqfpcaLoUW/AVHbIUXTGPVqs +KC1gKipSLClGNi5GJB8tKCExKSEwc1RVRzRCZEhQWUJMX1J6KClaLjBUICAyIiAxIB8xICE2 +IiE4Hx40Hh8xJCY8IyQ8HiA6HyJGHyJLJzRxNEWZPVGmQVeuTGK3X3PGXG/AXnC/UGGqLThw +HR00IB8xHx83ICA5IiI5MTZbJytNHiE8IyM7WXCvRlmOTWKVTWGQT2GRS1+QT2GQTV2HR1WB +TFZ9T2WWksD3fLHvfrHwg7DuTm2/VHjMVHjMPVywIydaODZdNTBTLCU3JCAwLCcyKSMwmXJo +VT5CW0JSSjZGRj5iPT1me4rgISdKHx8uHyAxHB0xHh0zICEyHyA4IyQ+ICM+JCZGIipdLjl7 +MkKQOEyiQVWsRVqxSFyzTWK4VGq/VWy/T2OyQFOfIB42Hh4wHh8zHyA4HR41KzFSJypOJitF +IiM9W3GvSV6UUGicUGaYTGGUU2eXUGOUTFyKTVuIRlR+QVSBj7v2irv3h7TxhLDuUG/DVXnO +VnjNS2O2Ky9hPDtlOTxvKyg8NTBHOCo4KiMxVjpETztFRzlJUjVBR0BaKz6AYmGeSGGcHCA9 +HB4uHx8yHR4yHx82IyM+HyE6KClOIidQKzd7LTyIN0eaOU2oQFSsQFaxOk+pNUmfNkqjO0ul +QlSmR1ajLDl3Hh8xHBwxISE6HSA6JitHLjJVICJAJSZAVmypSWKgT2idTmWYTWScT2WbTmKS +TV2PSFqMR1aIRliHgrPzirn2irfxjLfyVXXGV3nMUXfLQletQUB0JylWS0iDMSxONSw9JiAt +OCs8SztFQjBAUz5MQzlKSTlKPlWjcX2zOUp6U1mGISExHx4wHyA4Hh80JilDHyA3JypPJzBo +LUGQM0WaOEynPlOvQlu3OVKxM0utN024Tlq/cnrQcXzPSVWrQFWdHyVJHR4xHB0wHyE8HCE6 +JSZLGx06JyhDR16aQ2GlTmmkTWScUGaeTGKYUWSXSluRTV6SSluOSV6TcqbthbTzgrHvh7Lv +UnPFUHPGUnfMPlyxJy9oRkJ4ODpyNy5OOi0+JyExLCczQDE+RDFBQzFDSzxLTjlHREB0hIGs +d32sKCpaNTZgHhwxIiRHISE4JidCHh41LjBbKjZ8N0mhNkqkPVKvQVezQFayLj+NLDiALz2O +LjuGJTaAP0upNEOXN0iQMkGGHh8yICA0HR02HSA8ISRGHiI7NTpZOkyAQ2CoTmilTmWfTGGZ +T2KXTF6SSl2TSV+VS12TRViMYJThgbLwfq3sfq/uTm7DVHTKVXnNP12wJy1iJypcQ0F/PjVY +Tz1NKCQyKyMzLCQzNys7Pi8+XUJYRkdqHR0uODhVWVyDTmKcR1GHHitRJiRBHyA2JydCGxw1 +LTJlLT2MOEukPE6rPlGyPlS0Q1i1Rly5SV22RluxT2O6WW/Ic4zceILPU2W1RU6aIChMGxwx +HB0yJCZHIyZGISM+OT5lPkRzRWClTWajUGafT2OcTmCYTGCYUGKYSl6WR1uTRFaMVonVc6fu +fa3udqnqTm3DUXLIU3bPRF+zJy1gJitfNjdyOjNeLig6PzJCJB4tQS9BUTlIaE1XWEBPLic5 +IixTKSc2NzZMWl6COURyTWGXHhwuHiAzIB83Hxw0KDBsMECSNEiiOUuoQlW1QVe2SV+9UGXA +VGrDUGW7SmC0Vmq8d4TQiZnaWW68RFSkMTqAHh80HR4xJidLHB4+IyQ/Uld+VVuFP1iaTWSg +TGWhTmOeTmObSmCYTmGZS1+XTF6TRFeHVoTOYZnleq3ve6rtTm7DUnTITnPIPFiuLCpkKy1l +Nzt2PTVjNSo8RTlTSjlJNSo5RS45WUNUUUNHHx4uHjFIKyYzMDBWLChEKTFPSF2ZbXSVIR81 +Hx8yIx02MjpyKzyLOkymPU+tQ1e2SF26TmPCUGXCUmi/S2G2OU+kOk6nOEqYZXK8W3G9RFem +OEeVISNGHx8yISNAHR8+ISM4U1qJQkZrO0uCRmCgT2ikTWOfUWWcSl6WSV2TS16WSluSQ1eI +T3a+X5fmZ5/oeqvtUHDGUnXJUnbON1OoLC9ePjx3NjduNS5hNyk8SzdLMyQzNy9AVz1JWkRP +JiEzHx4uIyMzHiIvMD+GJylHIyMxVGWNQVOEPklzHh8wJCE5IildLD2JN0mkQlSxRFm4SF69 +TWO/UGfBUmm/PVOpPFGoNkqgNEimUmnCeI3TRlurPU6eKTV0Hh4zIiQ8ICFBIyQ3V2OYNTdX +MzlbQFmaUWilT2aiUGWdTGGaSl6VSF6XTV+VSluTSmahYJfkXpXjbaHnUW/CTnHFTnHJN1Kr +JipdODtvU015SkRwPzVLRDJRNSo3TjpGYEJKSTpWIBwtIB8rIyEvLzhlLzZqSkmDKSVIGh8o +MUiDh5O/IiVHISM2IydWMD+OOEukP1KvTWPBUWfGUmnDV27HVWvDP1awNkmgNkuiOU+nY3LH +sLnqTGKxQ1WlL0GNHiFBICA7JCdIHiA5Y3GkIyQ/ISI8QFeWT2mnTWemSmOgSmGcT2SfSl+Y +SFqQRlmPSFuPXo3VW5XkXpfjUHHFU3XITHHHOFOuJShaMDRlNDV4U0+FSDxLQzpUPTFEKx8s +SzdDNCczIx0vHh8rIB0rLCs/JyQ7OztoPUuHHR0sKjViZnKpcXuiICAwJCpVKz2OPU+pRVi0 +S1++VGrIYXfQYXjQXHPKSWC7QFSsOU2mPVOugI3WipPOUGW0SFirNkeUJStcHR03JylJLS5J +VmWbHiA1IiM3QFCISWGbTmqrUWilTWSgTWKeTF+YTF6WS12URVaLUm6rXpbjWpPkT3HFU3bL +UHTJOlWrJy5gJy5mND+CRUB/RDhSLiM2KyU2PS9BPik7QDJFHh0qHh8sIyEvHRwsJiQxOj1q +ISY6Hx0uIx4vPUuHaYK/SEp7ISRRMEGVOU2nSFu4U2fCXHLMaXvRZXzOX3XJTWS7Sl62PlOt +RViwmZ3ggpLRV2q5SFisOEmaJzBwIiI/IiFBQEFiTFKDIiE1IiE2NT5kR1qSUWqnTmaiTGOf +SmGcS2CbTWGZS1+VSVuSRFWKV4HIXJblUXPIU3nPVHjPOlaqKC1hJjBpKjZ6VFCFX1V2SDln +MSU6JSExSDpLRjFELCE1JCIuOys6V0FNPjRJMTBLJSM3Hx4vHx4wMTReU2OghJPDKzZnMUGN +P1KnSV21XXDHZXjOZ3nLZ3vMZXjIU2e7RlmvPE+rRVeyp6rlgI/SVmm2QFKnOEaXKDJzHx8/ +IyFCPD9lPUFqIiE0IiE1LjBKQ1aNUmmnU2qmTWSjS2CbTmSgTWCaSVySTF2VR1iMSFyQVoTK +TXHGVnrRUnjPPVmsKjBjKDJqLTyANkGMUlaJQkJoNStMJyM5JyIwVT5KVj5LKyc0NSs4Pi8+ +YUdWMCtBHx0tHx8vIB8xHh4uQEqCa4LAe43FKDmCPEueSl6yU2S5UmW5UWC2Wmq1W27AW2u5 +RFSmPU6oT2K8qq7pdILATF6rO0iYLDZ4Ji9nHx8+JSVCPkRpOTxgISA0IiE1Hx4zRlaJTmSf +T2elTWWjTmWiTGOfTWKdTWScTWKXR1uPR1eKTWKUUHTKU3nPT3LHN1GlJixcKjRtKTZ0PEyJ +KipRNDVRV1eYaHeoNS5ZNTFBNCY5MCc4LyMzUztJQzJCJSAzICAvIR4vICAxHx8wJzBXWmeb +cX+3eIG3NkWTQlCgR1epNUKMPkmNWF6eX2GnUVyyOUqaOk2kUGW7rbLtSVSQR1CUU1COJC1g +HiNKHh46JSQ/SUptNzlfIiA2Hx8wJSU5PENuRliPVGupUmmnTmWhUGeiT2SgS2KeUGWfTF+a +S12SR1iMTnLIUnfKS23BNU6fJSdTJSxhJzJxKjZ2LjVvJi9kX2+pQ2GxQlekJy9XJCMtMCY5 +Lik7QDE+Nig8IB4rHBwqOzRDHxwuICMyIyM0MDphZHCegY2+cYC3NUWNLDNfKCtUKypLRkNd +l5nOOUOMMD+KOUugUWi9mKXhM0KCKCpGNzZYQUqIHR83HB4zJyVAT1FyJiVHJiY8Hx4xIiI2 +LC1KRliST2ikTmelUGWgTGShTWOjTWSjTmOgTWSgS2CVSVuQT3HEU3fMTG7CNU6fKCpUKC1f +KTJqKzZ1Kjd2JzRyVl6RQFOdRV6uNUN8MTJsKCQwPCtHOCo+Tz1SJCAvMio7HhwvMSo3RTdH +HRwwKSc+TF6ZXHi4iZK+anOxIzBoIiNEHR83JCQ6NzdVJixUOU2hPFCqU2zEgJDabYDEIidS +ISA5KitIHiA5HyA6IiI3Q0ZxJydHKSc/IB8zICA0IyA1Q1SLSl6WT2enTmalS2SjTGWlSWOi +S2SfSmObTGObS2CWTnDEUnTIUHXKNk2dKSpUJSpYKTNqKDNxJzNyKjZ2KjiANUONP1ahOUeK +LzJTMD9+ICY/PjFDMyY3RDJEICAtISAxLyU5Hx8uMSg7KiU9KjBRZ3WxdIW9cYG0aHqxOkyM +NkWPOkmOQUyYKzV7LTd5S2K5WnPLdYvaeIrXW3HBMT55JSxeKjZyJSdLJCE5Sk16JiZBJyY7 +IB8zIiE0IiE1PkZxR1WITmmoTmenUGimTWWjS2OeUGijTWWfTWWaTmKYUXDCUHPGTm/EM0qX +KClSJipbKzZsKTRzKjRyKjd4Lj2BNkaNMUCPMkaGKjJhdXurNEOCLytLLSY6SDVEIiAvJSI4 +JSQ1Hh8vLio5LSY8KCU4NkR+UGmmbH+3Z3WshpK5T1+lOEWCPEWBRlabZnjLZn7UZ3/UeI/b +d43ZhJjiepLhVmiyLDJqHh02JyY/VFmIHB00IiE2IiI3Hx8xIiA0MDBMQVCFT2ahT2ioUWql +T2afT2efUmqkUWWdT2WcUWaZUXLGUXPDUHHENUqWKChUJipZKzRsKjVxLDZ3LDh6Lz2BNEOR +MEOWMUaLMEN5MD+JSkiAQ0J6JiQ2Nis7JCAwKSQ3LCU6IB4vIhwtLSQ5JiExIyQtNj95XW6s +X3azgY29bnynZXSyWmy7XXDBZnnMaYDUdYvbh5vkh5njjJzil6fpj53hNEaQIiU9JCQ8TlWD +HyA3IiI3JiQ4ISE0IB4yJSI1Q1CESFmRVG6rUmukU2ujUmylVGujUmecTmGTTFuJTnDET3HE +T2/EOE2aKCZTJitcJzBqKDNvJzJxKTN1NEGKMj2FNEOQMkCDUXK4M0KGP0mMRE+XMjZ4KiM8 +IB8tLSU6JyM1IB8wJCM2JCAxRTdMQThMJzFOUGGeZoC8cYO3ZGqThI+9aHeuWGy1X3XGaH/S +fpLcip3jjaDklaPmmKbnfI7WLzh3ISA0KihEU1WFGhwvHyA1IyI2ICA0Hx8zIiE0OD9kSFqM +UWupU2ulU2idUGWbTmGWTl+PU2OWUF+STnDEUXTIS2zAN0yZJiNQKSxdLjdwJDFtLTZyKjV1 +MTl9Lz2GLzyDSV+cYYjXLzt7NkOFPkuSLjx9Ky1ZKCpJKSM5ISAwISAxLig9KyM4HR8vPTBB +ISAzKDFUS1mYYHe2b2yLc3+vbnyxaHWlX3CyZHfId4vWgpXbjJ7jlKXnl6jrX3TCJCpaIyM4 +SEZgREZsHh4xHh4yJiU4JSQ4Hh0vKig8LCk/RVSHTmGWUGOcUGCWUWObUWWdU2iiVWqlV2ul +UHHGUnTISWrANEmXJidKIyZWKDBnKzRvJzJsJjFvLzt9MT6FMD19XXCtb53pNU6SPEiEOUSF +PkaNOkydMTVrLy1RJiQ3Kyc6MSpBKSU2Myg7PjFEICAxISA1LCtESEl2fICVbX+3doS0Y3Kn +dICxYnKqbH29gZTajp3hipfbhJXaRFimJCpNLy5MR0ZnPEV2ICAvHBsuIyI2JCI2Hh0wISAx +JSIzQElyRlJ8UWWbV22pVm+rV22nUmekVW2qUmekT3HDUXPGSGm/N02ZJiZLKS5ZKjJoKTRu +JTFuJDFuKzl8Kzh5LTp2dozFWoXNPVCXOkeJQEiGPEaDVU18S06LPD1yNjBYNi1JKyQ7IiAw +NCpDIh40JiI6Jh81Mig8U0BUW1V0bXigdoe8c4O1bnyxcH+zcH+veYe3hJDQhJPZfI3PNUKL +LS1cPDtZT09zQFSYHh0xHB0tIyM2ISE1Hx8yIyMzJCI2MC9LPkhzUGKZWHCrWG+pVm6pVGqn +WW+oVGqlT3HDTHHERWe8MEWQJSZLKCtcJzBlKjRtKjRuKTRwKjl7KTd2P1mNaazyVXe+SmCi +O0uMPkuMOUSFRE2KQ0uPPkabMDJgLSlJKyE3KCM3KCU7HR0tMyxKKyk+QTFKLyU8QjdKVlV/ +d4i9fpLFdYW1dYOzan2wc4Cxfou5c4G2XGyrKCxVKipJSEZkSk14XHa+UG6uISlMHx8yIyI2 +Hx4yHyAxIyE0JyI2P0h0S1iOWHCrVWymVGqnVW2pVGmjUGajTXDDT3DCR2m9L0SNJyhMJSpa +KjNqJzJrKzVwLDdyJzV0KjVsZ3y6SX3lSGq7O1WmMzx5QlKXPU2UPkqJQ06WMjxzQk+SOkaO +PT9yMCg/MytDIyI1OzFDNClJNi1DPDBHKSU6SkFOOk6Lc4G1c4a8doW3eIe2dYa2eYi2e4y6 +iZa7XG6gPT5lPTpYWWSbTW6+VXO+Y3m/KjRWISA0ISE1ICAzISAyJCI0OTxeTVyXU2elV26p +V2unVGqmV2ulUmajTnHHTm/ESWq+L0SOKitRJy1cJy9iKjNvKzRuLDd0KjRyKjRshrPtYnzN +PlKsNEqMMj+CMjx4PE+WOUaIPEiMQU+VPk6PQlOcQESCQ0F8QDZXPTNWKiU8STdMRjZPT0Fe +MixBHiAyIx4wUlqQa3SrboXBh5bFhJLBe4y8gpHAi5fCj5jGjZjFbnSiMzdjLzVhO0l/T2Sh +Zn/CLTZXHx4yIiEzIB4xJiM4JiM3TFqXTV2bVWuoU2ilU2mlWWylUWWgT3LFT3HESWm/MkOM +JidNJyxaKzJlLjdxKTRtKTVxKjZ1MT5yUZPvZpHWOFWhO1ipOUWIOEF+OkV/O06TQVCXPEeK +QlGSRVScS1WdU1SaRkZ5QThlPTBSWVl4Yk1mSTtYQDRILCY+ISA9KyY+U1qDXm+tg5XHhpfJ +gI+/g5O/i5nEj5zHk5/MkpzJjZnQWWWXMDp0KTFYOkZ8Zn25P0RiISAzHx4xHx8zICAyO0Fq +SlqbVGmmUWipUWenUWWkT2KfTW/DTm/DQ2a8LkCIJylQJCpaKDFmKjNsLThtKTVwKTVyUVuO +cI7XPWzRQF+sNUykN0OFQE+aRk6NNkKFQ1ekRVSgRFGVRVaZTFqfSVeUUVSNVFCHSE6HY2uY +VleCTVaFWmepXWajZG2tS1CDUlWAYGukb4G9d4u9iZXGhpTCipbCjprFkJ7KlKDNlqLOlZ/I +mKbPVGWlND5vPUVweIvBHB8xHx4yIiEyJSQ5Kic/SluZT2CfUminUWepTGKgUGakS23BTGy/ +RGa6MUGLJyhQJy5fLDNqLDZwKDNqKDVxJjRwPD95WJPYP1e0PFm6MkaUKzl0PEmMQE+bQE6K +O0eKQVakQFKfSFObTV+ZUWWrUGSrYGq0am+yamukYHO8VmapX3SuXm+0XGyyXm6zZ3CpYXCu +XGmhaoCxdYbEhZPIfZPJhJG/jJjDkZzFk5/LlZ/In6fOiZTBXm6cT2GgaHOhQlByIR8yICAy +ICAzJCE1QENtS1ycVGilUmioU2qqUWWmUHDETnDCRWS4MUKHJyhQKC5fJzJrKDJuKDNsJjJv +Kzh5KDBqUpXuRGexN0+VMj+CMDl1NkOHNUGERFalVGCnO0yTUGGsS1mgUF+jWmasVGGjYnfB +YW6wZHSyYHK4ZG+yXHGwYHazaHizZ3i3doO+a3uybXywdH60cXuteZHDiY6/lKLMiZjHiJbD +jZrEk57Ik5zIoaTNany1X2ylU2GWXG2eIB8xISAzHx8wISA0LCpETFuXUV+aUmmnUWenUmeo +TG7CT3LHRme6L0CFJidPJSteKjJqKjVvJzFqKDRzJzR5KjVwUIjkN1esLj+EMDuAND19OEaE +O0aQPEmIRVunQVOgQlaVU2WvTF6dVWOqY3S5ZHW0aHq6XHO6bX+9anq9XXG2an+/aX3Fc4O/ +doW6gou9cH61aXu3c36ucXqncoCwe42/hJHDk6TPkqLQj5rGkJzJlp/KkaHNY3WtiZfCmqLN +IyQ7ISEzICAyIB8yJSI2ODldTV6fTmKfUmmsUWepS23BUHHER2e5MECFJidPJitdKzRqLTdx +KTNtKTVyKjd5LTp3aJbiN0+iLDh2Kzd5KzdxMj18NkKJOEWLPk2PSF2pR1mhSVyeUmmyXXKx +Wm+3b3a0aHq2ZnK4ZHe/eITJYHy9eYjAbYTDaX65g4zCfYzAgou5hY3Ag5C+h466gomxlJTA +cYK+g5jOk5jOkqPQkaDJk5/Im6TOkZ7Jm6PKr6/VWWOIIyM1HR4wICAyIyE1KCc+R1CGTF2c +UmmnT2WoSWm7Tm7AQ2G1LTuAKChPKS9dJjBoMDt2LDhzLjp5Kzl+Lj6CaHq7NkeRLDRsLjqA +NEB/OESKNUWDPUuWMkCIOUiKUWWvS12nU2uvZna5aX2/bn+5cYXIg5LMbnq0donGfIzFe43H +jJbJpKXNdIe5eI27jZnJmKTRlJ/Ll5vEoqLHdoW5QWS8UmaxcoS9hpvJl6TNmqnSmKPPmKXQ +n6nPqK7TaGqFIiI0JCM1ISAzIB8zJSM3LCpFTF2cSVuXUGeoS2u8SGi6P1yuLz1/JiZIJChU +KTFmKzRuKjRxLjl2Kzh7MT+CT3K2OlWgKjVxMDt8KzdvN0WSNkaPMkGBOEmUNkiNOUSGY3Wv +XW+zWnG4a3zBcoLGeY3IZnu3kY/Ae4bAi5nMkJnQlaLVjJnNmKDQgZXCk6PPmKPLoafPqavQ +mJu9N1ShRmW6P2CyM0mRUE5yeYKojZi+o7Hal6bRkZzEqq/Ta3KhIB8xISE0IiEzHx8yIyI1 +IyI0PUJoTV6bTWGdSGm8TGq6P1ywLDp8KChIJilVKTFnKTBmKTJnKDNtKzZ2Ljp9R1SOPl2t +LjdyLzl5NkOBNUORPUqIOEyXN0OJPlCWQlGVOUh8YW+vYHm9bHq7dYG4Znq6fZXLbYe/nJzK +hZHAkprJlaPTlqHTj6LQl6XQoKzToKrQqK7TsrPQLDdsP1mnRWW4RGO0OFGcJCtWIyI1bnaN +jJq+srrWqrXbo63Tb3GUIB8xIB8yIB8yIB8yHx8vJiQ2JCM2SFWJSFiRSmm8Smi7QFywLjt9 +JSZJKy9eKjNnLjVsKTJsLDdzMDp8Mz+CMTp+T264Ljl3LTh4MT1/NUODO0eLOUqIQFGTSFyg +PFCTPEuOO0yTVl+UdIXGb3+5cYrGZH+9e4vIk5rIi5nLoqbXnKnWpavRm6bQpq/aoavToK7U +v77gaG+TLj55QFurRWK2Q1+wOU+bJCpXIyI3IiE0S0xkmajSoKvPubbOSk5zISEyIB4xISAz +Hh0vISAyIiEyIiE0KilBTFqVS2m8S2m6QFmqKjd8KSlNJypdKTFmKjNrKDJrKzZwMD19Lj2C +M0GKN0+UKzh6Ljt4ND2BN0CGNEJ+OEaLQ0+NSViqQVCVRFOaPk+dQlGUUVyccH6ydIfEgJbO +cIvJiJXLoabTm6zcoazUpq/Wn6nUoazUoqjQsLfblpy9MDNfLz5/P1mpRWCwQl2tO1GdJixZ +IyE2ISM7KzduO1KjQFWgPlehOE+cIB80Hh4vIB8zISA0Hh4uIR8zHx4xJCM0MjNSTGzASme5 +QF2vLTl9JidLJi5ZKTFlKDFrKzRtLDVxMz58M0KGMUCIMkKMM0SMLj19NUKBMkGFOUSFN0SF +PEuFPU+WQ1SWRlOXQ1mjRleUSV+nVm2qcX2xfpHHkaLRmKTTiZbHmp/Noa3dmaHLo67XpbLd +pLHVl6DANDljJi5eM0WKQl2uRGGzRmCwOlGcJStYISA1Ji5bO0+bQV2xO1SkOlWnQFqpLz96 +HR0vHh4vISA0ISAyHyEwHh0wIiM1Kyk6RGi+SGi7PluuLTt9JSdMKS5hLDNnLDVvKTVtLTdy +NEB+NUSJNEOPNUaOOUmRM0KGMj97NUKDN0OANkF5N0OAOEiIQ1KNQFSbQlWdSVmeTl2dVm2r +c4K/eICyl5vDmKTTr7Dcpq3ZoKvSo67XoarUt7rakZnAJCpVJS5eKzRqNkeNQFuvRmK2QFyu +NUybJSpVIiREM0KEQ1ytP1qsPlelPVanPVeqQlquIylOHR0sIB8yIiI0Hx8vISEzICEvIiE0 +Sm7BS2i9PVuwLDp/JidNLDJjKjFlKzVsKjRuKTRsMT9/MUCFMUKKNkWMNEePMkaRLDp+MD16 +OUaGP0qRPkyMOEaKQE6URFaUQUiDSlqiTV6hXHOzcYW8d4u+bIS/jZXEoanTqbHcpq7YoK3X +oK/boKjHKDFeLThvMDlwKjRtPE2TQF6yRGK3QF2xO1GeJClYLDRtPVOhQlywPlmsOlOkQFur +OVWlQlqsN1ChIR84Hh4tHyAxHx4yHh0tIB8zHB0rTHDDS2y9PF2vMD2CJihNKS9fLDJlKzVn +JTBnKzVyLzt8LDyBMkGGM0SLNUeQMkWSPlSeNEOBMz1/NkSBOkeLOUePOkmKQ1CVR1KWTl6i +TlmSXXGndoO8gpDCeI7Fh5fGgJPJgYu6kKPLqKvJsa/FSFN/LTl2Ljx4MDx6Lzl1NUiQQl6z +RGO5Ql+yNkuXLTt8Ok2YQVytP1yvPluvQVusP1mpO1apPlurPlusMUSHHR0tHx8tIiE0Hx4y +ICEvIB8xS23ARWe5P16xLDuAJShLIilXKjFmLTVsJjFsLTh0Lzt8NEGIN0WJNESLNUiTN0eT +NEiNOlGPPUiLPEWBPEaERFCOQEqMSVaUS1aTTGCUXmyzbnmuZ4K5dou5forAgJLGgZbMfpPB +h5nFWGOTLz17LDt6MkCBLTx6Ljp5MDt4M0aOQFutRmG1P1mnPVSfOlCbQVuqPlmrP1quPVuu +PlenO1akPliqPFmoQF2sQmCvN02QHyEwHR0vISA0HR4vHh8uS2/CS2vAPV6yMEGFJihQJy5f +KzNqKjVwKTVzMTx6MkCHMUCJNESPNUaPNEeSO0uXOUiZPEeYVFyWRFCMPkiHQE2DR1GKQ1eL +UmCgWGKsWWebZnusboO3dYW8gIzBe47IepHDcYGwRlGJMUCGNESLNEWNOEeLMT+DMD16MDx3 +OUySQVqqQFurOlalQVqnQFqqQVytPFemP1uvQFurPFikPlupO1akPVqpPFmmVHzLh7bzPVGP +ICAyHRwtICAzICAyTGy+R2i8QGC2LDuEKSxaLDVtLDdzKjVxLTh2NECDNEOLNUaQNkmTOUyY +NUaSOEuXO02cO0+cO0ucOkubQVCbSVeZVl2WSlmUV2GgaHKrbG6ocX2tb32tZnqwdYO2fJG+ +U2OWMEOML0GLM0aRNEaRN0eSNkeKM0OFLj9/MD18NkqUPlipPFalP1mnQlypQ1+wQ1+vQFus +QF2wQFysPVmnOlSkOFSkQFuoQGCve63xkb73VX7DIyM8HR8vIiIzISE0SWi8R2W5PVyzMT+D +JilYKDBqKzRyLTZyLjdzLDl7MD+HOEiROUmVPE6ZN0eVO0yZOEqeOEqcOEqbO06eOEqdNUqf +PE2aQFOXSFSVUmCbanOfdXuzX3atW2GeRFSONEOSMUaVM0qYN0uYOEmWOkyYOEuYN0mSM0WJ +M0KELzx7NkiQQFmmP1mnRV+tQmCwQ2O0Q2GxRWS3QWG0P16wPlqrOlenPlupPFupY5Lfibz4 +cqLjM0R7LTlwICE5Hx4xHh4wRmW6SGe6Pl2zLj2CJyxcKjJsKjRwLTh0LDRvLjh3NkOJMkCJ +N0aPMUWQNUiUO0yYOEuZNkmbO06gOkyeOUueMkebNEudN0ufNkuZMEWTMkeWMUSQNEaOMkOT +NkiXN0uaNkybNEqbN0yeNUqXMkeUOEyYN0mVMkSNMECELjt8M0aQPlaqQ1+vRmS0RWO2QmK2 +RGS3QmGzQ2O4QmK2P1yvPlusPlysT3bIhrf3iLn3QF2bKzhzMkF9M0B8ISM8Hh8vSmu+R2e6 +RWS6Lz+HKi9iJzFsKjV1JzNzKjRyMTl7NkONOEmTMkSPOEycO0+fOlCfOk2bOE2fOk+hOEqc +NkmbNkqbOE2hNkueN0qaNEaWNkiWNkqWPE2ZN0mWO06bNUqbNEqcN02fOE6fNUmaNUiWOk6a +NkqUM0OKMj+CMT5/O02aQ1ywR2a7RGS6SGe7RGe7R2a5R2W6SGi+RWe7QmK0P16vQWCwcKXu +j7/8YY7VLTt0L0B/NUaFOEqKMkKBIiQ/S26/SGm7RGO4Lj2CJy1eKzVyMTp5LTh1Ljh0MT18 +Lj2GN0iPNUmUOk+dOlGgO0+cPFCdOlCeOU+fPVGhPFGgO1CiN0yfOE2iNkudNUuaOU2bOk+b +OUyYOU+eOVCfOlGhN0+eOU+fNk2bOE2aOE6aN0yYNkuTOEmNMj9/MD1/Ok6ZR2O2SGjASm3C +S2vARmu/Q2S6SGi9R2e5RWS3Q2SyQmGvV4TTgrf5eazwNkyGMEJ+NUeEN0mIN0uJNkqLN0iM +TXHESm/DQGG2LT2AKC5eLTZvMDp3MDt2Lzt1MUB+M0SKO0qQOE6WPFKdOlOePFOfPVSiO1Og +PFSkPlOkO1KhO1KfN02dOE6fO1GhO1KhOlGfOVKgPFOePFWgOlOgOlKdOlGeOlGeOVKdOlGb +OVGaOFCZOE+UNEmMNkWDLjx6P1eiR2i5THC/SGzASW7DR2vAR2m9QmW5SGe3RmSyRWSzS3LA +dqvwgrf4RWqpLkB2N0eANkmFOUyGOk6GN0yHOE+S' + base64Decoded asByteArray readStream! ! + +!AffineTransformationTest methodsFor: 'testing' stamp: 'jmv 1/14/2015 15:11'! +testComposition + " + AffineTransformationTest new testComposition + " + | composition inner outer | + + outer _ AffineTransformation withTranslation: 3@5. + inner _ AffineTransformation withRadians: 0.3. + composition _ outer composedWith: inner. + self assert: composition translation = outer translation. + self assert: (outer externalizePosition: (inner externalizePosition: 3@4)) = (composition externalizePosition: 3@4). + self assert: (outer externalizeDelta: (inner externalizeDelta: 3@4)) = (composition externalizeDelta: 3@4). + self assert: (outer externalizeScalar: (inner externalizeScalar: 7)) = (composition externalizeScalar: 7). + self assert: (inner internalizePosition: (outer internalizePosition: 3@4)) = (composition internalizePosition: 3@4). + self assert: (inner internalizeDelta: (outer internalizeDelta: 3@4)) = (composition internalizeDelta: 3@4). + self assert: (inner internalizeScalar: (outer internalizeScalar: 7)) = (composition internalizeScalar: 7). + + + outer _ AffineTransformation withRadians: 0.3. + inner _ AffineTransformation withTranslation: 3@5. + composition _ outer composedWith: inner. + self assert: composition radians = outer radians. + self assert: ((outer externalizePosition: (inner externalizePosition: 3@4)) - (composition externalizePosition: 3@4)) r < 0.0001. + self assert: (outer externalizeDelta: (inner externalizeDelta: 3@4)) = (composition externalizeDelta: 3@4). + self assert: (outer externalizeScalar: (inner externalizeScalar: 7)) = (composition externalizeScalar: 7). + self assert: ((inner internalizePosition: (outer internalizePosition: 3@4)) - (composition internalizePosition: 3@4)) r < 0.0001. + self assert: (inner internalizeDelta: (outer internalizeDelta: 3@4)) = (composition internalizeDelta: 3@4). + self assert: (inner internalizeScalar: (outer internalizeScalar: 7)) = (composition internalizeScalar: 7).! ! + +!AffineTransformationTest methodsFor: 'testing' stamp: 'len 5/9/2022 17:57:24'! +testDisplayBounds + " + AffineTransformationTest new testDisplayBounds + " + self assert: ((AffineTransformation withRadians: 0.3) externalBoundingRectOf: (10@10 extent: 20@30)) + encompassingIntegerRectangle = (-3@12 corner: 26@48). + self assert: (AffineTransformation new externalBoundingRectOf: (-2@ 2 extent: 10@10)) + encompassingIntegerRectangle = (-2@2 corner: 8@12). + self assert: (AffineTransformation new externalBoundingRectOf: (-12@ 12 extent: 10@10)) + encompassingIntegerRectangle = (-12@12 corner: -2@22). + self assert: ((AffineTransformation withTranslation: 2) externalBoundingRectOf: (-4@ 2 extent: 10@10)) + encompassingIntegerRectangle = (-2@4 corner: 8@14). + self assert: ((AffineTransformation withTranslation: -4) externalBoundingRectOf: (2@ 2 extent: 10@10)) + encompassingIntegerRectangle = (-2@ -2 corner: 8@8). + self assert: ((AffineTransformation withTranslation: 2) externalBoundingRectOf: (-14@ 2 extent: 10@10)) + encompassingIntegerRectangle = (-12@4 corner: -2@14). + self assert: ((AffineTransformation withTranslation: 4) externalBoundingRectOf: (-12@ 2 extent: 10@10)) + encompassingIntegerRectangle = (-8@6 corner: 2@16). + self assert: ((AffineTransformation withTranslation: -4) externalBoundingRectOf: (12@ 2 extent: 10@10)) + encompassingIntegerRectangle = (8 @ -2 corner: 18@8). + self assert: ((AffineTransformation withTranslation: -2) externalBoundingRectOf: (4@ 2 extent: 10@10)) + encompassingIntegerRectangle = (2@0 corner: 12@10). + self assert: ((AffineTransformation withTranslation: 4) externalBoundingRectOf: (-2@ 2 extent: 10@10)) + encompassingIntegerRectangle = (2@6 corner: 12@16).! ! + +!AffineTransformationTest methodsFor: 'testing' stamp: 'len 5/9/2022 17:56:56'! +testFloatInverseTransform + " + AffineTransformationTest new testFloatInverseTransform + " + self assert: (AffineTransformation new inverseTransform: (-2@ 2)) = (-2@2). + self assert: ((AffineTransformation withTranslation: 2) inverseTransform: (-4@ 2)) = (-6@0). + self assert: ((AffineTransformation withTranslation: 4) inverseTransform: (-2@ 2)) = (-6@ -2). + self assert: ((AffineTransformation withTranslation: -2) inverseTransform: (4@ 2)) = (6@4). + self assert: ((AffineTransformation withTranslation: -4) inverseTransform: (2@ 2)) = (6@6)! ! + +!AffineTransformationTest methodsFor: 'testing' stamp: 'len 5/9/2022 17:57:03'! +testFloatTransform + " + AffineTransformationTest new testFloatTransform + " + self assert: (AffineTransformation new transform: (-2@ 2)) = (-2@2). + self assert: ((AffineTransformation withTranslation: 2) transform: (-4@ 2)) = (-2@4). + self assert: ((AffineTransformation withTranslation: 4) transform: (-2@ 2)) = (2@6). + self assert: ((AffineTransformation withTranslation: -2) transform: (4@ 2)) = (2@0). + self assert: ((AffineTransformation withTranslation: -4) transform: (2@ 2)) = (-2@ -2)! ! + +!AffineTransformationTest methodsFor: 'testing' stamp: 'jmv 1/14/2015 15:12'! +testInverseTransformation + " + AffineTransformationTest new testInverseTransformation + " + | forward inverse | + + forward _ AffineTransformation withTranslation: 3@5. + inverse _ forward inverseTransformation. + + self assert: inverse translation = forward translation negated. + self assert: (inverse externalizePosition: 3@4) = (forward internalizePosition: 3@4). + self assert: (inverse externalizeDelta: 3@4) = (forward internalizeDelta: 3@4). + self assert: (inverse externalizeScalar: 7) = (forward internalizeScalar: 7). + self assert: (inverse internalizePosition: 3@4) = (forward externalizePosition: 3@4). + self assert: (inverse internalizeDelta: 3@4) = (forward externalizeDelta: 3@4). + self assert: (inverse internalizeScalar: 7) = (forward externalizeScalar: 7). + + + forward _ AffineTransformation withRadians: 0.25. + inverse _ forward inverseTransformation. + + self assert: inverse radians = forward radians negated. + self assert: ((inverse externalizePosition: 3@4) - (forward internalizePosition: 3@4)) r < 0.0001. + self assert: ((inverse externalizeDelta: 3@4) - (forward internalizeDelta: 3@4)) r < 0.0001. + self assert: ((inverse externalizeScalar: 7) - (forward internalizeScalar: 7)) abs < 0.0001. + self assert: ((inverse internalizePosition: 3@4) - (forward externalizePosition: 3@4)) r < 0.0001. + self assert: ((inverse internalizeDelta: 3@4) - (forward externalizeDelta: 3@4)) r < 0.0001. + self assert: ((inverse internalizeScalar: 7) - (forward externalizeScalar: 7)) abs < 0.0001.! ! + +!LayoutMorphTest methodsFor: 'tests' stamp: 'jmv 5/23/2022 11:29:37'! +testLayout1 + " + self new testLayout1 + " + | pane row1 row2 row3 r1c1 r1c2 r1c3 r1c4 r1c5 r2c1 r2c2 r2c3 r3c1 r3c2 r3c3 | + pane _ LayoutMorph newColumn separation: 5. + pane color: Color red. + row1 _ LayoutMorph newRow separation: 5. + row1 color: Color red; + addMorph: (r1c1 _ BoxedMorph new color: (Color h: 60 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec fixedWidth: 10); + addMorph: (r1c2 _ BoxedMorph new color: Color blue) + layoutSpec: (LayoutSpec proportionalWidth: 0.8); + addMorph: (r1c3 _ BoxedMorph new color: (Color h: 30 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec proportionalWidth: 0.4); + addMorph: (r1c4 _ BoxedMorph new color: (Color h: 30 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec proportionalWidth: 0.15); + addMorph: (r1c5 _ BoxedMorph new color: (Color h: 60 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec fixedWidth: 20 fixedHeight: 20). + pane addMorph: row1 layoutSpec: LayoutSpec useAll. + row2 _ LayoutMorph newRow separation: 5. + row2 color: Color red; + addMorph: (r2c1 _ BoxedMorph new color: Color blue) + layoutSpec: (LayoutSpec proportionalWidth: 0.8); + addMorph: (r2c2 _ BoxedMorph new color: (Color h: 30 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec proportionalWidth: 0.4); + addMorph: (r2c3 _ BoxedMorph new color: (Color h: 30 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec proportionalWidth: 0.2). + pane addMorph: row2 layoutSpec: LayoutSpec useAll. + row3 _ LayoutMorph newRow separation: 5. + row3 color: Color red; + addMorph: (r3c1 _ BoxedMorph new color: (Color h: 120 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec fixedWidth: 20 proportionalHeight: 0.8); + addMorph: (r3c2 _ BoxedMorph new color: (Color h: 90 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec proportionalWidth: 0.5 fixedHeight: 40); + addMorph: (r3c3 _ BoxedMorph new color: (Color h: 150 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec fixedWidth: 30 proportionalHeight: 1.0). + pane addMorph: row3 layoutSpec: (LayoutSpec fixedHeight: 60). + pane openInWorld: UISupervisor ui; morphExtent: 408@300. + Processor activeProcess animatedUI + ifNotNil: [ :ui | ui doOneCycleNow] + ifNil: [ | updated | + updated _ false. + UISupervisor whenUIinSafeState: [ updated _ true ]. + [updated] whileFalse: [ + Processor yield ]]. + + self assert: row1 morphWidth = (pane morphWidth - 10). + self assert: r1c1 morphWidth = 10. + self assert: r1c2 morphWidth rounded = 200. + self assert: r1c3 morphWidth rounded = (r1c2 morphWidth / 0.8 * 0.4) rounded. + self assert: r1c4 morphWidth rounded = (r1c2 morphWidth / 0.8 * 0.15) rounded. + self assert: r1c5 morphWidth = 20. + self assert: r1c1 morphHeight = (row1 morphHeight - 10). + self assert: r1c2 morphHeight = (row1 morphHeight - 10). + self assert: r1c3 morphHeight = (row1 morphHeight - 10). + self assert: r1c4 morphHeight = (row1 morphHeight - 10). + self assert: r1c5 morphHeight = 20. + + self assert: row2 morphWidth = (pane morphWidth - 10). + self assert: r2c1 morphWidth rounded = 216. + self assert: r2c2 morphWidth rounded = 108. + self assert: r2c3 morphWidth rounded = 54. + self assert: r2c1 morphHeight = (row2 morphHeight - 10). + self assert: r2c2 morphHeight = (row2 morphHeight - 10). + self assert: r2c3 morphHeight = (row2 morphHeight - 10). + + self assert: row3 morphWidth = (pane morphWidth - 10). + self assert: r3c1 morphWidth = 20. + self assert: r3c2 morphWidth = (row3 morphWidth - 10 - 20 - 10 - 30 * 0.5) rounded. + self assert: r3c3 morphWidth = 30. + self assert: row3 morphHeight = 60. + self assert: r3c1 morphHeight = 40. + self assert: r3c2 morphHeight = 40. + self assert: r3c3 morphHeight = 50. + + pane delete! ! + +!LayoutMorphTest methodsFor: 'tests' stamp: 'jmv 5/23/2022 11:29:45'! +testLayout2 + " + self new testLayout2 + " + | pane row c1 c2 c3 | + pane _ LayoutMorph newColumn separation: 5. + pane color: Color red. + row _ LayoutMorph newRow separation: 5. + row + color: (Color h: 270 s: 0.2 v: 0.6); + addMorph: (c1 _ BoxedMorph new color: (Color h: 120 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec fixedWidth: 20 proportionalHeight: 0.8 offAxisEdgeWeight: #rowBottom); + addMorph: (c2 _ BoxedMorph new color: (Color h: 90 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec proportionalWidth: 0.8 fixedHeight: 40 offAxisEdgeWeight: #rowTop); + addMorph: (c3 _ BoxedMorph new color: (Color h: 150 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec fixedWidth: 30 proportionalHeight: 0.7 offAxisEdgeWeight: #center). + pane addMorph: row layoutSpec: (LayoutSpec proportionalHeight: 0.9). + pane openInWorld: UISupervisor ui; morphExtent: 400@300. + Processor activeProcess animatedUI + ifNotNil: [ :ui | ui doOneCycleNow] + ifNil: [ | updated | + updated _ false. + UISupervisor whenUIinSafeState: [ updated _ true ]. + [updated] whileFalse: [ + Processor yield ]]. + + self assert: row morphWidth = (pane morphWidth - 10). + self assert: row morphHeight = 261. + self assert: c1 displayBounds bottom = (row displayBounds bottom - 5) description: 'Should be at bottom'. + self assert: c1 morphWidth = 20. + self assert: c1 morphHeight = 200.8. + self assert: c2 displayBounds top = (row displayBounds top + 5) description: 'Should be at top'. + self assert: c2 morphWidth = 256. + self assert: c2 morphHeight = 40. + self assert: ((c3 displayBounds top - row displayBounds top) - (row displayBounds bottom - c3 displayBounds bottom)) abs < 2 description: 'Should be centered'. + self assert: c3 morphWidth = 30. + self assert: c3 morphHeight rounded = 176. + + pane delete! ! + +!LayoutMorphTest methodsFor: 'tests' stamp: 'jmv 5/23/2022 11:29:28'! +testLayout3 + " + self new testLayout3 + " + | pane row innerRow i1 i2 i3 c2 c3 | + pane _ LayoutMorph newColumn separation: 5. + pane color: Color red. + row _ LayoutMorph newRow separation: 5. + innerRow _ LayoutMorph newRow color: Color red; separation: 5. + innerRow + addMorph: (i1 _ BoxedMorph new) + layoutSpec: (LayoutSpec fixedWidth: 10 fixedHeight: 10); + addMorph: (i2 _ BoxedMorph new) + layoutSpec: (LayoutSpec fixedWidth: 10 fixedHeight: 10); + addMorph: (i3 _ BoxedMorph new) + layoutSpec: (LayoutSpec proportionalWidth: 1.0 fixedHeight: 10). + row + color: (Color h: 270 s: 0.2 v: 0.6); + addMorph: innerRow + layoutSpec: (LayoutSpec proportionalWidth: 0.5 fixedHeight: 30 offAxisEdgeWeight: #center); + addMorph: (c2 _ BoxedMorph new color: (Color h: 90 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec proportionalWidth: 0.5 fixedHeight: 40 offAxisEdgeWeight: #rowTop); + addMorph: (c3 _ BoxedMorph new color: (Color h: 150 s: 0.6 v: 0.6)) + layoutSpec: (LayoutSpec fixedWidth: 30 proportionalHeight: 1.0). + pane addMorph: row layoutSpec: (LayoutSpec fixedHeight: 200). + pane openInWorld: UISupervisor ui; morphExtent: 400@300. + Processor activeProcess animatedUI + ifNotNil: [ :ui | ui doOneCycleNow] + ifNil: [ | updated | + updated _ false. + UISupervisor whenUIinSafeState: [ updated _ true ]. + [updated] whileFalse: [ + Processor yield ]]. + + self assert: row displayBounds left = (pane displayBounds left + 5). + self assert: row morphWidth = (pane morphWidth - 10). + self assert: row morphHeight = 200. + self assert: innerRow displayBounds left = (row displayBounds left + 5). + self assert: (innerRow displayBounds top - row displayBounds top) = (row displayBounds bottom - innerRow displayBounds bottom) description: 'Should be centered'. + self assert: innerRow morphWidth = 170. + self assert: innerRow morphHeight = 30. + + self assert: i1 displayBounds left = (innerRow displayBounds left + 5). + self assert: (i1 displayBounds top - innerRow displayBounds top) = (innerRow displayBounds bottom - i1 displayBounds bottom) description: 'Should be centered'. + self assert: i1 morphWidth = 10. + self assert: i1 morphHeight = 10. + self assert: i2 displayBounds left = (innerRow displayBounds left + 20). + self assert: (i2 displayBounds top - innerRow displayBounds top) = (innerRow displayBounds bottom - i2 displayBounds bottom) description: 'Should be centered'. + self assert: i2 morphWidth = 10. + self assert: i2 morphHeight = 10. + self assert: i3 displayBounds left = (innerRow displayBounds left + 35). + self assert: (i3 displayBounds top - innerRow displayBounds top) = (innerRow displayBounds bottom - i3 displayBounds bottom) description: 'Should be centered'. + self assert: i3 morphWidth = (innerRow morphWidth - 40). + self assert: i3 morphHeight = 10. + + self assert: c2 displayBounds top = (row displayBounds top + 5) description: 'Should be at top'. + self assert: c2 morphWidth = 170. + self assert: c2 morphHeight = 40. + self assert: (c3 displayBounds top - row displayBounds top) = (row displayBounds bottom - c3 displayBounds bottom) description: 'Should be centered'. + self assert: c3 morphWidth = 30. + self assert: c3 morphHeight = (row morphHeight - 10). + + pane delete! ! + +!MorphicLocationTest methodsFor: 'testing' stamp: 'jmv 1/14/2015 14:32'! +testComposition + " + MorphicLocationTest new testComposition + " + | composition inner outer | + + outer _ MorphicTranslation withTranslation: 3@5. + inner _ AffineTransformation withRadians: 0.3. + composition _ outer composedWith: inner. + self assert: composition translation = outer translation. + self assert: (outer externalizePosition: (inner externalizePosition: 3@4)) = (composition externalizePosition: 3@4). + self assert: (outer externalizeDelta: (inner externalizeDelta: 3@4)) = (composition externalizeDelta: 3@4). + self assert: (outer externalizeScalar: (inner externalizeScalar: 7)) = (composition externalizeScalar: 7). + self assert: (inner internalizePosition: (outer internalizePosition: 3@4)) = (composition internalizePosition: 3@4). + self assert: (inner internalizeDelta: (outer internalizeDelta: 3@4)) = (composition internalizeDelta: 3@4). + self assert: (inner internalizeScalar: (outer internalizeScalar: 7)) = (composition internalizeScalar: 7). + + + outer _ AffineTransformation withRadians: 0.3. + inner _ MorphicTranslation withTranslation: 3@5. + composition _ outer composedWith: inner. + self assert: composition radians = outer radians. + self assert: ((outer externalizePosition: (inner externalizePosition: 3@4)) - (composition externalizePosition: 3@4)) r < 0.0001. + self assert: (outer externalizeDelta: (inner externalizeDelta: 3@4)) = (composition externalizeDelta: 3@4). + self assert: (outer externalizeScalar: (inner externalizeScalar: 7)) = (composition externalizeScalar: 7). + self assert: ((inner internalizePosition: (outer internalizePosition: 3@4)) - (composition internalizePosition: 3@4)) r < 0.0001. + self assert: (inner internalizeDelta: (outer internalizeDelta: 3@4)) = (composition internalizeDelta: 3@4). + self assert: (inner internalizeScalar: (outer internalizeScalar: 7)) = (composition internalizeScalar: 7).! ! + +!MorphicTranslationTest methodsFor: 'testing' stamp: 'jmv 1/12/2015 15:46'! +testComposition + " + MorphicTranslationTest new testComposition + " + | composition inner outer | + + outer _ MorphicTranslation withTranslation: 3@5. + inner _ MorphicTranslation withTranslation: -1@2. + composition _ outer composedWith: inner. + self assert: composition translation = (outer translation + inner translation). + self assert: (outer externalizePosition: (inner externalizePosition: 3@4)) = (composition externalizePosition: 3@4). + self assert: (outer externalizeDelta: (inner externalizeDelta: 3@4)) = (composition externalizeDelta: 3@4). + self assert: (outer externalizeScalar: (inner externalizeScalar: 7)) = (composition externalizeScalar: 7). + self assert: (inner internalizePosition: (outer internalizePosition: 3@4)) = (composition internalizePosition: 3@4). + self assert: (inner internalizeDelta: (outer internalizeDelta: 3@4)) = (composition internalizeDelta: 3@4). + self assert: (inner internalizeScalar: (outer internalizeScalar: 7)) = (composition internalizeScalar: 7). + + + outer _ MorphicTranslation withTranslation: -1@2. + inner _ MorphicTranslation withTranslation: 3@5. + composition _ outer composedWith: inner. + self assert: composition radians = outer radians. + self assert: (outer externalizePosition: (inner externalizePosition: 3@4)) = (composition externalizePosition: 3@4). + self assert: (outer externalizeDelta: (inner externalizeDelta: 3@4)) = (composition externalizeDelta: 3@4). + self assert: (outer externalizeScalar: (inner externalizeScalar: 7)) = (composition externalizeScalar: 7). + self assert: (inner internalizePosition: (outer internalizePosition: 3@4)) = (composition internalizePosition: 3@4). + self assert: (inner internalizeDelta: (outer internalizeDelta: 3@4)) = (composition internalizeDelta: 3@4). + self assert: (inner internalizeScalar: (outer internalizeScalar: 7)) = (composition internalizeScalar: 7).! ! + +!MorphicTranslationTest methodsFor: 'testing' stamp: 'len 5/9/2022 17:57:28'! +testDisplayBounds + " + MorphicTranslationTest new testDisplayBounds + " + + self assert: (MorphicTranslation new externalBoundingRectOf: (-2@ 2 extent: 10@10)) + encompassingIntegerRectangle = (-2@2 corner: 8@12). + self assert: (MorphicTranslation new externalBoundingRectOf: (-12@ 12 extent: 10@10)) + encompassingIntegerRectangle = (-12@12 corner: -2@22). + self assert: ((MorphicTranslation withTranslation: 2) externalBoundingRectOf: (-4@ 2 extent: 10@10)) + encompassingIntegerRectangle = (-2@4 corner: 8@14). + self assert: ((MorphicTranslation withTranslation: -4) externalBoundingRectOf: (2@ 2 extent: 10@10)) + encompassingIntegerRectangle = (-2@ -2 corner: 8@8). + self assert: ((MorphicTranslation withTranslation: 2) externalBoundingRectOf: (-14@ 2 extent: 10@10)) + encompassingIntegerRectangle = (-12@4 corner: -2@14). + self assert: ((MorphicTranslation withTranslation: 4) externalBoundingRectOf: (-12@ 2 extent: 10@10)) + encompassingIntegerRectangle = (-8@6 corner: 2@16). + self assert: ((MorphicTranslation withTranslation: -4) externalBoundingRectOf: (12@ 2 extent: 10@10)) + encompassingIntegerRectangle = (8@ -2 corner: 18@8). + self assert: ((MorphicTranslation withTranslation: -2) externalBoundingRectOf: (4@ 2 extent: 10@10)) + encompassingIntegerRectangle = (2@0 corner: 12@10). + self assert: ((MorphicTranslation withTranslation: 4) externalBoundingRectOf: (-2@ 2 extent: 10@10)) + encompassingIntegerRectangle = (2@6 corner: 12@16).! ! + +!MorphicTranslationTest methodsFor: 'testing' stamp: 'len 5/9/2022 17:57:12'! +testInverseTransform + " + MorphicTranslationTest new testInverseTransform + " + self assert: (MorphicTranslation new inverseTransform: (-2@ 2)) = (-2@2). + self assert: ((MorphicTranslation withTranslation: 2) inverseTransform: (-4@ 2)) = (-6@0). + self assert: ((MorphicTranslation withTranslation: 4) inverseTransform: (-2@ 2)) = (-6@ -2). + self assert: ((MorphicTranslation withTranslation: -2) inverseTransform: (4@ 2)) = (6@4). + self assert: ((MorphicTranslation withTranslation: -4) inverseTransform: (2@ 2)) = (6@6)! ! + +!MorphicTranslationTest methodsFor: 'testing' stamp: 'jmv 1/12/2015 15:46'! +testInverseTransformation + " + MorphicTranslationTest new testInverseTransformation + " + | forward inverse | + + forward _ MorphicTranslation withTranslation: 3@5. + inverse _ forward inverseTransformation. + + self assert: inverse translation = forward translation negated. + self assert: (inverse externalizePosition: 3@4) = (forward internalizePosition: 3@4). + self assert: (inverse externalizeDelta: 3@4) = (forward internalizeDelta: 3@4). + self assert: (inverse externalizeScalar: 7) = (forward internalizeScalar: 7). + self assert: (inverse internalizePosition: 3@4) = (forward externalizePosition: 3@4). + self assert: (inverse internalizeDelta: 3@4) = (forward externalizeDelta: 3@4). + self assert: (inverse internalizeScalar: 7) = (forward externalizeScalar: 7)! ! + +!MorphicTranslationTest methodsFor: 'testing' stamp: 'len 5/9/2022 17:57:17'! +testTransform + " + MorphicTranslationTest new testTransform + " + self assert: (MorphicTranslation new transform: (-2@ 2)) = (-2@2). + self assert: ((MorphicTranslation withTranslation: 2) transform: (-4@ 2)) = (-2@4). + self assert: ((MorphicTranslation withTranslation: 4) transform: (-2@ 2)) = (2@6). + self assert: ((MorphicTranslation withTranslation: -2) transform: (4@ 2)) = (2@0). + self assert: ((MorphicTranslation withTranslation: -4) transform: (2@ 2)) = (-2@ -2)! ! + +!WorldTest methodsFor: 'tests' stamp: 'jmv 10/24/2020 15:58:12'! +testDoOneCycleWorksWithDeferredQueue + "Ensure that nested doOneCycles don't break deferred UI messages" + | finished | + [ + UISupervisor whenUIinSafeState:[ UISupervisor ui doOneCycleNow ]. + UISupervisor whenUIinSafeState: nil "whatever". + UISupervisor ui doOneCycleNow. + finished _ true. + ] valueWithin: 1 seconds onTimeout: [finished _ false ]. + self assert: finished! ! + +!MethodReferenceTest methodsFor: 'test actual class' stamp: 'HAW 10/23/2019 21:08:24'! +testActualClassIfAbsentEvaluatesBlockIfClassDoesNotExist + + self + assert: 1 + equals: ((MethodReference + classSymbol: #X_Y_Z + classIsMeta: false + methodSymbol: #xx) actualClassIfAbsent: [ 1])! ! + +!MethodReferenceTest methodsFor: 'test actual class' stamp: 'HAW 10/23/2019 21:09:29'! +testActualClassIfAbsentReturnsClassIfClassExists + + self + assert: self class + equals: ((MethodReference + class: self class + selector: thisContext selector) actualClassIfAbsent: [ self fail])! ! + +!MethodReferenceTest methodsFor: 'test actual class' stamp: 'HAW 10/23/2019 21:05:22'! +testActualClassReturnNilWhenClassDoesNotExist + + self assert: (MethodReference classSymbol: #X_Y_Z classIsMeta: false methodSymbol: #xx) actualClass isNil! ! + +!MethodReferenceTest methodsFor: 'test actual class' stamp: 'HAW 10/23/2019 21:09:58'! +testActualClassReturnsClassIfExists + + self + assert: self class + equals: (MethodReference + class: self class + selector: thisContext selector) actualClass ! ! + +!MethodReferenceTest methodsFor: 'test source code' stamp: 'HAW 10/23/2019 21:42:10'! +testSourceCodeIfAbsentEvaluatesBlockIfClassDoesNotExist + + self + assert: 1 + equals: ((MethodReference classSymbol: #X_Y_Z classIsMeta: false methodSymbol:#xx) sourceCodeIfAbsent: [ 1 ])! ! + +!MethodReferenceTest methodsFor: 'test source code' stamp: 'HAW 10/23/2019 21:42:34'! +testSourceCodeIfAbsentEvaluatesBlockIfMethodDoesNotExist + + self + assert: 1 + equals: ((MethodReference class: self class selector:#xx) sourceCodeIfAbsent: [ 1 ])! ! + +!MethodReferenceTest methodsFor: 'test source code' stamp: 'HAW 10/23/2019 21:43:23'! +testSourceCodeIfAbsentReturnsSourceCodeIfExists + + self + assert: (self class>>thisContext selector) sourceCode + equals: ((MethodReference class: self class selector: thisContext selector) sourceCodeIfAbsent: [ self fail ])! ! + +!MethodReferenceTest methodsFor: 'test source code' stamp: 'HAW 10/23/2019 21:11:15'! +testSourceCodeReturnsSourceCodeIfMethodExist + + self + assert: (self class compiledMethodAt: thisContext selector) sourceCode + equals: (MethodReference + class: self class + selector: thisContext selector) sourceCode ! ! + +!MethodReferenceTest methodsFor: 'test source code' stamp: 'HAW 10/23/2019 21:39:16'! +testSourceCodeSignalExceptionIfClassDoesNotExist + + self + should: [ (MethodReference classSymbol: #X_Y_Z classIsMeta: false methodSymbol:#xx) sourceCode ] + raise: Error + withMessageText: MethodReference classDoesNotExistErrorMessage ! ! + +!MethodReferenceTest methodsFor: 'test source code' stamp: 'HAW 10/23/2019 21:13:28'! +testSourceCodeSignalExceptionIfMethodDoesNotExist + + self + should: [ (MethodReference class: self class selector: #xx) sourceCode ] + raise: Error + withMessageText: Dictionary keyNotFoundErrorDescription ! ! + +!MethodReferenceTest methodsFor: 'test compiled method' stamp: 'HAW 1/1/2020 19:46:58'! +testCompiledMethodIfAbsentEvaluatesAbsentBlockWhenActualClassIsNil + + self + assert: 1 + equals: ((MethodReference + classSymbol: #X_Y_Z + classIsMeta: false + methodSymbol: #xx) compiledMethodIfAbsent: [ 1])! ! + +!MethodReferenceTest methodsFor: 'test compiled method' stamp: 'HAW 1/1/2020 19:47:05'! +testCompiledMethodIfAbsentEvaluatesAbsentBlockWhenSelectorIsNotImplemented + + self + assert: 1 + equals: ((MethodReference + classSymbol: self class name + classIsMeta: false + methodSymbol: #xx) compiledMethodIfAbsent: [ 1])! ! + +!MethodReferenceTest methodsFor: 'test compiled method' stamp: 'HAW 1/1/2020 19:47:13'! +testCompiledMethodIfAbsentReturnsImplementedMethodWhenItExists + + self + assert: thisContext method + equals: ((MethodReference + classSymbol: self class name + classIsMeta: false + methodSymbol: thisContext selector) compiledMethodIfAbsent: [ self fail ])! ! + +!MethodReferenceTest methodsFor: 'test string version' stamp: 'HAW 4/9/2020 15:51:56'! +test01DefaultStringVersionIsClassAndSelector + + | stringVersion | + + stringVersion := (MethodReference method: thisContext method) stringVersion. + + self assert: self class name, ' ', thisContext selector equals: stringVersion! ! + +!MethodReferenceTest methodsFor: 'test string version' stamp: 'HAW 8/19/2021 15:05:13'! +test02CanPrefixStringVersion + + | methodReference prefix | + + prefix := 'a prefix'. + methodReference := MethodReference method: thisContext method. + methodReference prefixStringVersionWith: prefix. + + self assert: '[',prefix,'] - ',self class name, ' ', thisContext selector equals: methodReference stringVersion! ! + +!MethodReferenceTest methodsFor: 'test testing' stamp: 'HAW 1/2/2020 06:49:00'! +testReferencesParameterAtReturnsFalseWhenInvalid + + self deny: ((MethodReference + classSymbol: #X_Y_Z + classIsMeta: false + methodSymbol: #xx) referencesParameterAt: 1)! ! + +!MethodReferenceTest methodsFor: 'test testing' stamp: 'HAW 1/2/2020 06:49:03'! +testReferencesParameterAtReturnsTrueWhenTheParameterIsReferenced + + self assert: ((MethodReference + classSymbol: #MethodReference + classIsMeta: false + methodSymbol: #referencesParameterAt:) referencesParameterAt: 1)! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 12:16:37'! +test00MessagesForTestingAreImplemented + + self assert: (self respondsTo: #_zz). + self assert: (self respondsTo: #!!). + ! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:56:57'! +test01TypeOfMessageSentToLiteralNumberAreObtainedCorrectly + + self assertTypesAreValidWhenMessageSendTo: '1'! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:58:55'! +test02TypeOfMessageSentToLiteralStringAreObtainedCorrectly + + self assertTypesAreValidWhenMessageSendTo: '''a'''! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:58:39'! +test03TypeOfMessageSentToLiteralSymbolAreObtainedCorrectly + + self assertTypesAreValidWhenMessageSendTo: '#a'! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:59:12'! +test04TypeOfMessageSentToLiteralArrayAreObtainedCorrectly + + self assertTypesAreValidWhenMessageSendTo: '#(1)'! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:59:23'! +test05TypeOfMessageSentToLiteralBraceArrayAreObtainedCorrectly + + self assertTypesAreValidWhenMessageSendTo: '{1}'! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:59:33'! +test06TypeOfMessageSentToLiteralBlockAreObtainedCorrectly + + self assertTypesAreValidWhenMessageSendTo: '[1]'! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:59:42'! +test07TypeOfMessageSentToLiteralCharacterAreObtainedCorrectly + + self assertTypesAreValidWhenMessageSendTo: '$a'! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:59:51'! +test08TypeOfMessageSentToLiteralNilAreObtainedCorrectly + + self assertTypesAreValidWhenMessageSendTo: 'nil'! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:59:59'! +test09TypeOfMessageSentToLiteralTrueAreObtainedCorrectly + + self assertTypesAreValidWhenMessageSendTo: 'true'! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 12:00:08'! +test10TypeOfMessageSentToLiteralFalseAreObtainedCorrectly + + self assertTypesAreValidWhenMessageSendTo: 'false'! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 7/15/2021 10:47:18'! +test11TypeOfMessageSentToSelfAreObtainedCorrectly + + self + assertTypeOfMessageSend: 'm1 self _zz' + is: #undefinedUnary + in: Object + receiverRange: [ :ranges | ranges penultimate ] + messageRange: [ :ranges | ranges last ]. + self + assertTypeOfMessageSend: 'm1 self size' + is: #unary + in: Object + receiverRange: [ :ranges | ranges penultimate ] + messageRange: [ :ranges | ranges last ]. + + "Binary messages have been disabled - Hernan + self + assertTypeOfMessageSend: 'm1 self !! 2' + is: #undefinedBinary + in: Object + receiverRange: [ :ranges | ranges antepenultimate ] + messageRange: [ :ranges | ranges penultimate ]." + + self + assertTypeOfMessageSend: 'm1 self = 2' + is: #binary + in: Object + receiverRange: [ :ranges | ranges antepenultimate ] + messageRange: [ :ranges | ranges penultimate ].! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 12:00:26'! +test12TypeOfMessageSentToSuperAreObtainedCorrectly + + self assertTypesAreValidWhenMessageSendTo: 'super'! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 7/15/2021 10:47:00'! +test13TypesIsUndefinedForAnyMessageSendToSuperFromProtoObject + + self + assertTypeOfMessageSend: 'm1 super size' + is: #undefinedUnary + in: ProtoObject + receiverRange: [ :ranges | ranges penultimate ] + messageRange: [ :ranges | ranges last ]. + + "binaryMessages have been disabled - Hernan + self + assertTypeOfMessageSend: 'm1 super = 2' + is: #undefinedBinary + in: ProtoObject + receiverRange: [ :ranges | ranges antepenultimate ] + messageRange: [ :ranges | ranges penultimate ]."! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 12:00:37'! +test14TypeOfMessageSentToGlobalVarAreObtainedCorrectly + + self assertTypesAreValidWhenMessageSendTo: 'Smalltalk'! ! + +!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 12:24:04'! +test15TypeOfMessageSentToClassVarAreObtainedCorrectly + + ClassVar1 := 1. + self assertTypesAreValidWhenMessageSendTo: 'ClassVar1'! ! + +!SHST80RangeTypeTest methodsFor: 'assertions' stamp: 'HAW 10/5/2020 12:02:43'! +assertTypeOfBinaryMessageSend: aSourceCode is: aExpectedType + + self + assertTypeOfMessageSend: aSourceCode + is: aExpectedType + receiverRange: [ :ranges | ranges antepenultimate ] + messageRange: [ :ranges | ranges penultimate ] +! ! + +!SHST80RangeTypeTest methodsFor: 'assertions' stamp: 'jmv 4/26/2021 19:40:38'! +assertTypeOfMessageSend: aSourceCode + is: aExpectedType + in: aClassOrMetaClass + receiverRange: aReceiverRangeBlock + messageRange: aMessageRangeBlock + + | parser ranges st80RangeType type | + + parser := SHParserST80 new. + ranges := parser + workspace: nil; + classOrMetaClass: aClassOrMetaClass ; + source: aSourceCode; + parse; + ranges. + + st80RangeType := SHST80RangeType for: aSourceCode in: aClassOrMetaClass. + st80RangeType lastRange: (aReceiverRangeBlock value: ranges). + type := st80RangeType ofCurrentRangeOrMessageSendIn: (aMessageRangeBlock value: ranges). + + self assert: aExpectedType equals: type + ! ! + +!SHST80RangeTypeTest methodsFor: 'assertions' stamp: 'HAW 10/5/2020 12:23:51'! +assertTypeOfMessageSend: aSourceCode + is: aExpectedType + receiverRange: aReceiverRangeBlock + messageRange: aMessageRangeBlock + + self + assertTypeOfMessageSend: aSourceCode + is: aExpectedType + in: self class + receiverRange: aReceiverRangeBlock + messageRange: aMessageRangeBlock! ! + +!SHST80RangeTypeTest methodsFor: 'assertions' stamp: 'HAW 10/5/2020 12:02:52'! +assertTypeOfUnaryMessageSend: aSourceCode is: aExpectedType + + self + assertTypeOfMessageSend: aSourceCode + is: aExpectedType + receiverRange: [ :ranges | ranges penultimate ] + messageRange: [ :ranges | ranges last ] +! ! + +!SHST80RangeTypeTest methodsFor: 'assertions' stamp: 'HAW 7/15/2021 10:45:30'! +assertTypesAreValidWhenMessageSendTo: aReceiverAsString + + self assertTypeOfUnaryMessageSend: 'm1 ', aReceiverAsString, ' _zz' is: #undefinedUnary. + self assertTypeOfUnaryMessageSend: 'm1 ', aReceiverAsString, ' size' is: #unary. + + " binary messages has beed disabled by now - Hernan + self assertTypeOfBinaryMessageSend: 'm1 ', aReceiverAsString, ' !! 2' is: #undefinedBinary. + self assertTypeOfBinaryMessageSend: 'm1 ', aReceiverAsString, ' = 2' is: #binary + "! ! + +!SHST80RangeTypeTest methodsFor: 'messages for testing' stamp: 'HAW 10/5/2020 12:15:40'! +!! something + + "Do not remove this method because it exists for its name to have implementors - Hernan"! ! + +!SHST80RangeTypeTest methodsFor: 'messages for testing' stamp: 'HAW 10/5/2020 12:15:50'! +_zz + + "Do not remove this method because it exists for its name to have implementors - Hernan"! ! + +!DebuggerTest methodsFor: 'tests - method categories' stamp: 'HAW 8/19/2021 15:31:36'! +testCategoriesAreAddedSortedByAndSeparatedByClass + + | objectCategories protoObjectCategories categoriesPrompter | + + objectCategories := Object methodCategoriesAsSortedCollection. + protoObjectCategories := ProtoObject methodCategoriesAsSortedCollection removeAllFoundIn: objectCategories; yourself. + + "Test pre-conditions. May seem unnecesary but they are not if we take time into account - Hernan" + self assert: ProtoObject equals: Object superclass. + self assert: nil equals: ProtoObject superclass. + self assert: objectCategories notEmpty. + self assert: protoObjectCategories notEmpty. + + categoriesPrompter := MethodCategoriesPrompter staringFrom: Object rejectingFirst: false. + + self assert: 2 equals: categoriesPrompter lines size. + self assert: 1 equals: categoriesPrompter lines first. + self assert: (categoriesPrompter categories copyFrom: 2 to: categoriesPrompter lines second) asArray equals: objectCategories asArray. + self assert: (categoriesPrompter categories copyFrom: categoriesPrompter lines second + 1 to: categoriesPrompter categories size) asArray equals: protoObjectCategories asArray. + ! ! + +!DebuggerTest methodsFor: 'tests - method categories' stamp: 'HAW 8/19/2021 15:33:48'! +testMetaclassCategoriesIncludesInstanceCreation + + | categoriesPrompter | + + categoriesPrompter := MethodCategoriesPrompter staringFrom: ProtoObject class rejectingFirst: false. + + self assert: Categorizer instanceCreation equals: categoriesPrompter categories second ! ! + +!SmalltalkCompleterTest methodsFor: 'testing' stamp: 'jmv 7/14/2011 14:26'! +testMessages + " + SmalltalkCompleterTest new testMessages + " + | fromSmalltalk fromUCompleter | + fromSmalltalk _ Smalltalk allImplementedMessages. + fromUCompleter _ Symbol allInstances select: [ :s | + SmalltalkCompleter isThereAnImplementorOf: s]. + self assert: fromSmalltalk = fromUCompleter asSet! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 20:56:42'! +test000_AutocompletesMessagesFor_GlobalVariables_WithSelectorsFromTheirClasses + + self + assertEntriesWhenBrowsing: 'm1 SmalltalkCompleterTest ' + areSelectorsOf: SmalltalkCompleterTest class. + + self + assertEntriesWhenBrowsing: 'm1 1 < SmalltalkCompleterTest ' + areUnaryAndBinarySelectorsOf: SmalltalkCompleterTest class. + ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:01:49'! +test001_AutocompletesMessagesFor_Self_WithSelectorsFromTheBrowsedClass + + self + assertEntriesWhenBrowsing: 'm1 self ' + areSelectorsOf: SmalltalkCompleterTest. + + self + assertEntriesWhenBrowsing: 'm1 1 < self ' + areUnaryAndBinarySelectorsOf: SmalltalkCompleterTest.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:02:19'! +test002_AutocompletesMessagesFor_Super_WithSelectorsFromTheBrowsedClass + + self + assertEntriesWhenBrowsing: 'm1 super ' + areSelectorsOf: TestCase. + + self + assertEntriesWhenBrowsing: 'm1 1 < super ' + areUnaryAndBinarySelectorsOf: TestCase.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:02:43'! +test003_AutocompletesMessagesFor_Super_WithSelectorsForUnknownClassesWhenTheBrowsedClassDoesNotHaveASuperclass + + self browseClass: ProtoObject. + + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 super '. + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 1 < super '.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:11:29'! +test004_AutocompletesMessagesFor_True_WithSelectorsFromTrue + + self + assertEntriesWhenBrowsing: 'm1 true ' + areSelectorsOf: True. + + self + assertEntriesWhenBrowsing: 'm1 1 < true ' + areUnaryAndBinarySelectorsOf: True. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:12:17'! +test005_AutocompletesMessagesFor_False_WithSelectorsFromFalse + + self + assertEntriesWhenBrowsing: 'm1 false ' + areSelectorsOf: False. + + self + assertEntriesWhenBrowsing: 'm1 1 < false ' + areUnaryAndBinarySelectorsOf: False. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:12:12'! +test006_AutocompletesMessagesFor_Nil_WithSelectorsFromUndefinedObject + + self + assertEntriesWhenBrowsing: 'm1 nil ' + areSelectorsOf: UndefinedObject. + + self + assertEntriesWhenBrowsing: 'm1 1 < nil ' + areUnaryAndBinarySelectorsOf: UndefinedObject. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:36:47'! +test007_AutocompletesMessagesFor_Characters_WithSelectorsFromCharacter + + self + assertEntriesWhenBrowsing: 'm1 $a ' + areSelectorsOf: Character. + + self + assertEntriesWhenBrowsing: 'm1 1 < $a ' + areUnaryAndBinarySelectorsOf: Character. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:15:01'! +test008_AutocompletesMessagesFor_Numbers_WithSelectorsFromTheirClass + + self + assertEntriesWhenBrowsing: 'm1 1 ' + areSelectorsOf: SmallInteger. + + self + assertEntriesWhenBrowsing: 'm1 1 < 1 ' + areUnaryAndBinarySelectorsOf: SmallInteger. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:15:25'! +test009_AutocompletesMessagesFor_Strings_WithSelectorsFromString + + self + assertEntriesWhenBrowsing: 'm1 ''a'' ' + areSelectorsOf: String. + + self + assertEntriesWhenBrowsing: 'm1 1 < ''a'' ' + areUnaryAndBinarySelectorsOf: String. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:37:45'! +test010_AutocompletesMessagesFor_Symbols_WithSelectorsFromSymbol + + self + assertEntriesWhenBrowsing: 'm1 #a ' + areSelectorsOf: Symbol. + + self + assertEntriesWhenBrowsing: 'm1 1 < #a ' + areUnaryAndBinarySelectorsOf: Symbol. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:38:21'! +test011_AutocompletesMessagesFor_StringSymbol_WithSelectorsFromSymbol + + self + assertEntriesWhenBrowsing: 'm1 #''a'' ' + areSelectorsOf: Symbol. + + self + assertEntriesWhenBrowsing: 'm1 1 < #''a'' ' + areUnaryAndBinarySelectorsOf: Symbol. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:42:33'! +test012_AutocompletesMessagesFor_InstanceVariables + + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 instanceVariable1 '. + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 1 + instanceVariable1 '.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 16:42:09'! +test013_AutocompletesMessagesFor_MethodArguments_WithSelectorsForUnknownClasses + + "I reference to SmalltalkCompleterTest directly and not thru 'self class' becuase this test has subclasses + the #m1: and #m2: are defined in SmalltalkCompleterTest - Hernan" + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsingMethodWith: SmalltalkCompleterTest >> #m1:. + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsingMethodWith: SmalltalkCompleterTest >> #m2: ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:22:39'! +test014_AutocompletesMessagesFor_TemporaryVariables_WithSelectorsForUnknownClasses + + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 |a| a '. + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 |a| 1 + a '. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:25:42'! +test015_AutocompletesMessagesFor_BlockArguments_WithSelectorsForUnknownClasses + + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 [ :a | a '. + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 [ :a | 1 + a '. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 22:04:54'! +test016_AutocompletesMessagesFor_BlockTemporaryVariables_WithSelectorsForUnknownClasses + + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 [ | a | a '. + + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 [ | a | 1 + a '. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'NPM 3/18/2020 18:34:08'! +test017_AutocompletesMessagesFor_NilWorkspaceVariables_WithSelectorsForUnknownClasses + + self + assertEntriesAreSelectorsForUnknownClassesForWorkspaceWith: 'x ' + binding: 'x' + to: nil. + + self + assertEntriesAreSelectorsForUnknownClassesForWorkspaceWith: '1 + x ' + binding: 'x' + to: nil.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 22:05:36'! +test017_AutocompletesMessagesFor_NonNilWorkspaceVariables_WithSelectorsFromTheirClasses + + self + assertEntriesForWorkspaceWith: 'x ' + binding: 'x' + to: 1 + areSelectorsOf: SmallInteger. + + self + assertEntriesForWorkspaceWith: '1 < x ' + binding: 'x' + to: 1 + areUnaryAndBinarySelectorsOf: SmallInteger.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:27:14'! +test018_AutocompletesMessagesFor_ThisContext_WithSelectorsFromMethodContext + + self + assertEntriesWhenBrowsing: 'm1 thisContext ' + areSelectorsOf: MethodContext. + + self + assertEntriesWhenBrowsing: 'm1 1 < thisContext ' + areUnaryAndBinarySelectorsOf: MethodContext. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:27:39'! +test019_AutocompletesMessagesFor_ClassVariables_WithSelectorsFromTheirClasses + + ClassVariableForTesting _ 1. + + self + assertEntriesWhenBrowsing: 'm1 ClassVariableForTesting ' + areSelectorsOf: SmallInteger. + + self + assertEntriesWhenBrowsing: 'm1 1 < ClassVariableForTesting ' + areUnaryAndBinarySelectorsOf: SmallInteger. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:28:01'! +test020_AutocompletesMessagesFor_PoolConstants_WithSelectorsFromTheirClasses + + poolDictionaryForTesting at: #X put: 1. + + self + assertEntriesWhenBrowsing: 'm1 X ' + areSelectorsOf: SmallInteger. + + self + assertEntriesWhenBrowsing: 'm1 1 < X ' + areUnaryAndBinarySelectorsOf: SmallInteger.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:39:25'! +test021_AutocompletesMessagesFor_BlockEndings_WithSelectorsFromBlockClosure + + self + assertEntriesWhenBrowsing: 'm1 [] ' + areSelectorsOf: BlockClosure. + + self + assertEntriesWhenBrowsing: 'm1 1 < [] ' + areUnaryAndBinarySelectorsOf: BlockClosure. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 23:39:55'! +test022_AutocompletesMessagesFor_ArrayEnds_WithSelectorsFromArray + + self + assertEntriesWhenBrowsing: 'm1 #() ' + areSelectorsOf: Array. + + self + assertEntriesWhenBrowsing: 'm1 1 < #() ' + areUnaryAndBinarySelectorsOf: Array. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:04:04'! +test023_AutocompletesMessagesFor_RightBraces_WithSelectorsFromArray + + self + assertEntriesWhenBrowsing: 'm1 {} ' + areSelectorsOf: Array. + + self + assertEntriesWhenBrowsing: 'm1 1 < {} ' + areUnaryAndBinarySelectorsOf: Array. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:43:31'! +test023_AutocompletingMessagesFor_UnaryMessages + + self denyComputingEntriesIsSupportedWhenBrowsing: 'm1 self class '. + + self denyComputingEntriesIsSupportedWhenBrowsing: 'm1 1 < self class '. ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:44:50'! +test024_AutocompletingMessagesFor_RightParenthesis + + self denyComputingEntriesIsSupportedWhenBrowsing: 'm1 (1) '. + + self denyComputingEntriesIsSupportedWhenBrowsing: 'm1 1 < (1) '.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 02:08:24'! +test025_AutocompletesMessagesFor_UnknownIdentifiers_WithSelectorsForUnknownClasses + + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 Foo1234 '. + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 foo1234 '.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:45:10'! +test026_AutocompletingMessagesFor_Cascade + + self denyComputingEntriesIsSupportedWhenBrowsing: 'm1 self class; '. + ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:13:19'! +test027_AutocompletesEntriesFor_GlobalVariables_WithIdentifiersBegginingWithThem + + self + assertEntriesWhenBrowsing: 'm1 SmalltalkCompleterTes' + areIdentifiersBeginningWith: 'SmalltalkCompleterTest'. + ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:14:50'! +test028_AutocompletesEntriesFor_PoolConstants_WithIdentifiersBegginingWithThem + + poolDictionaryForTesting at: #X put: 1. + + self + assertEntriesWhenBrowsing: 'm1 X' + areIdentifiersBeginningWith: 'X'.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'NPM 3/18/2020 19:56:46'! +test029_AutocompletesEntriesFor_WorkspaceVariables_WithIdentifiersBegginingWithThem + + | completer | + completer := self + autocompleteEntriesForWorkspaceWith: 'x' + binding: 'x' + to: 1. + + self + assertEntriesOf: completer + areIdentifiersBeginningWith: 'x'.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:15:11'! +test030_AutocompletesEntriesFor_ClassVariables_WithIdentifiersBegginingWithThem + + ClassVariableForTesting _ 1. + + self + assertEntriesWhenBrowsing: 'm1 ClassVariableForTestin' + areIdentifiersBeginningWith: 'ClassVariableForTesting'.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:15:28'! +test031_AutocompletesEntriesFor_InstanceVariables_WithIdentifiersBegginingWithThem + + self + assertEntriesWhenBrowsing: 'm1 instanceVariable' + areIdentifiersBeginningWith: 'instanceVariable1'.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/2/2020 21:36:46'! +test032_AutocompletesEntriesFor_MethodArguments_WithIdentifiersBegginingWithThem + + | completer | + + completer := self autocompleteEntriesBrowsingMethod: SmalltalkCompleterTest >> #m3:. + + self + assert: completer + analizedSelectorsFrom: nil + canShowDocumentation: false + detectedPossibleInvalidSelector: #() + suggested: (completer computeIdentifierEntriesBeginningWith: 'arg1').! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:15:54'! +test033_AutocompletesEntriesFor_TemporaryVariables_WithIdentifiersBegginingWithThem + + self + assertEntriesWhenBrowsing: 'm1 |xx| x' + areIdentifiersBeginningWith: 'xx'.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:16:11'! +test034_AutocompletesEntriesFor_BlockArguments_WithIdentifiersBegginingWithThem + + self + assertEntriesWhenBrowsing: 'm1 [ :xx | x' + areIdentifiersBeginningWith: 'xx'.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:16:27'! +test035_AutocompletesEntriesFor_BlockTemporaryVariables_WithIdentifiersBegginingWithThem + + self + assertEntriesWhenBrowsing: 'm1 [ | xx | x' + areIdentifiersBeginningWith: 'xx'.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:16:43'! +test036_AutocompletesEntriesFor_IncompleteIdentifiers_WithIdentifiersBegginingWithThem + + self + assertEntriesWhenBrowsing: 'm1 Obj' + areIdentifiersBeginningWith: 'Obj'.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:17:34'! +test037_AutocompletesEntriesFor_ReservedNames_WithIdentifiersBegginingWithThem + + self assertEntriesWhenBrowsing: 'm1 self' areIdentifiersBeginningWith: 'self'. + self assertEntriesWhenBrowsing: 'm1 supe' areIdentifiersBeginningWith: 'super'. + self assertEntriesWhenBrowsing: 'm1 tru' areIdentifiersBeginningWith: 'true'. + self assertEntriesWhenBrowsing: 'm1 fals' areIdentifiersBeginningWith: 'false'. + self assertEntriesWhenBrowsing: 'm1 ni' areIdentifiersBeginningWith: 'nil'. + self assertEntriesWhenBrowsing: 'm1 thisContex' areIdentifiersBeginningWith: 'thisContext'.! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'NPM 3/18/2020 19:15:44'! +test038_DoesNotAutocompleteEntriesFor_UndefinedIdentifiers + + | completer | + completer := self createCompleterForBrowsing: 'a'. - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: 'm1: p1 m3: p3'. - classToRefactor compile: senderSelector asString, ' - self m1: 1 m3: 3. + completer computeEntries. + + self denyHasEntries: completer ! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:18:55'! +test039_AutocompletesEntriesFor_BinaryMessages_WithIdentifiersBegginingWithThem + self - m1: 4 - m3: 6'. + assertEntriesWhenBrowsing: 'm1 1 ~=' + areSelectorsOf: SmallInteger + beginningWith: '~='! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:19:17'! +test040_AutocompletesEntriesFor_IncompleteBinaryMessages_WithIdentifiersBegginingWithThem + + self + assertEntriesWhenBrowsing: 'm1 1 ~' + areSelectorsOf: SmallInteger + beginningWith: '~'! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:19:42'! +test041_AutocompletesEntriesFor_UnaryMessages_WithIdentifiersBegginingWithThem + + self + assertEntriesWhenBrowsing: 'm1 1 not' + areSelectorsOf: SmallInteger + beginningWith: 'not'! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:19:53'! +test042_AutocompletesEntriesFor_IncompleteUnaryMessages_WithIdentifiersBegginingWithThem + + self + assertEntriesWhenBrowsing: 'm1 1 no' + areSelectorsOf: SmallInteger + beginningWith: 'no'! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:20:03'! +test043_AutocompletesEntriesFor_KeywordMessages_WithIdentifiersBegginingWithThem + + self + assertEntriesWhenBrowsing: 'm1 1 at:' + areSelectorsOf: SmallInteger + beginningWith: 'at:'! ! + +!SmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/3/2020 01:18:26'! +test044_AutocompletesEntriesFor_IncompleteKeywordMessages_WithIdentifiersBegginingWithThem + + self + assertEntriesWhenBrowsing: 'm1 self firstKeyword:' + areSelectorsOf: SmalltalkCompleterTest + beginningWith: 'firstKeyword:'.! ! + +!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'HAW 1/27/2022 19:32:18'! +createCompleterForBrowsing: sourceCode - refactoring := AddParameter - named: newParameter at: 2 initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. + | browser model | + browser := Browser new. + browser setSelectedSystemCategoryTreeItem: (SystemCategoryWrapper with: classToBrowse category name: classToBrowse category model: browser). + browser classListIndex: (browser classList indexOf: classToBrowse name). - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: senderMethod sourceCode equals: senderSelector asString, ' - self m1: 1 m2: 2 m3: 3. - self - m1: 4 - m2: 2 m3: 6'. -! ! + model := (PluggableTextModel on: browser) actualContents: sourceCode. + browser editSelection: #newMethod. -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:44:50'! -test32IndexCanNotBeLessThanOne + ^ self createCompleterWith: model.! ! + +!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'NPM 3/18/2020 19:17:59'! +createCompleterForWorkspaceWith: sourceCode binding: aVariableName to: aValue - self - assertCreation: [ - AddParameter - named: 'newParam' - at: 0 - initializedWith: '1' - using: 'm2:' asSymbol - toKeywordSelector: 'm1:' asSymbol - implementors: {} - senders: {} ] - failsWith: [ AddParameter errorMessageForInvalidParameterIndex: 0 for: 1 ]! ! + | model | + model := Workspace withText: sourceCode. + (model bindingOf: aVariableName) value: aValue. + + ^ self createCompleterWith: model! ! -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:44:43'! -test33IndexCanNotBeBiggerThanNumberOfParametersPlusOne +!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'HAW 5/2/2020 13:14:11'! +createCompleterWith: aModel - self - assertCreation: [ - AddParameter - named: 'newParam' - at: 3 - initializedWith: '1' - using: 'm2:' asSymbol - toKeywordSelector: 'm1:' asSymbol - implementors: {} - senders: {} ] - failsWith: [ AddParameter errorMessageForInvalidParameterIndex: 3 for: 1 ]! ! + ^ (SmalltalkCompleter withModel: aModel) + changePositionTo: aModel actualContents size; + yourself! ! -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:44:36'! -test34IndexMustBeInteger +!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'HAW 5/2/2020 16:37:44'! +firstKeyword: a secondKeyword: b! ! + +!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'HAW 5/2/2020 16:55:18'! +m1: arg1 arg1 ! ! + +!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'HAW 5/2/2020 16:37:29'! +m2: arg1 1 + arg1 ! ! + +!SmalltalkCompleterTest methodsFor: 'test objects' stamp: 'HAW 5/2/2020 16:56:16'! +m3: arg1 arg1! ! + +!SmalltalkCompleterTest methodsFor: 'test support' stamp: 'NPM 3/18/2020 19:13:43'! +autocompleteEntriesBrowsing: sourceCode - self - assertCreation: [ - AddParameter - named: 'newParam' - at: 1.5 - initializedWith: '1' - using: 'm2:' asSymbol - toKeywordSelector: 'm1:' asSymbol - implementors: {} - senders: {} ] - failsWith: [ AddParameter errorMessageForInvalidParameterIndex: 1.5 for: 1 ]! ! + | completer | + completer := self createCompleterForBrowsing: sourceCode. + + completer computeEntries. + + ^ completer! ! -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:44:23'! -test35AddingParameterRetractsInsertionPointWhenAtInsertionPointIsANewLine +!SmalltalkCompleterTest methodsFor: 'test support' stamp: 'HAW 5/2/2020 21:51:30'! +autocompleteEntriesBrowsingMethod: aCompiledMethod + + | completer selector | + + selector := aCompiledMethod selector. + completer := self createCompleterForBrowsing: aCompiledMethod sourceCode. + "Not nice, but does it work - Hernan" + completer textProviderOrModel instVarNamed: 'currentCompiledMethod' put: aCompiledMethod. + completer textProviderOrModel selectedMessageName: selector. + + completer computeEntries. + + ^ completer! ! - | refactoring classToRefactor oldSelector newParameter newParameterValue senderSelector | +!SmalltalkCompleterTest methodsFor: 'test support' stamp: 'NPM 3/18/2020 19:07:19'! +autocompleteEntriesForWorkspaceWith: sourceCode binding: aVariableName to: aValue - oldSelector := 'm1' asSymbol. - newParameter := 'newParam'. - newParameterValue := '1'. - senderSelector := 'sender_m1' asSymbol. + | completer | + completer := self + createCompleterForWorkspaceWith: sourceCode + binding: aVariableName + to: aValue. + + completer computeEntries. - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, Character newLineCharacter asString, Character newLineCharacter asString. - classToRefactor compile: senderSelector asString, ' self ', oldSelector asString. + ^ completer! ! - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue toUnarySelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - self shouldnt: [ refactoring apply ] raise: Error. +!SmalltalkCompleterTest methodsFor: 'test support' stamp: 'NPM 3/18/2020 18:32:34'! +browseClass: aClass + + classToBrowse _ aClass.! ! + +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 20:21:58'! +assert: aCompleter analizedSelectorsFrom: classes canShowDocumentation: aBoolean detectedPossibleInvalidSelector: selectors suggested: entries + + classes + ifNil: [ self assert: aCompleter selectorsClasses isNil ] + ifNotNil: [ self assert: aCompleter selectorsClasses asSet = classes asSet ]. + self assert: aCompleter canShowSelectorDocumentation equals: aBoolean. + self assert: aCompleter possibleInvalidSelectors asSet = selectors asSet. + entries + ifNil: [ self assert: aCompleter entries isNil ] + ifNotNil: [ self assert: (self entriesToCompareFrom: aCompleter entries) = (self entriesToCompareFrom: entries) ] + + ! ! + +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 20:25:15'! +assertEntriesAreSelectorsForUnknownClasses: aCompleter + + | expectedEntries expectedPossibleInvalidSelectors | + expectedPossibleInvalidSelectors _ Set new. + expectedEntries _ aCompleter computeMessageEntriesForUnknowClassAddingPossibleInvalidSelectorsTo: expectedPossibleInvalidSelectors. + + self + assert: aCompleter + analizedSelectorsFrom: #() + canShowDocumentation: true + detectedPossibleInvalidSelector: expectedPossibleInvalidSelectors + suggested: expectedEntries! ! + +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 19:06:02'! +assertEntriesAreSelectorsForUnknownClassesForWorkspaceWith: sourceCode binding: aVariableName to: aValue + + | completer | + completer := self + autocompleteEntriesForWorkspaceWith: sourceCode + binding: aVariableName + to: aValue. + + self assertEntriesAreSelectorsForUnknownClasses: completer.! ! + +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 19:07:53'! +assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: sourceCode + + | completer | + completer := self autocompleteEntriesBrowsing: sourceCode. + + self assertEntriesAreSelectorsForUnknownClasses: completer.! ! + +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 21:36:46'! +assertEntriesAreSelectorsOfUnknownClassesWhenBrowsingMethodWith: aCompiledMethod + + | completer | + + completer := self autocompleteEntriesBrowsingMethod: aCompiledMethod. + + self assertEntriesAreSelectorsForUnknownClasses: completer. ! ! -!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:44:13'! -test36ParentesisAreAddedToSendersOfUnaryMessage - - self shouldFail: [ | refactoring classToRefactor oldSelector newParameter newParameterValue senderSelector | +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 19:08:09'! +assertEntriesForWorkspaceWith: sourceCode binding: aVariableName to: aValue areSelectorsOf: aClass - oldSelector := 'm1' asSymbol. - newParameter := 'newParam'. - newParameterValue := '1'. - senderSelector := 'sender_m1' asSymbol. + | completer | + completer := self + autocompleteEntriesForWorkspaceWith: sourceCode + binding: aVariableName + to: aValue. - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString. - classToRefactor compile: senderSelector asString, ' self ', oldSelector asString, ', self size'. + self + assertEntriesOf: completer + areAllSelectorsOf: aClass.! ! - refactoring := AddParameter - named: newParameter initializedWith: newParameterValue toUnarySelector: oldSelector - implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. - refactoring apply. +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 19:19:49'! +assertEntriesForWorkspaceWith: sourceCode binding: aVariableName to: aValue areUnaryAndBinarySelectorsOf: aClass - self assert: senderSelector asString, ' (self ', oldSelector asString, '), self size' equals: (classToRefactor>>senderSelector) sourceCode - ]! ! - -!AddParameterTest methodsFor: 'class factory' stamp: 'HAW 8/24/2018 17:20:56'! -classToRefactorName + | completer | + completer := self + autocompleteEntriesForWorkspaceWith: sourceCode + binding: aVariableName + to: aValue. - ^#ClassToAddParameter! ! - -!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:18:58'! -test01CannotChangeSelectorOrderInUnaryMessages - self - assertCreation: [ ChangeKeywordsSelectorOrder from: #m1 to: #m1 implementors: #() senders: #() ] - failsWith: [ ChangeKeywordsSelectorOrder selectorToChangeIsNotKeywordWithMoreThanOneParameterErrorMessage ]! ! + assertEntriesOf: completer + areUnaryAndBinarySelectorsOf: aClass.! ! -!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:18:58'! -test02CannotChangeSelectorOrderInBinaryMessages +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/17/2020 18:27:01'! +assertEntriesOf: aCompleter areAllSelectorsOf: aClass self - assertCreation: [ ChangeKeywordsSelectorOrder from: #+ to: #+ implementors: #() senders: #() ] - failsWith: [ ChangeKeywordsSelectorOrder selectorToChangeIsNotKeywordWithMoreThanOneParameterErrorMessage ]! ! + assertEntriesOf: aCompleter + areAllSelectorsOf: aClass + beginningWith: ''! ! -!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:18:58'! -test03CannotChangeSelectorOrderInKeywordMessagesWithOneParameterOnly +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 17:38:48'! +assertEntriesOf: aCompleter areAllSelectorsOf: aClass beginningWith: aPrefix - self - assertCreation: [ ChangeKeywordsSelectorOrder from: #m1: to: #m1: implementors: #() senders: #() ] - failsWith: [ ChangeKeywordsSelectorOrder selectorToChangeIsNotKeywordWithMoreThanOneParameterErrorMessage ]! ! + self assertEntriesOf: aCompleter areAllSelectorsOfAll: { aClass } beginningWith: aPrefix +! ! -!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 05:44:03'! -test04ChangesKeywordsOrder +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 18:42:55'! +assertEntriesOf: aCompleter areAllSelectorsOfAll: classes beginningWith: aPrefix - | classToRefactor refactoring oldSelector newSelector | + | suggested | - oldSelector := #m1:m2:. - newSelector := #m2:m1:. - classToRefactor := self createClassNamed: #ClassToChangeSelectorOrder. - classToRefactor compile: (self selectorAndParametersFor: oldSelector). + suggested := classes inject: Set new into: [ :suggestedCollector :aClass | + suggestedCollector + addAll: (aCompleter selectorsOf: aClass beginningWith: aPrefix); + yourself ]. + + self + assert: aCompleter + analizedSelectorsFrom: classes + canShowDocumentation: true + detectedPossibleInvalidSelector: #() + suggested: suggested.! ! - refactoring := ChangeKeywordsSelectorOrder from: oldSelector to: newSelector implementors: { classToRefactor >> oldSelector } senders: #(). - refactoring apply. +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 20:25:15'! +assertEntriesOf: aCompleter areIdentifiersBeginningWith: aPrefix - self assert: (classToRefactor includesSelector: newSelector). - self deny: (classToRefactor includesSelector: oldSelector)! ! + self + assert: aCompleter + analizedSelectorsFrom: nil + canShowDocumentation: false + detectedPossibleInvalidSelector: #() + suggested: (aCompleter computeIdentifierEntriesBeginningWith: aPrefix)! ! -!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 05:52:51'! -test05ChangesParametersOrder +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 20:10:35'! +assertEntriesOf: aCompleter areUnaryAndBinarySelectorsOf: aClass - | classToRefactor refactoring oldSelector newSelector renamedMethod parameters selectorAndParameters | + self + assert: aCompleter + analizedSelectorsFrom: {aClass} + canShowDocumentation: true + detectedPossibleInvalidSelector: #() + suggested: (self using: aCompleter addUnaryAndBinarySelectorsOf: aClass). + ! ! - oldSelector := #m1:m2:. - newSelector := #m2:m1:. - classToRefactor := self createClassNamed: #ClassToChangeSelectorOrder. - selectorAndParameters := self selectorAndParametersFor: oldSelector. - classToRefactor compile: selectorAndParameters. +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 19:58:16'! +assertEntriesWhenBrowsing: sourceCode areIdentifiersBeginningWith: aPrefix + + | completer | + completer := self autocompleteEntriesBrowsing: sourceCode. + + self + assertEntriesOf: completer + areIdentifiersBeginningWith: aPrefix.! ! - refactoring := ChangeKeywordsSelectorOrder from: oldSelector to: newSelector implementors: { classToRefactor >> oldSelector } senders: #(). - refactoring apply. +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 18:55:09'! +assertEntriesWhenBrowsing: sourceCode areSelectorsOf: aClass + + self + assertEntriesWhenBrowsing: sourceCode + areSelectorsOf: aClass + beginningWith: ''! ! - renamedMethod := classToRefactor >> newSelector. - parameters := selectorAndParameters substrings reject: [ :aKeywordOrParameter | oldSelector keywords includes: aKeywordOrParameter ]. +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 18:58:41'! +assertEntriesWhenBrowsing: sourceCode areSelectorsOf: aClass beginningWith: aPrefix + self - assert: (OrderedCollection with: parameters second with: parameters first) - equals: renamedMethod methodNode argumentNames ! ! + assertEntriesOf: (self autocompleteEntriesBrowsing: sourceCode) + areAllSelectorsOf: aClass + beginningWith: aPrefix + ! ! -!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 05:31:03'! -test06NewSelectorMustIncludeOldSelectorKeywords +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 17:40:10'! +assertEntriesWhenBrowsing: sourceCode areSelectorsOfAll: classes + + self + assertEntriesWhenBrowsing: sourceCode + areSelectorsOfAll: classes + beginningWith: ''! ! +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 17:41:09'! +assertEntriesWhenBrowsing: sourceCode areSelectorsOfAll: classes beginningWith: aPrefix + self - assertCreation: [ ChangeKeywordsSelectorOrder from: #m1:m2: to: #m3:m1: implementors: #() senders: #() ] - failsWith: [ ChangeKeywordsSelectorOrder newSelectorDoesNotIncludeOldSelectorKeywordsErrorMessage ] - ! ! + assertEntriesOf: (self autocompleteEntriesBrowsing: sourceCode) + areAllSelectorsOfAll: classes + beginningWith: aPrefix + ! ! -!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 05:52:00'! -test07ChangesKeywordsAndParametersOrderForMoreThanTwoKeywords +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 18:59:22'! +assertEntriesWhenBrowsing: sourceCode areUnaryAndBinarySelectorsOf: aClass + + self + assertEntriesOf: (self autocompleteEntriesBrowsing: sourceCode) + areUnaryAndBinarySelectorsOf: aClass. + + ! ! - | classToRefactor refactoring renamedMethod oldSelector newSelector selectorAndParameters parameters | +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 21:33:48'! +assertEntriesWhenBrowsingMethod: aMethod areSelectorsOf: aClass + + self + assertEntriesWhenBrowsingMethod: aMethod + areSelectorsOf: aClass + beginningWith: ''! ! - oldSelector := #m1:m2:m3:. - newSelector := #m2:m3:m1:. - classToRefactor := self createClassNamed: #ClassToChangeSelectorOrder. - selectorAndParameters := self selectorAndParametersFor: oldSelector. - classToRefactor compile: selectorAndParameters. +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 21:36:46'! +assertEntriesWhenBrowsingMethod: aMethod areSelectorsOf: aClass beginningWith: aPrefix + + self + assertEntriesOf: (self autocompleteEntriesBrowsingMethod: aMethod) + areAllSelectorsOf: aClass + beginningWith: aPrefix + ! ! - refactoring := ChangeKeywordsSelectorOrder from: oldSelector to: newSelector implementors: { classToRefactor >> oldSelector } senders: #(). - refactoring apply. +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 21:36:46'! +assertEntriesWhenBrowsingMethod: aMethod areUnaryAndBinarySelectorsOf: aClass + + self + assertEntriesOf: (self autocompleteEntriesBrowsingMethod: aMethod) + areUnaryAndBinarySelectorsOf: aClass. + + ! ! - renamedMethod := classToRefactor >> newSelector. - parameters := selectorAndParameters substrings reject: [ :aKeywordOrParameter | oldSelector keywords includes: aKeywordOrParameter ]. +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 20:25:15'! +denyComputingEntriesIsSupportedWhenBrowsing: sourceCode + + | completer | + completer := self createCompleterForBrowsing: sourceCode. + self - assert: (OrderedCollection with: parameters second with: parameters third with: parameters first) - equals: renamedMethod methodNode argumentNames ! ! + should: [ completer computeEntries ] + raise: Error. + self + assert: completer + analizedSelectorsFrom: nil + canShowDocumentation: true + detectedPossibleInvalidSelector: #() + suggested: nil.! ! -!ChangeKeywordsSelectorOrderTest methodsFor: 'source code creation' stamp: 'HAW 3/17/2019 05:43:44'! -selectorAndParametersFor: aKeywordSelector +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'NPM 3/18/2020 20:25:15'! +denyHasEntries: aCompleter - ^String streamContents: [ :stream | - aKeywordSelector keywords - withIndexDo: [ :aKeyword :index | - stream - nextPutAll: aKeyword; - space; - nextPut: $p; - print: index ] - separatedBy: [ stream space ]] - ! ! + self + assert: aCompleter + analizedSelectorsFrom: nil + canShowDocumentation: nil + detectedPossibleInvalidSelector: #() + suggested: #()! ! -!ExtractAsParameterTest methodsFor: 'assertions' stamp: 'HAW 9/22/2021 16:02:51'! -assertCanExtractAsParameter: toExtract +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 20:24:54'! +entriesToCompareFrom: aCollectionOfEntries - self assertCanExtractFrom: toExtract size: toExtract size introducing: toExtract! ! + ^(aCollectionOfEntries reject: [ :anEntry | + anEntry beginsWith: AutoCompleterSelectorsCollector categoryEntryHeader ]) asSet! ! -!ExtractAsParameterTest methodsFor: 'assertions' stamp: 'HAW 9/22/2021 15:11:43'! -assertCanExtractFrom: sourceCode interval: interval introducing: toIntroduced +!SmalltalkCompleterTest methodsFor: 'assertions' stamp: 'HAW 5/2/2020 20:10:35'! +using: aCompleter addUnaryAndBinarySelectorsOf: aClass + + ^ aCompleter unaryAndBinarySelectorsOf: aClass beginningWith: ''! ! - | refactoring classToRefactor oldSelector newSelector newImplementorSourceCode newParameter senderSelector senderMethod | - - oldSelector := 'm1' asSymbol. - newSelector := (oldSelector, ':') asSymbol. - newParameter := 'newParam'. - senderSelector := 'sender_m1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' ', sourceCode. - classToRefactor compile: senderSelector asString, ' self ', oldSelector asString. - - refactoring := ExtractAsParameter - named: newParameter - extractedFrom: interval + 3 - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). +!SmalltalkCompleterTest methodsFor: 'setUp/tearDown' stamp: 'NPM 3/18/2020 18:32:49'! +setUp + + super setUp. - newImplementorSourceCode := (classToRefactor>>newSelector) sourceCode. - self assert: newSelector, ' ', newParameter, ' ', (sourceCode first: interval first - 1), newParameter, (sourceCode last: sourceCode size - interval last) equals: newImplementorSourceCode. + self browseClass: SmalltalkCompleterTest. - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: senderSelector asString, ' self ', newSelector asString, ' ', toIntroduced equals: senderMethod sourceCode! ! +! ! -!ExtractAsParameterTest methodsFor: 'assertions' stamp: 'HAW 9/22/2021 11:51:22'! -assertCanExtractFrom: sourceCode size: toExtractSize introducing: toIntroduced +!SmalltalkCompleterTest methodsFor: 'running' stamp: 'HAW 5/2/2020 20:49:50'! +performTest - self assertCanExtractFrom: sourceCode interval: (1 to: toExtractSize) introducing: toIntroduced ! ! + ^SmalltalkCompleter changeEntriesLimitTo: SmallInteger maxVal during: [ super performTest ]! ! -!ExtractAsParameterTest methodsFor: 'assertions' stamp: 'HAW 9/22/2021 16:03:34'! -assertCannotExtractAsParameter: newParameterValue withErrorMessage: anErrorMessage +!SmalltalkCompleterTest class methodsFor: 'testing' stamp: 'HAW 5/2/2020 13:21:14'! +isAbstract - | classToRefactor oldSelector | + ^true! ! + +!DynamicTypingSmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:43:31'! +test023_AutocompletingMessagesFor_UnaryMessages - oldSelector := 'm1' asSymbol. + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 self class '. + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 1 + self class '. ! ! + +!DynamicTypingSmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:44:50'! +test024_AutocompletingMessagesFor_RightParenthesis - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' ', newParameterValue. + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 (1) '. + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 1 < (1) '.! ! + +!DynamicTypingSmalltalkCompleterTest methodsFor: 'tests' stamp: 'HAW 5/6/2020 23:45:10'! +test026_AutocompletingMessagesFor_Cascade - self - assertCreation: [ ExtractAsParameter - named: 'newParam' - extractedFrom: (4 to: 3+newParameterValue size) - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {} ] - failsWith: anErrorMessage ! ! + self assertEntriesAreSelectorsOfUnknownClassesWhenBrowsing: 'm1 self class; '. + ! ! -!ExtractAsParameterTest methodsFor: 'assertions' stamp: 'HAW 9/22/2021 16:06:03'! -assertCannotExtractInvalidNodeAsParameter: newParameterValue +!DynamicTypingSmalltalkCompleterTest class methodsFor: 'testing' stamp: 'HAW 5/2/2020 16:27:37'! +isAbstract - self - assertCannotExtractAsParameter: newParameterValue - withErrorMessage: ExtractAsParameter errorMessageForInvalidExpressionToExtractAsParameter! ! + ^DynamicTypingSmalltalkCompleter isForCurrentTypeSystem not! ! -!ExtractAsParameterTest methodsFor: 'assertions' stamp: 'HAW 9/22/2021 16:05:39'! -assertCannotExtractInvalidSelectionAsParameter: newParameterValue +!TaskbarTest methodsFor: 'Running' stamp: 'jmv 10/24/2020 15:55:32'! +setUp - self - assertCannotExtractAsParameter: newParameterValue - withErrorMessage: ExtractAsParameter errorMessageForInvalidSelection ! ! + needsDelete _ UISupervisor ui taskbar isNil. + taskbar _ UISupervisor ui hideTaskbar; showTaskbar; taskbar. + taskbar screenSizeChanged. + taskbar world runStepMethods! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:07:02'! -test01CanExtractLiterals +!TaskbarTest methodsFor: 'Running' stamp: 'jmv 12/28/2017 16:12:13'! +tearDown - self assertCanExtractAsParameter: '1' -! ! + needsDelete ifTrue: [ + UISupervisor ui hideTaskbar ]! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:07:26'! -test02CannotExtract_self +!TaskbarTest methodsFor: 'test cases' stamp: 'jmv 12/28/2017 16:12:16'! +testClassSingleton - self assertCannotExtractInvalidNodeAsParameter: 'self'. - - ! ! + self should: [ taskbar == UISupervisor ui taskbar ]. +! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:08:15'! -test03CannotExtract_super +!TaskbarTest methodsFor: 'test cases' stamp: 'jmv 9/4/2012 17:30'! +testHorizontalAlignment - self assertCannotExtractInvalidNodeAsParameter: 'super'. + self should: [ taskbar morphPositionInWorld x = 0 ]! ! + +!TaskbarTest methodsFor: 'test cases' stamp: 'jmv 12/28/2017 16:12:01'! +testWidth - ! ! + self should: [ taskbar morphWidth = UISupervisor ui morphWidth ]! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:09:04'! -test04CannotExtract_thisContext +!TestCaseTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:47:26'! +testIsTestCase + self assert: (TestCase new is: #TestCase).! ! - self assertCannotExtractInvalidNodeAsParameter: 'thisContext'. - - ! ! +!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 3/17/2019 07:31:39'! +testShouldFailErrorsWhenNoErrorIsSignaled -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:08:57'! -test05CanExtractMessageSendToLiteralWithLiterals + self + should: [ self shouldFail: [] ] + raise: TestResult failure! ! - self assertCanExtractAsParameter: '1 + 1'. - - ! ! +!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 3/17/2019 07:32:19'! +testShouldFailPassesWhenAnErrorIsSignaled -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:09:15'! -test06CanExtract_true + self shouldFail: [ self error: 'an error' ]! ! - self assertCanExtractAsParameter: 'true'! ! +!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 4/5/2018 14:32:15'! +testShouldRaiseWithExceptionDoCanExpectException -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:09:30'! -test07CannotExtract_comment + "This test is important becuase TestFailure is a subclass of Exception, therefore if we are expecting Exception to be raised it should not + catch the TestFailure - Hernan" + + | failureRaised | + + failureRaised := false. + + [self should: [] raise: Exception ] + on: TestResult failure + do: [ :failure | failureRaised := true ]. + + self assert: failureRaised ! ! - self assertCannotExtractInvalidSelectionAsParameter: '"comment"'. +!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HernanWilkinson 1/19/2017 20:52:39'! +testShouldRaiseWithExceptionDoFailsWhenNoExceptionIsSignaled - ! ! + | failureSignaled | + + failureSignaled := false. + + [self + should: [] + raise: ZeroDivide + withExceptionDo: [:signaledException | self error: 'should not evaluate this block' ]] + on: TestResult failure + do: [:failure | failureSignaled := true ]. + + self assert: failureSignaled ! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:09:52'! -test08CanExtractSelectionWithSeparators +!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HernanWilkinson 1/19/2017 20:52:31'! +testShouldRaiseWithExceptionDoFailsWhenOtherExceptionTypeIsSignaled - self assertCanExtractFrom: ' 10 ' size: 4 introducing: '10' + | exceptionToRaise | - ! ! + exceptionToRaise := Error new. + + [self + should: [ exceptionToRaise signal ] + raise: ZeroDivide + withExceptionDo: [:signaledException | self error: 'should not evalaute this block' ]] + on: Error + do: [:anError | self assert: exceptionToRaise equals: anError ] + +! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:10:22'! -test09RemovesTrailingDotsFromSelection +!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HernanWilkinson 1/19/2017 20:51:53'! +testShouldRaiseWithExceptionDoPassSignaledExceptionToAssertionsBlock - | refactoring classToRefactor oldSelector newSelector newImplementorSourceCode newParameter senderSelector senderMethod toExtract | + | exceptionToRaise | - oldSelector := 'm1' asSymbol. - newSelector := (oldSelector, ':') asSymbol. - newParameter := 'newParam'. - senderSelector := 'sender_m1' asSymbol. - toExtract := '1.'. + exceptionToRaise := Error new. - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' ', toExtract, ' self printString'. - classToRefactor compile: senderSelector asString, ' self ', oldSelector asString. + self + should: [ exceptionToRaise signal ] + raise: exceptionToRaise class + withExceptionDo: [:signaledException | + self assert: exceptionToRaise equals: signaledException ]. + +! ! + +!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HernanWilkinson 1/19/2017 20:51:45'! +testShouldRaiseWithExceptionDoValuesAssertionsBlockWhenExceptionIsRaised + + | exceptionToRaise assertionsBlockEvaluated | - refactoring := ExtractAsParameter - named: newParameter - extractedFrom: (4 to: 5) - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {classToRefactor>>senderSelector}. - refactoring apply. + exceptionToRaise := Error new. + assertionsBlockEvaluated := false. - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). + self + should: [ exceptionToRaise signal ] + raise: exceptionToRaise class + withExceptionDo: [:signaledException | + assertionsBlockEvaluated := true ]. + + self assert: assertionsBlockEvaluated ! ! + +!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 2/6/2019 13:37:19'! +testShouldRaiseWithMessageTextDoesNotFailWithRightMessageText + + | messageText | - newImplementorSourceCode := (classToRefactor>>newSelector) sourceCode. - self assert: newSelector, ' ', newParameter, ' ', newParameter, '. self printString' equals: newImplementorSourceCode. + messageText := 'some message'. - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: senderSelector asString, ' self ', newSelector asString, ' 1' equals: senderMethod sourceCode! ! + self + shouldnt: [ + self + should: [ self error: messageText ] + raise: Error + withMessageText: messageText ] + raise: TestResult failure + ! ! + +!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 2/6/2019 13:38:00'! +testShouldRaiseWithMessageTextFailsWithDifferentMessageText + + self + should: [ + self + should: [ self error: 'some message' ] + raise: Error + withMessageText: '' ] + raise: TestResult failure + ! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:10:35'! -test10CanExtractWithParenthesis +!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 3/17/2019 06:42:30'! +testShoulndFailErrorsWhenAnErrorIsSignaled - self assertCanExtractFrom: '(1)' size: 3 introducing: '1' - - ! ! + self + should: [ self shouldntFail: [ self fail ]] + raise: TestResult failure! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:10:45'! -test11CanExtract_symbol +!TestCaseTest methodsFor: 'exception testing tests' stamp: 'HAW 3/17/2019 06:41:26'! +testShoulndFailPassesWhenNoErrorIsSignaled - self assertCanExtractAsParameter: '#assert:'! ! + self shouldntFail: [ 1+2 ]! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:10:55'! -test12CanExtract_false +!TestCaseTest methodsFor: 'changes' stamp: 'HAW 5/15/2019 18:33:28'! +testAssertChangesByPassesWhenActionChangesConditionByTheSpecifiedAmount - self assertCanExtractAsParameter: 'false'! ! + |aCollection| -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:11:03'! -test13CanExtract_nil + aCollection := OrderedCollection new. + + self assert: [ aCollection add: 1; add: 2 ] changes: [ aCollection size ] by: 2! ! - self assertCanExtractAsParameter: 'nil'! ! +!TestCaseTest methodsFor: 'changes' stamp: 'HAW 5/15/2019 18:34:29'! +testAssertChangesFromToPassesWhenActionChangesConditionFromAndToTheSpecifiedValues -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:11:34'! -test14CanExtactFromKeywordSelector + |aCollection| - | refactoring classToRefactor oldSelector newSelector newImplementorSourceCode newParameter senderSelector senderMethod toExtract newKeyword | + aCollection := OrderedCollection with: 1. - oldSelector := 'm1:' asSymbol. - newKeyword := 'm2:' asSymbol. - newSelector := (oldSelector, newKeyword) asSymbol. - newParameter := 'newParam'. - senderSelector := 'sender_m1' asSymbol. - toExtract := '1.'. + self assert: [ aCollection add: 2 ] changes: [ aCollection size ] from: 1 to: 2! ! - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector, ' p1 ', toExtract, ' self printString'. - classToRefactor compile: senderSelector, ' self ', oldSelector, ' #x '. - - refactoring := ExtractAsParameter - named: newParameter - extractedFrom: (8 to: 9) - at: 2 - newKeyword: newKeyword - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). - - newImplementorSourceCode := (classToRefactor>>newSelector) sourceCode. - self assert: oldSelector, ' p1 ', newKeyword, ' ', newParameter, ' ', newParameter, '. self printString' equals: newImplementorSourceCode. - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: senderSelector, ' self ', oldSelector, ' #x ', newKeyword, ' 1 ' equals: senderMethod sourceCode! ! +!TestCaseTest methodsFor: 'changes' stamp: 'HAW 5/15/2019 18:33:34'! +testAssertChangesPassesWhenConditionIsAlteredByAction -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:12:01'! -test15CanExtractMessageSendToLiteral + |aCollection| - | refactoring classToRefactor oldSelector newSelector newImplementorSourceCode newParameter senderSelector senderMethod toExtract | + aCollection := OrderedCollection new. - oldSelector := 'm1' asSymbol. - newSelector := (oldSelector, ':') asSymbol. - newParameter := 'newParam'. - senderSelector := 'sender_m1' asSymbol. - toExtract := '10 factorial'. + self assert: [ aCollection add: 1 ] changes: [ aCollection size ]! ! - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector, ' ', toExtract. - classToRefactor compile: senderSelector, ' self ', oldSelector. - - refactoring := ExtractAsParameter - named: newParameter - extractedFrom: (4 to: 15) - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {classToRefactor>>senderSelector}. - refactoring apply. - - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector). - - newImplementorSourceCode := (classToRefactor>>newSelector) sourceCode. - self assert: newSelector, ' ', newParameter, ' ', newParameter equals: newImplementorSourceCode. - - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: senderSelector, ' self ', newSelector, ' ', toExtract equals: senderMethod sourceCode! ! +!TestCaseTest methodsFor: 'changes' stamp: 'HAW 5/15/2019 18:33:39'! +testAssertDoeNotChangePassesWhenConditionIsNotAlteredByAction -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:12:21'! -test16CannotExtractMessageSendWithInvalidNode + |aCollection| - self assertCannotExtractInvalidNodeAsParameter: '10 + self'! ! + aCollection := OrderedCollection with: 1. + + self assert: [ aCollection sum ] doesNotChange: [ aCollection size ]! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:12:38'! -test17CannotExtractMessageSendToInvalidNode +!TestCaseTest methodsFor: 'assert is near to' stamp: 'jmv 7/1/2019 16:24:01'! +testAssertIsCloseToPassesForSameNumberDifferentToZero + + self assert: 1.5 isCloseTo: 1.5! ! - self assertCannotExtractInvalidNodeAsParameter: 'self + 10'! ! +!TestCaseTest methodsFor: 'assert is near to' stamp: 'jmv 7/1/2019 16:24:12'! +testAssertIsCloseToPassesWhenBothAreZero -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:12:59'! -test18CanExtractManyMessageSends + self assert: 0.0 isCloseTo: 0.0! ! - self assertCanExtractAsParameter: '10 + 10 + 10'! ! +!TestCaseTest methodsFor: 'assert is near to' stamp: 'jmv 7/1/2019 16:24:18'! +testAssertIsCloseToPassesWithSameCalculatedNumber + + self assert: 0.3 isCloseTo: 0.1 + 0.2! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:13:19'! -test19CannotExtractManyMessageSendsWithInvalidNode +!TestCaseTest methodsFor: 'assert is near to' stamp: 'jmv 7/1/2019 16:24:24'! +testAssertIsCloseToWithPrecisionPassesWhenDifferenceIsNegativeAndLessThanPrecision + + |precision newValue originalNumber | + + precision _ 0.1. + originalNumber _ 0.3. + newValue _ originalNumber - 0.01. + + self assert: originalNumber isCloseTo: newValue withPrecision: precision! ! - self assertCannotExtractInvalidNodeAsParameter: '10 + 10 + self'! ! +!TestCaseTest methodsFor: 'assert is near to' stamp: 'jmv 7/1/2019 16:24:30'! +testAssertIsCloseToWithPrecisionPassesWhenDifferenceIsPositiveAndLessThanPrecision + + |precision newValue originalNumber | + + precision _ 0.1. + originalNumber _ 0.3. + newValue _ originalNumber + 0.01. + + self assert: originalNumber isCloseTo: newValue withPrecision: precision! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:13:38'! -test20CanExtractPartOfAValidExpression +!TestCaseTest methodsFor: 'assert is near to' stamp: 'jmv 7/1/2019 16:24:39'! +testAssertIsNotCloseWithPrecisionPassesWhenDifferenceIsBiggerThanPrecision + + |precision newValue originalNumber | + + precision _ 0.1. + originalNumber _ 0.3. + newValue _ originalNumber + precision + 0.001. + + self assert: originalNumber isNotCloseTo: newValue withPrecision: precision! ! - self assertCanExtractFrom: '10 + 10' size: 2 introducing: '10' - ! ! +!TestCaseTest methodsFor: 'includes' stamp: 'HAW 5/15/2019 18:49:51'! +testAssertIncludesFailsWhenElementIsNotIncludedInCollection + + | collection anElement | + + anElement _ 1. + collection _ #(). + + self should: [ self assert: collection includes: anElement ] + raise: TestResult failure + withMessageText: collection asString, ' does not include ', anElement asString! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:13:48'! -test21CanExtractABlock +!TestCaseTest methodsFor: 'includes' stamp: 'HAW 5/15/2019 18:50:04'! +testAssertIncludesShouldNotFailWhenElementIsInCollection + + | collection anElement | + + anElement _ 1. + collection _ Array with: anElement. + + self + shouldnt: [ self assert: collection includes: anElement ] + raise: TestResult failure! ! - self assertCanExtractAsParameter: '[10]' - ! ! +!TestCaseTest methodsFor: 'should take less than' stamp: 'jmv 3/10/2022 11:42:41'! +testShouldNotTakeMoreThanFailsWhenClosureTakesMoreThanTheLimit -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:14:01'! -test22CannotExtractBlockWithInvalidNode + self shouldFail: [ self should: [(Delay forMilliseconds: 50) wait ] notTakeMoreThan: 10 milliSeconds ]! ! - self assertCannotExtractInvalidNodeAsParameter: '[self]' - ! ! +!TestCaseTest methodsFor: 'should take less than' stamp: 'HAW 5/15/2019 19:07:04'! +testShouldNotTakeMoreThanPassesWhenClosureTakesLessThanTheLimit -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:14:17'! -test23CannotExtractBlockWithMessageSendWithInvalidNode + self shouldntFail: [ self should: [] notTakeMoreThan: 1 milliSeconds ] + ! ! - self assertCannotExtractInvalidNodeAsParameter: '[1 + self]' +!TestSuiteTest methodsFor: 'assertions' stamp: 'HAW 2/10/2017 15:11:43'! +assert: expectedTestSuite hasSameTestsAs: resultTestSuite + + | expectedTests resultTests | + + expectedTests _ expectedTestSuite tests. + resultTests _ resultTestSuite tests. + + self assert: expectedTests size equals: resultTests size. + self assert: (expectedTests allSatisfy: [:expectedTest | resultTests anySatisfy: [:resultTest | self is: expectedTest equalTo: resultTest ]]) ! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:14:34'! -test24CanExtractBlockWithManyExpressions +!TestSuiteTest methodsFor: 'assertions' stamp: 'jmv 3/12/2018 20:41:35'! +assertIncludesThisTest: aTestSuite + + | thisTestSelector | + + thisTestSelector _ thisContext sender selector. + ^aTestSuite tests anySatisfy: [ :aTestCase | aTestCase class = self class and: [aTestCase selector = thisTestSelector ]]! ! - self assertCanExtractAsParameter: '[1 + 1. 2 + 2]' - ! ! +!TestSuiteTest methodsFor: 'assertions' stamp: 'HAW 2/10/2017 15:20:29'! +is: expectedTest equalTo: resultTest -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:14:44'! -test25CanExtractBlockWithParameters + ^expectedTest class = resultTest class and: [ expectedTest selector = resultTest selector ]! ! - self assertCanExtractAsParameter: '[:p1 | 1 + p1]' - ! ! +!TestSuiteTest methodsFor: 'test support' stamp: 'HAW 10/29/2019 11:13:21'! +hardCodedReferenceToSelfClass -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:15:06'! -test26CannotExtractBlockThatReferencesMethodVariable + ^TestSuiteTest ! ! - | classToRefactor oldSelector | - - oldSelector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' | var1 | [ 1 + var1 ]'. - - self - assertCreation: [ ExtractAsParameter - named: 'newParam' - extractedFrom: (13 to: 24) - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {} ] - failsWith: ExtractAsParameter errorMessageForInvalidExpressionToExtractAsParameter +!TestSuiteTest methodsFor: 'test support' stamp: 'HAW 3/3/2017 16:37:00'! +quickMethodTest -! ! + "stub for a quick method - Hernan"! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:15:23'! -test27CanExtractBlockWithParameterAndLocalVariable +!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 15:22:49'! +test01SuiteForTestCaseClassHasTheSameTestAsCreatingTheSuiteFromTheTestCaseClass - self assertCanExtractAsParameter: '[:p1 | | v1 | v1 := 1. v1 + p1]' - ! ! + self assert: self class buildSuite hasSameTestsAs: (TestSuite forClass: self class)! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:16:13'! -test28CanExtractBlockEvaluation +!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 15:24:17'! +test02SuiteForNoTestCaseClassUsesTestClassWithSameNameEndingWithTest - | toExtract | + self assert: self class buildSuite hasSameTestsAs: (TestSuite forClass: TestSuite)! ! + +!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 10/29/2019 11:12:11'! +test03SuiteForNoTestCaseClassAndNoTestClassLooksForReferencesInTests + + | objectTestSuite referencesToObject testCaseClasses | - toExtract := '[:p1 | p1] value: 1'. - self assertCanExtractFrom: toExtract size: toExtract size introducing: '(', toExtract ,')' + "I need to be sure that Object has no test class for the test to make sense - Hernan" + self assert: self class testCaseClass isNil. + + objectTestSuite _ TestSuite forClass: self class. + referencesToObject _ self class allCallsOn collect: [:aMethodReference | aMethodReference actualClass ]. + testCaseClasses _ (objectTestSuite tests collect: [:aTestCase | aTestCase class ]) asSet. + + self assert: objectTestSuite tests notEmpty. + self assert: (testCaseClasses allSatisfy: [:aTestCaseClass | (aTestCaseClass is: #TestCaseClass) and: [ referencesToObject includes: aTestCaseClass ]]) ! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:16:32'! -test29CannotExtractInvalidInterval +!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 15:41:52'! +test04SuiteForTestMethodIncludesOnlyTheMethod - | classToRefactor oldSelector | - - oldSelector := 'm1' asSymbol. + self assert: (TestSuite new addTest: (self class selector: thisContext selector)) hasSameTestsAs: (TestSuite forCompiledMethod: thisContext method)! ! + +!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 15:56:00'! +test05SuiteForNoTestMethodIncludesTestCaseSendingTheCompiledMethodSelector + + | compiledMethodSuite compiledMethodSelector senders | - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString. + compiledMethodSelector _ #addTest:. + compiledMethodSuite _ TestSuite forCompiledMethod: (TestSuite compiledMethodAt: compiledMethodSelector). + senders _ (Smalltalk allCallsOn: compiledMethodSelector) collect: [:aMethodReference | aMethodReference selector ]. - self - assertCreation: [ ExtractAsParameter - named: 'newParam' - extractedFrom: (2 to: 1) - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {} ] - failsWith: ExtractMethodNewMethod noSelectionErrorMessage ! ! + self assert: compiledMethodSuite tests notEmpty. + self assert: (compiledMethodSuite tests allSatisfy: [:aTestCase | (aTestCase class is: #TestCaseClass) and: [ senders includes: aTestCase selector]])! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:16:45'! -test30CannotExtractIntervalOutOfBounds +!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 16:39:30'! +test06ForSystemCategoryWithTestCasesIncludesOnlyTestCasesClasses - | classToRefactor oldSelector | - - oldSelector := 'm1' asSymbol. + | suite | - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString. + suite _ TestSuite forSystemCategoryNamed: self class category using: SystemOrganization. - self - assertCreation: [ ExtractAsParameter - named: 'newParam' - extractedFrom: (2 to: 20) - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {} ] - failsWith: ExtractMethodNewMethod outOfBoundsSelectionErrorMessage ! ! + "I just make a simple assertion that verifies this test is included - Hernan" + self assertIncludesThisTest: suite ! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:17:03'! -test31CannotExtractIfOriginalMethodIsNotInImplementors +!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 16:41:00'! +test07ForSystemCategoryWithNoTestCasesIncludesTestClassesTests - | classToRefactor oldSelector | + | suite | - oldSelector := 'm1' asSymbol. + suite _ TestSuite forSystemCategoryNamed: TestSuite category using: SystemOrganization. - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' 1'. + "I just make a simple assertion that verifies this test is included - Hernan" + self assertIncludesThisTest: suite ! ! + +!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 16:41:08'! +test08ForMessageCategoryContainingTestCasesIncludesThoseTestCases + + | suite classOrganizer | - self - assertCreation: [ ExtractAsParameter - named: 'newParam' - extractedFrom: (4 to: 4) - at: classToRefactor>>oldSelector - implementors: {} - senders: {} ] - failsWith: ExtractAsParameter errorMessageForOrigialMethodMustBeInImplementorsToChange! ! + classOrganizer _ self class organization. + suite _ TestSuite forMessageCategoryNamed: (classOrganizer categoryOfElement: thisContext selector) of: self class categorizedWith: classOrganizer. -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:21:15'! -test32CannotExtractMoreThanOneExpression + "I just make a simple assertion that verifies this test is included - Hernan" + self assertIncludesThisTest: suite ! ! - self assertCannotExtractInvalidSelectionAsParameter: '1+1. 2+2' ! ! +!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 2/10/2017 16:38:46'! +test09ForMessageCategoryWihoutTestIsEmpty -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 19:54:04'! -test33WhenAddingToUnaryMessageSelectorMustBeUnary - - | classToRefactor oldSelector | - - oldSelector := 'm1:' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' p1 1'. + | suite classOrganizer | + classOrganizer _ self class organization. + suite _ TestSuite forMessageCategoryNamed: (classOrganizer categoryOfElement: #assert:hasSameTestsAs:) of: self class categorizedWith: classOrganizer. + + self assert: suite tests isEmpty! ! + +!TestSuiteTest methodsFor: 'tests - instance creation' stamp: 'HAW 3/3/2017 18:53:02'! +test10CanNotDebugAsFailureQuickMethods + + self class debugAsFailure: #quickMethodTest ifCanNot: [ ^self ]. + self fail! ! + +!DifferenceFinderTest methodsFor: 'all' stamp: 'LC 1/24/2010 11:29'! +testCharacters + | lcs | + lcs := DifferenceFinder charactersOf: 'GAC' and: 'AGCAT'. + lcs compute. self - assertCreation: [ ExtractAsParameter - named: 'newParam' - extractedFrom: (8 to: 8) - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {} ] - failsWith: AddParameter selectorMustBeUnaryErrorMessage ! ! + assert: (lcs lcsAt: 1 at: 1) anyOne size = 0; + assert: (lcs lcsAt: 1 at: 2) anyOne size = 1; + assert: (lcs lcsAt: 1 at: 3) anyOne size = 1; + assert: (lcs lcsAt: 1 at: 4) anyOne size = 1; + assert: (lcs lcsAt: 1 at: 5) anyOne size = 1; + assert: (lcs lcsAt: 2 at: 1) anyOne size = 1; + assert: (lcs lcsAt: 2 at: 2) anyOne size = 1; + assert: (lcs lcsAt: 2 at: 3) anyOne size = 1; + assert: (lcs lcsAt: 2 at: 4) anyOne size = 2; + assert: (lcs lcsAt: 2 at: 5) anyOne size = 2; + assert: (lcs lcsAt: 3 at: 1) anyOne size = 1; + assert: (lcs lcsAt: 3 at: 2) anyOne size = 1; + assert: (lcs lcsAt: 3 at: 3) anyOne size = 2; + assert: (lcs lcsAt: 3 at: 4) anyOne size = 2; + assert: (lcs lcsAt: 3 at: 5) anyOne size = 2 +! ! + +!DifferenceFinderTest methodsFor: 'all'! +testCharacters2 + | finder x y | + finder := DifferenceFinder charactersOf: 'GAC' and: 'AGCAT'. + finder compute. + self assert: finder differences size = 3. + finder differences do: [:diff | + x := String streamContents: [:strm | + diff + do: [:char :condition | (#(#removed #unchanged) includes: condition) + ifTrue: [strm nextPut: char]]]. + self assert: x = 'GAC'. + y := String streamContents: [:strm | + diff + do: [:char :condition | (#(#inserted #unchanged) includes: condition) + ifTrue: [strm nextPut: char]]]. + self assert: y = 'AGCAT'] +! ! + +!DifferenceFinderTest methodsFor: 'all'! +testCode + | old new finder | + old := 'differencesText + | change sourceString current diff rtf selectedString | + change := self selectedMethod ifNil: [self currentClass]. + current := change currentVersion. + sourceString := current isNil + ifTrue: [''] + ifFalse: [current isCompiledMethod ifTrue: [(self + formatSource: current sourceString + inClass: current classField) + sourceCode] ifFalse: [current sourceString]]. + selectedString := (current isNil or: [current isCompiledMethod not]) + ifTrue: [change sourceString] + ifFalse: [((self + formatSource: change sourceString + inClass: current classField) ifNil: [change]) sourceCode]. + diff := TextDiffBuilder from: sourceString to: selectedString. + rtf := RTFText new setFont: TextFont. + rtf setTabStops: self tabStops. + diff run; printPatchSequenceOn: rtf. + ^rtf contents contents'. + new := 'differencesText + | change sourceString current finder rtf selectedString | + change := self selectedMethod ifNil: [self currentClass]. + current := change currentVersion. + sourceString := current isNil ifTrue: [''] ifFalse: [ + current isCompiledMethod + ifTrue: [(self + formatSource: current sourceString + inClass: current classField) + sourceCode] + ifFalse: [current sourceString]]. + selectedString := (current isNil or: [current isCompiledMethod not]) + ifTrue: [change sourceString] + ifFalse: [((self + formatSource: change sourceString + inClass: current classField) + ifNil: [change]) + sourceCode]. + finder := DifferenceFinder wordsOf: sourceString and: selectedString. + finder compute. + rtf := RTFText new setFont: TextFont. + rtf setTabStops: self tabStops. + finder differences first printTextOn: rtf. + ^rtf contents contents'. + finder := DifferenceFinder wordsOf: old and: new. + finder compute +! ! + +!DifferenceFinderTest methodsFor: 'all'! +testLines + | finder alan ian x y | + alan := 'The best way to + predict + the future is to + invent + it. + A. Kay'. + ian := 'The best way to + invent + the future is to + not predicting + it. + Ian Piumarta'. + finder := DifferenceFinder linesOf: alan and: ian. + finder compute. + finder differences do: [:diff | + x := String streamContents: [:strm | + diff + do: [:chunk :condition | (#(#removed #unchanged) includes: condition) + ifTrue: [strm nextPutAll: chunk]]]. + self assert: x = alan. + y := String streamContents: [:strm | + diff + do: [:chunk :condition | (#(#inserted #unchanged) includes: condition) + ifTrue: [strm nextPutAll: chunk]]]. + self assert: y = ian] +! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 19:54:11'! -test34WhenAddingToKeywordMessageSelectorMustBeKeyword - - | classToRefactor oldSelector | - - oldSelector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' 1'. - - self - assertCreation: [ ExtractAsParameter - named: 'newParam' - extractedFrom: (4 to: 4) - at: 1 - newKeyword: #m2: - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {} ] - failsWith: AddParameter selectorMustBeKeywordErrorMessage ! ! +!DifferenceFinderTest methodsFor: 'all'! +testWords + | finder alan ian x y | + alan := 'The best way to + predict + the future is to + invent + it. + A. Kay'. + ian := 'The best way to + invent the future is to + not predicting + it. + Ian Piumarta'. + finder := DifferenceFinder wordsOf: alan and: ian. + finder compute. + finder differences do: [:diff | + x := String streamContents: [:strm | + diff + do: [:chunk :condition | (#(#removed #unchanged) includes: condition) + ifTrue: [strm nextPutAll: chunk]]]. + self assert: x = alan. + y := String streamContents: [:strm | + diff + do: [:chunk :condition | (#(#inserted #unchanged) includes: condition) + ifTrue: [strm nextPutAll: chunk]]]. + self assert: y = ian] +! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 18:19:43'! -test35CanExtractManyIntervals - - | classToRefactor oldSelector refactoring | - - oldSelector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' 10 + 10'. - - refactoring := ExtractAsParameter - named: 'newParam' - extractedFromAll: { (4 to: 5). (9 to: 10) } - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {}. - - refactoring apply. - - self assert: 'm1: newParam newParam + newParam' equals: (classToRefactor >> #m1:) sourceCode - ! ! +!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:31:27'! +allClassCategoriesOfTestData -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 18:20:26'! -test36CannotExtractIfAnyIntervalIsNotValid - - | classToRefactor oldSelector | - - oldSelector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' 10 + self'. - - self - assertCreation: [ ExtractAsParameter - named: 'newParam' - extractedFromAll: { (4 to: 5). (9 to: 12) } - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {} ] - failsWith: ExtractAsParameter errorMessageForInvalidExpressionToExtractAsParameter - - - ! ! + ^Array with: self classCategoryOfTestData ! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 18:20:36'! -test37CannotExtractIfSourceToExtractAreNotEqualInAllIntervals - - | classToRefactor oldSelector | - - oldSelector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' 10 + 11'. +!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:31:31'! +classCategoryOfTestData - self - assertCreation: [ ExtractAsParameter - named: 'newParam' - extractedFromAll: { (4 to: 5). (9 to: 10) } - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {} ] - failsWith: ExtractAsParameter errorMessageNotAllExpressionsToExtractAreEqual - + "I can not call it testDataClassCategory becuase it will be taken as test!! - Hernan" - ! ! + ^self class classCategoryOfTestData! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 18:20:55'! -test38CanExtractManyBlocksIfAreEqual - - | classToRefactor oldSelector refactoring | - - oldSelector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' [10] + [10]'. - - refactoring := ExtractAsParameter - named: 'newParam' - extractedFromAll: { (4 to: 7). (11 to: 14) } - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {}. - - refactoring apply. - - self assert: 'm1: newParam newParam + newParam' equals: (classToRefactor >> #m1:) sourceCode - ! ! +!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/18/2019 19:55:52'! +createClassNamed: aName -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 18:21:22'! -test39CanExtractManyBlocksIfSourceCodeNotEqualButSameAst - - | classToRefactor oldSelector refactoring | - - oldSelector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' [10] + [ 10 ]'. - - refactoring := ExtractAsParameter - named: 'newParam' - extractedFromAll: { (4 to: 7). (11 to: 16) } - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {}. - - refactoring apply. - - self assert: 'm1: newParam newParam + newParam' equals: (classToRefactor >> #m1:) sourceCode - ! ! + ^self + createClassNamed: aName asSymbol "Just in case it is a string... - Hernan" + subclassOf: RefactoringClassTestData + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self classCategoryOfTestData. +! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 18:21:48'! -test40CannotExtractWithoutIntervals - - | classToRefactor oldSelector | - - oldSelector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' 10 + 11'. - - self - assertCreation: [ ExtractAsParameter - named: 'newParam' - extractedFromAll: {} - at: classToRefactor>>oldSelector - implementors: {classToRefactor>>oldSelector} - senders: {} ] - failsWith: ExtractAsParameter errorMessageForNoExpressionToExtract - - - ! ! +!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/18/2019 19:55:56'! +createClassNamed: aName category: aCategory -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 20:32:04'! -test41DetectsAllRangesForLiteral - - | classToRefactor selector intervals | - - selector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: selector, ' 10 + 10'. - - intervals := ExtractAsParameter intervalsForEquivalentExpressionIn: classToRefactor >> selector at: (4 to: 5). + ^self + createClassNamed: aName + subclassOf: RefactoringClassTestData + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: aCategory +! ! - self assert: { (4 to: 5). (9 to: 10) } equals: intervals asArray.! ! +!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/18/2019 19:56:00'! +createClassNamed: aName instanceVariableNames: instanceVariables -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 20:32:28'! -test42DoesNotMixesRangesForDifferentLiterals - - | classToRefactor selector intervals | - - selector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: selector, ' 10 + 100'. - - intervals := ExtractAsParameter intervalsForEquivalentExpressionIn: classToRefactor >> selector at: (4 to: 5). + ^self + createClassNamed: aName + subclassOf: RefactoringClassTestData + instanceVariableNames: instanceVariables + classVariableNames: '' + poolDictionaries: '' + category: self classCategoryOfTestData. - self assert: { (4 to: 5) } equals: intervals asArray.! ! +! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 20:32:48'! -test43DetectsRangesForEquivalentBlocks - - | classToRefactor selector intervals | - - selector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: selector, ' [10] + [ 10 ]'. - - intervals := ExtractAsParameter intervalsForEquivalentExpressionIn: classToRefactor >> selector at: (4 to: 7). +!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:31:49'! +createClassNamed: aName subclassOf: superclass - self assert: { (4 to: 7). (11 to: 16) } equals: intervals asArray.! ! + ^self + createClassNamed: aName + subclassOf: superclass + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self classCategoryOfTestData. +! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 20:33:01'! -test44DetectsRangesForEquivalentMessageSends - - | classToRefactor selector intervals | - - selector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: selector, ' 10 factorial + 10 factorial'. - - intervals := ExtractAsParameter intervalsForEquivalentExpressionIn: classToRefactor >> selector at: (4 to: 15). +!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:31:53'! +createClassNamed: aName subclassOf: superclass category: aCategory - self assert: { (4 to: 15). (19 to: 33) } equals: intervals asArray.! ! + ^self + createClassNamed: aName + subclassOf: superclass + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: aCategory +! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 20:34:32'! -test45DoesNotDetectEquiallySemanticBlocks - - | classToRefactor selector intervals | - - "This is something to improve - Hernan" - - selector := 'm1' asSymbol. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: selector, ' [:p1 | 1 ] + [:p2 | 1]'. - - intervals := ExtractAsParameter intervalsForEquivalentExpressionIn: classToRefactor >> selector at: (4 to: 13). +!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:31:58'! +createClassNamed: aName subclassOf: superclass instanceVariableNames: instanceVariables - self assert: { (4 to: 13) } equals: intervals asArray.! ! + ^self + createClassNamed: aName + subclassOf: superclass + instanceVariableNames: instanceVariables + classVariableNames: '' + poolDictionaries: '' + category: self classCategoryOfTestData. +! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 12/6/2021 11:44:09'! -test46CanExtractMessageSendToClassWithValidParameters +!DynamicallyCodeCreationTest methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:32:28'! +createClassNamed: aName subclassOf: superclass instanceVariableNames: instanceVariables classVariableNames: classVariables poolDictionaries: poolDictionaries category: category - | toExtract | - - toExtract := 'Array with: 1'. + self assert: (Smalltalk classNamed: aName) isNil description: 'Class ', aName, ' already exists'. - self assertCanExtractFrom: toExtract size: toExtract size introducing: '(', toExtract, ')' + classCategories add: category. - ! ! + ^superclass + subclass: aName + instanceVariableNames: instanceVariables + classVariableNames: classVariables + poolDictionaries: poolDictionaries + category: category +! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 12/6/2021 11:44:47'! -test47CanExtractEmptyBraceArray +!DynamicallyCodeCreationTest methodsFor: 'assertions' stamp: 'HAW 12/17/2019 10:32:57'! +assertAllClassCategoriesAreExpectedToBeRemoved - self assertCanExtractAsParameter: '{}'! ! + "I'm using a halt instead of assert or error becuase I want the programmer to see what class category + was not defined in allClassCategoriesOfTestData - Hernan" + (classCategories difference: self allClassCategoriesOfTestData) notEmpty ifTrue: [ self halt: #allClassCategoriesOfTestData asString, ' is not implemented correctly' ] + ! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 12/6/2021 11:46:33'! -test48CanExtractBraceArrayWithExtractableElements +!DynamicallyCodeCreationTest methodsFor: 'assertions' stamp: 'HAW 12/17/2019 10:33:05'! +assertCanRunTest + + self assertNoTestDataClassCategoryExist. + ! ! - self assertCanExtractAsParameter: '{1. {}. Array with: 1}'! ! +!DynamicallyCodeCreationTest methodsFor: 'assertions' stamp: 'HAW 12/17/2019 10:33:17'! +assertNoTestDataClassCategoryExist -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 12/6/2021 11:49:29'! -test49CannotExtractBraceArrayWithNoExtractableElements + self allClassCategoriesOfTestData do: [ :aClassCategory | self denyExistsClassCategory: aClassCategory ] + ! ! - self assertCannotExtractInvalidNodeAsParameter: '{1. self m2 }'! ! +!DynamicallyCodeCreationTest methodsFor: 'assertions' stamp: 'HAW 12/17/2019 10:33:26'! +denyExistsClassCategory: aClassCategory + + self deny: (SystemOrganization hasCategory: aClassCategory) description: 'Can not run test because class category ', aClassCategory, ' already exists'! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 12/6/2021 12:05:47'! -test50CanExtractReferenceToGlobal +!DynamicallyCodeCreationTest methodsFor: 'setup/teardown' stamp: 'HAW 12/17/2019 10:33:36'! +setUp - self assertCanExtractAsParameter: 'Smalltalk'! ! + "If the authorInitials are not set, they will be asked - Hernan" + UISupervisor whenUIinSafeState: [ Utilities authorInitials ]. + "Because I'm using the same system to create classes and removed them with its category at tearDown, I want to be sure + I will not remove something I don't have too - Hernan" + setUpAssertionsPassed := false. + self assertCanRunTest. + setUpAssertionsPassed := true. + + classCategories := Set new.! ! -!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 12/6/2021 12:05:01'! -test51CannotExtractNotExistingGlobalReference +!DynamicallyCodeCreationTest methodsFor: 'setup/teardown' stamp: 'HAW 12/17/2019 10:33:41'! +tearDown - self assertCannotExtractInvalidNodeAsParameter: '__Smalltalk__'! ! + setUpAssertionsPassed ifTrue: [ + self assertAllClassCategoriesAreExpectedToBeRemoved. + SystemOrganization removeSystemCategories: classCategories. + "I commented this becuase it took too much time and the only ones runing these tests + are the ones developing refactorings that know about creating/removing test data category - Hernan + Browser allInstancesDo: [:aBrowser | aBrowser changed: #systemCategoryList ]"]! ! -!ExtractAsParameterTest methodsFor: 'class factory' stamp: 'HAW 9/8/2021 22:00:32'! -classToRefactorName +!DynamicallyCodeCreationTest class methodsFor: 'class factory' stamp: 'HAW 12/17/2019 10:34:07'! +classCategoryOfTestData - ^#ClassToIntroduceParameter! ! + ^ '__Refactoring-TestData__'! ! -!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 9/28/2019 00:49:10'! -assertClassHasDefined: aSelector withBody: newSourceCode +!CompilerTest methodsFor: 'emulating' stamp: 'HAW 12/17/2019 11:00:59'! +correctFrom: start to: end with: aReplacement + + | newSourceCode | + + newSourceCode := sourceCode first: start - 1. + newSourceCode := newSourceCode, aReplacement. + newSourceCode := newSourceCode, (sourceCode copyFrom: end + 1 to: sourceCode size). + + sourceCode := newSourceCode ! ! - self - assert: newSourceCode - equals: (classToRefactor >> aSelector) sourceCode! ! +!CompilerTest methodsFor: 'emulating' stamp: 'cwp 8/25/2009 20:23'! +selectFrom: start to: end + ! ! -!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 6/23/2019 18:30:02'! -assertClassHasDefined: aSelector withBody: newSourceCode inCategory: aCategory +!CompilerTest methodsFor: 'emulating' stamp: 'HAW 6/18/2020 15:27:24'! +selectInvisiblyFrom: start to: stop +! ! - self assertClassHasDefined: aSelector withBody: newSourceCode. - self assert: aCategory equals: (classToRefactor >> aSelector) category! ! +!CompilerTest methodsFor: 'emulating' stamp: 'cwp 8/25/2009 20:22'! +selectionInterval + ^ 1 to: 0! ! -!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 1/12/2020 21:08:55'! -assertExtracting: codeToExtract from: originalCode named: newMessage defines: newCode andUpdates: updatedCode +!CompilerTest methodsFor: 'emulating' stamp: 'HAW 12/17/2019 10:53:27'! +text - | originalSelector category | - category _ #category. - originalSelector _ classToRefactor compile: originalCode classified: category. + ^ sourceCode ! ! - (ExtractMethod - fromInterval: (self intervalOf: codeToExtract locatedIn: originalCode) - of: classToRefactor >> originalSelector - to: newMessage - categorizedAs: category) apply. +!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 15:44:13'! +testCanNotDefineVarsInsideBackTick - self - assertClassHasDefined: originalSelector withBody: updatedCode inCategory: category; - assertClassHasDefined: newMessage selector withBody: newCode inCategory: category! ! + self + should: [ self class compile: 'm1 `|v1| v1 := 1`' ] + raise: SyntaxErrorNotification + withExceptionDo: [ :anError | + self assert: (anError messageText includesSubString: 'expression expected') ]! ! -!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:10:35'! -creationWithMessage: aMessage onInterval: anIntervalToExtract ofMethod: methodToExtractCodeFrom failsWith: aRefactoringExceptionMessageEvaluationBlock errorCondition: anExceptionHandlingCondition +!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 16:08:17'! +testCanNotHaveMoreThanOneExpressionInsideBackTick - self - should: [ - ExtractMethod - fromInterval: anIntervalToExtract - of: methodToExtractCodeFrom - to: aMessage - categorizedAs: Categorizer default ] - raise: anExceptionHandlingCondition - withMessageText: aRefactoringExceptionMessageEvaluationBlock! ! + self + should: [ self class compile: 'm1 `1 factorial. 1 factorial`' ] + raise: SyntaxErrorNotification + withExceptionDo: [ :anError | + self assert: (anError messageText includesSubString: 'backtick expected') ]! ! -!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:13:01'! -creationWithSelectorNamed: aSelectorName onInterval: anIntervalToExtract ofMethod: aMethodToRefactor failsWith: aRefactoringErrorMessageEvaluationBlock errorCondition: anExceptionHandlingCondition +!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 16:09:28'! +testCanNotHaveReturnInsideBackTick - self - creationWithMessage: (Message selector: aSelectorName) - onInterval: anIntervalToExtract - ofMethod: aMethodToRefactor - failsWith: aRefactoringErrorMessageEvaluationBlock - errorCondition: anExceptionHandlingCondition! ! + self + should: [ self class compile: 'm1 `^10`' ] + raise: SyntaxErrorNotification + withExceptionDo: [ :anError | + self assert: (anError messageText includesSubString: 'expression expected') ]! ! -!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:09:14'! -tryingToExtract: someCode from: anExistingSourceCode failsWith: aRefactoringErrorMessageEvaluationBlock +!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 15:41:08'! +testCanNotReferenceSelfInsideBackTick - | existingSelector | - existingSelector := classToRefactor compile: anExistingSourceCode. + self + should: [ self class compile: 'm1 `self`' ] + raise: SyntaxErrorNotification + withExceptionDo: [ :anError | + self assert: (anError messageText includesSubString: + (BacktickNode canNotReferencePseudoVarInsideBacktickErrorDescriptionFor: 'self')) ]! ! - self - creationWithSelectorNamed: #aValidSelector - onInterval: (self intervalOf: someCode locatedIn: anExistingSourceCode) - ofMethod: classToRefactor >> existingSelector - failsWith: aRefactoringErrorMessageEvaluationBlock - errorCondition: self refactoringError! ! +!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 15:41:13'! +testCanNotReferenceSuperInsideBackTick -!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:11:49'! -tryingToExtract: someCode from: anExistingSourceCode using: aMessage failsWith: aRefactoringErrorMessageEvaluationBlock + self + should: [ self class compile: 'm1 `super`' ] + raise: SyntaxErrorNotification + withExceptionDo: [ :anError | + self assert: (anError messageText includesSubString: + (BacktickNode canNotReferencePseudoVarInsideBacktickErrorDescriptionFor: 'super')) ]! ! - | existingSelector | - existingSelector := classToRefactor compile: anExistingSourceCode. +!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 15:45:04'! +testCanNotReferenceTempVarsInsideBackTick - self - creationWithMessage: aMessage - onInterval: (self intervalOf: someCode locatedIn: anExistingSourceCode) - ofMethod: classToRefactor >> existingSelector - failsWith: aRefactoringErrorMessageEvaluationBlock - errorCondition: self refactoringError! ! + self + should: [ self class compile: 'm1 |v1| `v1 := 1`' ] + raise: SyntaxErrorNotification + withExceptionDo: [ :anError | + self assert: (anError messageText includesSubString: 'Can not evaluate code') ]! ! -!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:12:03'! -tryingToExtract: someCode from: anExistingSourceCode using: aMessage raisesWarning: aRefactoringWarningMessageEvaluationBlock +!CompilerTest methodsFor: 'test - backtick' stamp: 'HAW 6/23/2020 15:41:18'! +testCanNotReferenceThisContextInsideBackTick - | existingSelector | - existingSelector := classToRefactor compile: anExistingSourceCode. + self + should: [ self class compile: 'm1 `thisContext`' ] + raise: SyntaxErrorNotification + withExceptionDo: [ :anError | + self assert: (anError messageText includesSubString: + (BacktickNode canNotReferencePseudoVarInsideBacktickErrorDescriptionFor: 'thisContext')) ]! ! - self - creationWithMessage: aMessage - onInterval: (self intervalOf: someCode locatedIn: anExistingSourceCode) - ofMethod: classToRefactor >> existingSelector - failsWith: aRefactoringWarningMessageEvaluationBlock - errorCondition: self refactoringWarning! ! +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'EB 12/20/2019 20:54:26'! +testAddsMoreThanOneUndeclaredVariableCorrectlyInBlock + + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle [ var1 := 1. goo := 1. ^goo + var1 ]'. + + [ testClass compile: sourceCode notifying: self ] + on: UndeclaredVariable + do: [ :anUndeclaredVariable | + anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. + + self assert: 'griffle [ | goo var1 | var1 := 1. goo := 1. ^goo + var1 ]' equals: sourceCode +! ! -!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:09:47'! -tryingToExtractOnInterval: anIntervalToExtract failsWith: aRefactoringErrorMessageEvaluationBlock +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 17:15:47'! +testAddsUndeclaredVariableCorrectlyInBlockWhenNoSpaceBetweenLastOneAndPipe - self - creationWithSelectorNamed: #aValidSelector - onInterval: anIntervalToExtract - ofMethod: self methodToExtractCodeFrom - failsWith: aRefactoringErrorMessageEvaluationBlock - errorCondition: self refactoringError! ! + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle [|var1| var1 := 1.goo := 1.^ goo + var1]'. + + [ testClass compile: sourceCode notifying: self ] + on: UndeclaredVariable + do: [ :anUndeclaredVariable | + anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. + + self assert: 'griffle [|var1 goo | var1 := 1.goo := 1.^ goo + var1]' equals: sourceCode! ! -!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:10:02'! -tryingToExtractWithSelectorNamed: aSelectorName failsWith: aRefactoringErrorMessageEvaluationBlock +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'EB 1/27/2020 00:10:26'! +testAddsUndeclaredVariableCorrectlyInBlockWhenTheresAnArgumentAlready - | originalSource selectorOfOriginalMethod | - originalSource := 'm1 ^ 8'. - selectorOfOriginalMethod := classToRefactor compile: originalSource. + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle [ :var1 | goo := 1.^ goo + var1]'. + + [ testClass compile: sourceCode notifying: self ] + on: UndeclaredVariable + do: [ :anUndeclaredVariable | + anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. + + self assert: 'griffle [ :var1 | | goo | goo := 1.^ goo + var1]' equals: sourceCode! ! - self - creationWithSelectorNamed: aSelectorName - onInterval: (self intervalOf: '8' locatedIn: originalSource) - ofMethod: classToRefactor >> selectorOfOriginalMethod - failsWith: aRefactoringErrorMessageEvaluationBlock - errorCondition: self refactoringError! ! +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'EB 1/27/2020 02:46:02'! +testAddsUndeclaredVariableCorrectlyInBlockWhenTheresArgumentsAndTempDeclarationPipesWithNoTemps -!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:08:00'! -tryingToExtractWithSelectorNamed: aSelectorName raisesWarning: aRefactoringWarningMessageEvaluationBlock + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle [ :var1 | | | goo := 1.^ goo + var1]'. + + [ testClass compile: sourceCode notifying: self ] + on: UndeclaredVariable + do: [ :anUndeclaredVariable | + anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. + + self assert: 'griffle [ :var1 | | goo | goo := 1.^ goo + var1]' equals: sourceCode! ! - | originalSource selectorOfOriginalMethod | - originalSource := 'm1 ^ 8'. - selectorOfOriginalMethod := classToRefactor compile: originalSource. +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'EB 12/20/2019 20:55:29'! +testAddsUndeclaredVariableCorrectlyInMethodAndInBlock - self - creationWithSelectorNamed: aSelectorName - onInterval: (self intervalOf: '8' locatedIn: originalSource) - ofMethod: classToRefactor >> selectorOfOriginalMethod - failsWith: aRefactoringWarningMessageEvaluationBlock - errorCondition: self refactoringWarning - ! ! + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle var1 := 1. [ goo := 1. ^goo + var1 ]'. + + [ testClass compile: sourceCode notifying: self ] + on: UndeclaredVariable + do: [ :anUndeclaredVariable | + anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. + + self assert: 'griffle | var1 |', String newLineString, 'var1 := 1. [ | goo | goo := 1. ^goo + var1 ]' equals: sourceCode! ! -!ExtractMethodTest methodsFor: 'class factory' stamp: 'RNG 4/20/2019 21:31:05'! -classToRefactorName +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 17:15:27'! +testAddsUndeclaredVariableCorrectlyInMethodWhenNoSpaceBetweenLastOneAndPipe - ^ #ClassToExtractMethod! ! + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle |var1| var1 := 1.goo := 1.^ goo + var1'. + + [ testClass compile: sourceCode notifying: self ] + on: UndeclaredVariable + do: [ :anUndeclaredVariable | + anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. + + self assert: 'griffle |var1 goo | var1 := 1.goo := 1.^ goo + var1' equals: sourceCode! ! -!ExtractMethodTest methodsFor: 'method and source code helpers' stamp: 'RNG 5/12/2019 23:21:30'! -compileMethodToExtractCodeFrom +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 17:18:11'! +testAddsUndeclaredVariableInRightBlock + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle [|goo| goo := 1. ^goo ]. [goo1:=1.^ goo1]'. + + [ testClass compile: sourceCode notifying: self ] + on: UndeclaredVariable + do: [ :anUndeclaredVariable | + anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. + + self assert: 'griffle [|goo| goo := 1. ^goo ]. [ | goo1 |goo1:=1.^ goo1]' equals: sourceCode! ! - classToRefactor compile: self sourceCodeOfMethodToExtractCodeFrom! ! +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'EB 1/27/2020 00:31:46'! +testAddsUndeclaredVariableWithAnArgumentAndTempAlreadyInBlock -!ExtractMethodTest methodsFor: 'method and source code helpers' stamp: 'RNG 5/12/2019 23:22:01'! -methodToExtractCodeFrom + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle [ :var1 | | foo | foo := 2. goo := 1.^ goo + var1 + foo ]'. + + [ testClass compile: sourceCode notifying: self ] + on: UndeclaredVariable + do: [ :anUndeclaredVariable | + anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. + + self assert: 'griffle [ :var1 | | foo goo | foo := 2. goo := 1.^ goo + var1 + foo ]' equals: sourceCode! ! - ^ classToRefactor >> self selectorOfMethodToExtractCodeFrom! ! +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:06:40'! +testDoesNotConfusesVariablesWithSameNameOfDifferentBlocksWhenRemoving -!ExtractMethodTest methodsFor: 'method and source code helpers' stamp: 'RNG 5/12/2019 23:25:05'! -selectorOfMethodToExtractCodeFrom + | testClass counter | + + testClass := self createTestClass. + sourceCode := 'griffle [ | goo | ]. [ | goo | ]'. + counter := 0. + [testClass compile: sourceCode notifying: self] + on: UnusedVariable + do: [ :unusedVariable | + self assert: 'goo' equals: unusedVariable name. + counter := counter + 1. + unusedVariable resume: counter = 1 ]. + + self assert: 'griffle [ ]. [ | goo | ]' equals: sourceCode.! ! - ^ #mExtractMethodExample:! ! +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:07:39'! +testDoesNotRemoveUnusedVariableIfSaidSo -!ExtractMethodTest methodsFor: 'method and source code helpers' stamp: 'RNG 9/8/2019 18:40:40'! -sourceCodeOfMethodToExtractCodeFrom + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle | goo |'. + + [testClass compile: sourceCode notifying: self] + on: UnusedVariable + do: [ :unusedVariable | + self assert: 'goo' equals: unusedVariable name. + unusedVariable resume: false ]. + + self assert: 'griffle | goo |' equals: sourceCode.! ! - ^ self selectorOfMethodToExtractCodeFrom, ' anArgument +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:12:44'! +testKeepsVariableDefinitionWhenThereAreUsedTemporaries - - | localVar | - - self m1. - self m2: ''hey true''. - self m3: anArgument , ''^ 21''. - localVar _ Set with: ''hello''. - localVar := #($x $y $z) size and: [ (9) * 3 ]. - ^ localVar + ((4))'! ! + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle | goo a | a := 1. ^a'. + + [testClass compile: sourceCode notifying: self] + on: UnusedVariable + do: [ :unusedVariable | + self assert: 'goo' equals: unusedVariable name. + unusedVariable resume: true ]. + + self assert: 'griffle | a | a := 1. ^a' equals: sourceCode.! ! -!ExtractMethodTest methodsFor: 'refactoring helpers' stamp: 'RNG 5/8/2020 21:06:17'! -intervalOf: aPieceOfSourceCode locatedIn: sourceCode +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:03:46'! +testRemovesUnusedVariablesFromBlocks - | interval | - interval _ sourceCode intervalOfSubCollection: aPieceOfSourceCode. - ^ (interval first to: interval last - 1) asSourceCodeInterval! ! + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle [ | goo | ]'. + + [testClass compile: sourceCode notifying: self] + on: UnusedVariable + do: [ :unusedVariable | + self assert: 'goo' equals: unusedVariable name. + unusedVariable resume: true ]. + + self assert: 'griffle [ ]' equals: sourceCode.! ! -!ExtractMethodTest methodsFor: 'set up' stamp: 'HAW 8/28/2021 17:39:00'! -setUp +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:01:28'! +testRemovesVariableDefinitionWhenNoMoreUnusedTemporaries + + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle | goo |'. + + [testClass compile: sourceCode notifying: self] + on: UnusedVariable + do: [ :unusedVariable | + self assert: 'goo' equals: unusedVariable name. + unusedVariable resume: true ]. + + self assert: 'griffle ' equals: sourceCode.! ! - super setUp. - classToRefactor _ self createClassNamed: self classToRefactorName. - ! ! +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 17:13:33'! +testReusesBlockTempDeclarationWhenEmptyForUndeclaredVariable -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! -test09ExtractingALiteralCreatesANewMethodAndChangesExistingCodeToCallThatNewMethod + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle [ || goo := 1.^ goo ]'. + + [ testClass compile: sourceCode notifying: self ] + on: UndeclaredVariable + do: [ :anUndeclaredVariable | + anUndeclaredVariable resume: anUndeclaredVariable declareBlockTempAction ]. + + self assert: 'griffle [ | goo | goo := 1.^ goo ]' equals: sourceCode! ! - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '4'. - originalCode _ 'm1 ^ ' , codeToExtract. - newMethodCode _ 'm2 +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 17:12:52'! +testReusesMethodTempDeclarationWhenEmptyForUndeclaredVariable - ^ ' , codeToExtract. - updatedCode _ 'm1 ^ self m2'. + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle || goo := 1.^ goo'. + + [ testClass compile: sourceCode notifying: self ] + on: UndeclaredVariable + do: [ :anUndeclaredVariable | + anUndeclaredVariable resume: anUndeclaredVariable declareMethodTempAction ]. + + self assert: 'griffle | goo | goo := 1.^ goo' equals: sourceCode! ! - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 17:12:34'! +testUndeclaredVariableIsSignaledForUndeclaredVariables -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! -test15ExtractingAListOfStatementsCreatesANewMethodWithoutReturn + | testClass | + + testClass := self createTestClass. + + self + should: [ testClass compile: 'griffle ^ goo' notifying: self ] + raise: UndeclaredVariable + withExceptionDo: [ :anUndeclaredVariable | + self assert: 'goo' equals: anUndeclaredVariable name ]! ! - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ 'self m3. - self m4: 5'. - originalCode _ 'm1 ' , codeToExtract. - newMethodCode _ 'm2 +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:09:35'! +testUndefinedVariableIsSignaledForVariablesDefinedButNotInitialized - ', codeToExtract. - updatedCode _ 'm1 self m2'. + | testClass | + + testClass := self createTestClass. - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! + self + should: [testClass compile: 'griffle | goo | ^ goo' notifying: self] + raise: UndefinedVariable + withExceptionDo: [ :anUndefinedVariable | + self assert: 'goo' equals: anUndefinedVariable name ]! ! -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! -test17AStringContainingTheReturnCharacterCanBeExtracted - "this is to make sure the return is found using AST logic, not by text" +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:10:53'! +testUnknownSelectorIsSignalForMessagesSendNotImplemented - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '''^ 3'' size'. - originalCode _ 'm1 ^ ' , codeToExtract. - newMethodCode _ 'm2 + | testClass unknowSelector | + + testClass := self createTestClass. + unknowSelector := 'reallyHopeThisIsntImplementedAnywhere'. + + self + should: [ testClass + compile: 'griffle self ', unknowSelector + notifying: self] + raise: UnknownSelector + withExceptionDo: [ :anUnknowSelector | + self assert: unknowSelector equals: anUnknowSelector name ]! ! - ^ ' , codeToExtract. - updatedCode _ 'm1 ^ self m2'. +!CompilerTest methodsFor: 'tests - exceptions' stamp: 'HAW 12/17/2019 11:11:49'! +testUnusedVariableIsSignaledForUnusedVariables - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! + | testClass | + + testClass := self createTestClass. + sourceCode := 'griffle | goo |'. + + self + should: [testClass compile: sourceCode notifying: self] + raise: UnusedVariable + withExceptionDo: [ :unusedVariable | + self assert: 'goo' equals: unusedVariable name ] +! ! -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! -test18ExtractingAListOfStatementsIncludingDotsRemovesThemAndContinuesWithMethodExtraction +!CompilerTest methodsFor: 'private' stamp: 'HAW 12/17/2019 10:38:10'! +createTestClass + + ^self createClassNamed: #CompilerTestDataClass__! ! - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ ' - self m3. - self m4: 5.'. - originalCode _ 'm1 - ' , codeToExtract. - newMethodCode _ 'm2 +!CompilerTest methodsFor: 'private' stamp: 'cwp 8/25/2009 20:28'! +unusedVariableSource + ^ 'griffle + | goo | + ^ nil'! ! - self m3. - self m4: 5'. - updatedCode _ 'm1 - - self m2.'. +!ChangesTest methodsFor: 'assertions' stamp: 'HAW 11/1/2019 17:04:26'! +assertIsLogged: aString times: stringCount and: aBlock - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! + | logContent startPosition indexOfSubstring | -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! -test19ASelectionContainingAdditionalParenthesesAtTheBeginningAndOrEndCanBeExtracted + logContent := self userChangesForTestsFile textContents. + + startPosition := 1. + stringCount <= 0 + ifTrue: [ self deny: (logContent includesSubString: aString) ] + ifFalse:[ + stringCount timesRepeat: [ + indexOfSubstring := logContent findString: aString startingAt: startPosition. + self assert: indexOfSubstring > 0. + startPosition := indexOfSubstring + 1 ]. + indexOfSubstring := logContent findString: aString startingAt: startPosition. + self assert: 0 equals: indexOfSubstring]. + + aBlock value: logContent value: startPosition. + - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '((42))'. - originalCode _ 'm1 ^ ' , codeToExtract. - newMethodCode _ 'm2 + ! ! - ^ 42'. - updatedCode _ 'm1 ^ ((self m2))'. +!ChangesTest methodsFor: 'assertions' stamp: 'HAW 11/1/2019 17:03:04'! +assertIsLoggedOnce: aString - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! + self assertIsLoggedOnce: aString and: [:logContents :nextPosition | ] ! ! -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! -test20ASelectionContainingALocalVariableIsParameterizedOnTheExtractedMessage +!ChangesTest methodsFor: 'assertions' stamp: 'HAW 11/1/2019 17:02:33'! +assertIsLoggedOnce: aString and: aBlock - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ 'local + 3'. - originalCode _ 'm1 | local | ^ ' , codeToExtract. - newMethodCode _ 'm2: local + self assertIsLogged: aString times: 1 and: aBlock! ! - ^ ' , codeToExtract. - updatedCode _ 'm1 | local | ^ self m2: local'. +!ChangesTest methodsFor: 'assertions' stamp: 'HAW 11/1/2019 17:03:30'! +assertIsLoggedTwice: aString - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2: arguments: #('local')) - defines: newMethodCode andUpdates: updatedCode! ! + self assertIsLogged: aString times: 2 and: [:logContents :nextPosition | ] ! ! -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! -test21ASelectionContainingAdditionalParenthesesOnOneSideCanBeExtractedAndItIsNotTrimmed +!ChangesTest methodsFor: 'user changes' stamp: 'jmv 5/16/2022 09:26:36'! +changeUserChangesFileWhile: aBlock - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '(9) * 3'. - originalCode _ 'm1 ^ ' , codeToExtract. - newMethodCode _ 'm2 + ^ PreferenceNG + withTemporaryValue: self userChangesForTestsFileExtension + of: #userChangesFileNameExtension + do: aBlock.! ! - ^ ' , codeToExtract. - updatedCode _ 'm1 ^ self m2'. +!ChangesTest methodsFor: 'user changes' stamp: 'HAW 11/1/2019 17:07:57'! +scanChangesFromFile - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! + | fileStream changeList | -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! -test22ItIsPossibleToExtractTheLastExpressionOfAMethod + fileStream := Smalltalk defaultUserChangesName asFileEntry readStream. + changeList := ChangeList new scanFile: fileStream from: 0 to: fileStream size. - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ 'localVar + ((4))'. - originalCode _ 'm1 | localVar | ^ ' , codeToExtract. - newMethodCode _ 'm2: localVar + ^ changeList changeList. +! ! - ^ ' , codeToExtract. - updatedCode _ 'm1 | localVar | ^ self m2: localVar'. +!ChangesTest methodsFor: 'user changes' stamp: 'HAW 11/1/2019 17:08:00'! +userChangesForTestsFile - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2: arguments: #('localVar')) - defines: newMethodCode andUpdates: updatedCode! ! + ^self userChangesForTestsFileName asFileEntry! ! -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! -test26ItIsPossibleToExtractAnEntireBlockIncludingALocalAssignment +!ChangesTest methodsFor: 'user changes' stamp: 'HAW 11/1/2019 17:08:04'! +userChangesForTestsFileExtension - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '[ |something| something _ 3 ]'. - originalCode _ 'm1 ^ ' , codeToExtract. - newMethodCode _ 'm2 + ^'.test.changes' ! ! - ^ ' , codeToExtract. - updatedCode _ 'm1 ^ self m2'. +!ChangesTest methodsFor: 'user changes' stamp: 'HAW 11/1/2019 17:08:07'! +userChangesForTestsFileName - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! + ^(FileIOAccessor default baseNameFor: Smalltalk imageName), self userChangesForTestsFileExtension! ! -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! -test27ItIsPossibleToExtractExpressionsWithOptimizedSelectors +!ChangesTest methodsFor: 'setUp/tearDown' stamp: 'HAW 12/17/2019 10:36:27'! +tearDown - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '2 ifNil: [ #boo ] ifNotNil: [ #yay ]'. - originalCode _ 'm1 ^ ' , codeToExtract. - newMethodCode _ 'm2 + self userChangesForTestsFile delete. + super tearDown ! ! - ^ ' , codeToExtract. - updatedCode _ 'm1 ^ self m2'. +!ChangesTest methodsFor: 'test data' stamp: 'HAW 12/17/2019 10:37:01'! +createTestDataClass - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! + ^ self createClassNamed: self testDataClassName + ! ! -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! -test29ExtractingABinaryExpressionToAKeywordMessageIntroducesParenthesesToNotBreakOriginalPrecedence +!ChangesTest methodsFor: 'test data' stamp: 'HAW 11/1/2019 17:08:21'! +testDataClassName - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '2 + arg'. - originalCode _ 'm1: arg ^ ' , codeToExtract , ' * 3'. - newMethodCode _ 'm2: arg + ^ #LogChangesTestClass__! ! - ^ ' , codeToExtract. - updatedCode _ 'm1: arg ^ (self m2: arg) * 3'. +!ChangesTest methodsFor: 'scan tests' stamp: 'HAW 11/1/2019 17:08:27'! +test01ScanNewClassChange - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2: arguments: #('arg')) - defines: newMethodCode andUpdates: updatedCode! ! + | newClass newClassChange | -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:11:36'! -test30ItIsPossibleToExtractAQuotedExpression + self changeUserChangesFileWhile: [ + newClass := self createTestDataClass. + newClassChange := self scanChangesFromFile last. - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '`3 + 4`'. - originalCode _ 'm1 ^ ' , codeToExtract. - newMethodCode _ 'm2 + self assert: newClassChange changeType equals: #classDefinition. + self assert: newClassChange changeClass equals: newClass. + self deny: newClassChange stamp isNil. + self deny: newClassChange isTestClassChange. + ] ! ! - ^ ' , codeToExtract. - updatedCode _ 'm1 ^ self m2'. +!ChangesTest methodsFor: 'scan tests' stamp: 'HAW 11/1/2019 17:08:31'! +test02ScanNewMethodChange - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! + | newMethodChange newClass | -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'HAW 3/30/2020 16:16:37'! -test31ItIsPossibleToExtractExpressionsWithOptimizedSelectorsWhereTheReceiverIsNotASimpleLiteral + self changeUserChangesFileWhile: [ + newClass := self createTestDataClass. + newClass compile: 'm1 ^ 1' classified: 'a-category'. - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '2 factorial ifNotNil: [ #boo ]'. - originalCode _ 'm1 ^ ' , codeToExtract. - newMethodCode _ 'm2 + newMethodChange := self scanChangesFromFile last. - ^ ' , codeToExtract. - updatedCode _ 'm1 ^ self m2'. + self assert: newMethodChange changeType equals: #method. + self assert: newMethodChange methodSelector equals: #m1. + self assert: newMethodChange changeClass equals: newClass. + self assert: newMethodChange prior isNil. + self deny: newMethodChange stamp isNil ] ! ! - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! +!ChangesTest methodsFor: 'scan tests' stamp: 'HAW 11/1/2019 17:08:34'! +test03ScanMethodModifiedChange -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 4/5/2020 23:19:13'! -test32ItIsPossibleToExtractATemporaryDeclarationOfABlockIfItIsNotUsedOutsideOfSelectionInterval + | methodModifiedChange newClass | - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '| a | a _ 3 factorial'. - originalCode _ 'm1 ^ [ ' , codeToExtract , ' ]'. - newMethodCode _ 'm2 + self changeUserChangesFileWhile: [ + newClass := self createTestDataClass. + newClass compile: 'm1 ^ 1' classified: 'a-category'. + newClass compile: 'm1 ^ 2' classified: 'a-category'. - ' , codeToExtract. - updatedCode _ 'm1 ^ [ self m2 ]'. + methodModifiedChange := self scanChangesFromFile last. - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! + self assert: methodModifiedChange changeType equals: #method. + self assert: methodModifiedChange methodSelector equals: #m1. + self assert: methodModifiedChange changeClass equals: newClass. + self deny: methodModifiedChange prior isNil. + self deny: methodModifiedChange stamp isNil ] +! ! -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 4/5/2020 23:19:23'! -test33ItIsPossibleToExtractATemporaryDeclarationIfItIsNotUsedOutsideOfSelectionInterval +!ChangesTest methodsFor: 'scan tests' stamp: 'HAW 11/1/2019 17:08:37'! +test04ScanMethodRemovalChange - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '| a | a _ 3 factorial'. - originalCode _ 'm1 ' , codeToExtract. - newMethodCode _ 'm2 + | methodRemovalChange newClass | - ' , codeToExtract. - updatedCode _ 'm1 self m2'. + self changeUserChangesFileWhile: [ + newClass := self createTestDataClass. + newClass compile: 'm1 ^ 1' classified: 'a-category'. + newClass removeSelector: #m1. - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! + methodRemovalChange := self scanChangesFromFile last. -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 4/14/2020 20:52:00'! -test36ItIsPossibleToExtractACascadeExpression + self assert: methodRemovalChange isMethodDeletion. + self assert: methodRemovalChange methodSelector equals: #m1. + self deny: methodRemovalChange stamp isNil ] +! ! - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '(3 + 2) factorial; yourself'. - originalCode _ 'm1 ^ ' , codeToExtract. - newMethodCode _ 'm2 +!ChangesTest methodsFor: 'scan tests' stamp: 'HAW 11/1/2019 17:08:40'! +test05ScanClassRemovalChange - ^ ' , codeToExtract. - updatedCode _ 'm1 ^ self m2'. + | classRemovalChange newClass | - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! + self changeUserChangesFileWhile: [ + newClass := self createTestDataClass. + newClass removeFromSystem. -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 4/24/2020 20:32:48'! -test37ItIsPossibleATempDeclarationAlongWithABlock + classRemovalChange := self scanChangesFromFile last. - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '| temp | []'. - originalCode _ 'm1 ' , codeToExtract. - newMethodCode _ 'm2 + self assert: classRemovalChange changeType equals: #classRemoval. + self assert: classRemovalChange changeClassName equals: self testDataClassName. + self assert: classRemovalChange isClassDeletion. + self deny: classRemovalChange stamp isNil ] - ' , codeToExtract. - updatedCode _ 'm1 self m2'. +! ! - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! +!ChangesTest methodsFor: 'scan tests' stamp: 'MGD 12/19/2019 19:37:24'! +test06ScanClassRenamedChange -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 5/4/2020 20:08:01'! -test38ItIsPossibleToExtractCodeThatContainsMultipleParenthesisWithSpacesBetweenThem + | classRenamedChange newClass | - | codeToExtract newMethodCode originalCode updatedCode | - codeToExtract _ '( (3 + 4))'. - originalCode _ 'm1 ^ ' , codeToExtract. - newMethodCode _ 'm2 + self changeUserChangesFileWhile: [ + newClass := self createTestDataClass. + newClass rename: #NewTestClass__. - ^ 3 + 4'. - updatedCode _ 'm1 ^ ( (self m2))'. + classRenamedChange := self scanChangesFromFile last. - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! + self assert: classRenamedChange changeType equals: #classRenamed. + self assert: classRenamedChange changeClassName equals: self testDataClassName. + self assert: classRenamedChange newClassName equals: #NewTestClass__. + self deny: classRenamedChange stamp isNil. ] +! ! -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'HAW 9/22/2021 15:01:48'! -test44CanExtractManyStatementsInsideABlock +!ChangesTest methodsFor: 'log tests' stamp: 'HAW 10/5/2020 11:33:10'! +test01AddingAClassShouldBeLogged + " Log format expected: - | codeToExtract newMethodCode originalCode updatedCode | + !!classDefinition: #ClassName category: 'Category' stamp: changeStamp!! + Object subclass: #ClassName + instanceVariableNames: '...' + classVariableNames: '...' + poolDictionaries: '....' + category: 'Category'!! + " + | newClass | - codeToExtract _ 'self m1. - self m2'. - originalCode _ 'm1 true ifTrue: [' , codeToExtract, ']'. - newMethodCode _ 'm2 + self changeUserChangesFileWhile: [ + newClass := self createTestDataClass. - self m1. - self m2'. - updatedCode _ 'm1 true ifTrue: [self m2]'. + self assertIsLoggedOnce: '!!classDefinition: #', self testDataClassName, ' category: ''', self classCategoryOfTestData,''' stamp:'. + self assertIsLoggedOnce: newClass definition ] ! ! - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) - defines: newMethodCode andUpdates: updatedCode! ! +!ChangesTest methodsFor: 'log tests' stamp: 'HAW 11/1/2019 17:08:48'! +test02AddingANewMethodShouldBeLogged + " Log format expected: -!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'HAW 10/18/2021 18:42:26'! -test45CanExtractCodeWithMoreThanOneBlockAndABlockAtTheEndInsideAnotherBlock + !!Class methodsFor: 'category' stamp: 'author stamp'!! + methodSourceCode + " + | aClass | + + self changeUserChangesFileWhile: [ + aClass := self createTestDataClass. + aClass compile: 'm1 ^ 1' classified: 'a-category'. - | codeToExtract newMethodCode originalCode updatedCode | + self assertIsLoggedOnce: '!!', self testDataClassName, ' methodsFor: ''a-category'' stamp:'. + self assertIsLoggedOnce: 'm1 ^ 1'] +! ! + +!ChangesTest methodsFor: 'log tests' stamp: 'HAW 11/1/2019 17:08:50'! +test03ChangingAMethodShouldBeLogged + " Log format expected: + + !!Class methodsFor: 'category' stamp: 'author stamp'!! + newMethodSourceCode + " + | aClass | - codeToExtract _ 'true ifTrue: [ self m1 ]. - true ifTrue: [ self m2 ].'. - originalCode _ 'm1 [true] whileTrue: [ ' , codeToExtract, ' - self m3]'. - newMethodCode _ 'm4 + self changeUserChangesFileWhile: [ + aClass := self createTestDataClass. + aClass compile: 'm1 ^ 1' classified: 'a-category'. + aClass compile: 'm1 ^ 2' classified: 'a-category'. - true ifTrue: [ self m1 ]. - true ifTrue: [ self m2 ]'. - updatedCode _ 'm1 [true] whileTrue: [ self m4. - self m3]'. + self assertIsLoggedTwice: '!!', self testDataClassName , ' methodsFor: ''a-category'' stamp:'. + self assertIsLoggedOnce: 'prior: '. + self assertIsLoggedOnce: 'm1 ^ 2' ] ! ! - self - assertExtracting: codeToExtract from: originalCode named: (Message selector: #m4) - defines: newMethodCode andUpdates: updatedCode! ! +!ChangesTest methodsFor: 'log tests' stamp: 'HAW 11/1/2019 17:08:53'! +test04RemovingAMethodShouldBeLogged + " Log format expected: + + !!methodRemoval: #ClassName selector stamp: changeStamp!! + methodSourceCode + " + | newClass methodSource readStream | + + self changeUserChangesFileWhile: [ + newClass := self createTestDataClass. + newClass compile: 'm1 ^ 1' classified: 'a-category'. + newClass removeSelector: #m1. -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 19:13:15'! -test01NewSelectorShouldNotBeEmpty + self + assertIsLoggedOnce: '!!methodRemoval: ',self testDataClassName, ' #m1 stamp:' + and: [ :logContents :nextPosition | + readStream := ReadStream on: logContents. + readStream position: nextPosition. + readStream nextLine. + methodSource := readStream nextLine. + + self assert: 'm1 ^ 1!!' equals: methodSource ]]! ! - self - tryingToExtractWithSelectorNamed: #'' - failsWith: [ NewSelectorPrecondition newSelectorCanNotBeEmptyErrorMessage ]! ! +!ChangesTest methodsFor: 'log tests' stamp: 'HAW 11/1/2019 17:08:56'! +test05RemovingAClassShouldBeLogged + " Log format expected: -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 19:13:15'! -test02NewSelectorShouldNotContainSeparators + !!classRemoval: #ClassName stamp: changeStamp!! + classDefinitionMessage + " + | newClass definition loggedDefinition readStream | - self - tryingToExtractWithSelectorNamed: #'my selector' - failsWith: [ NewSelectorPrecondition newSelectorCanNotContainSeparatorsErrorMessage ]! ! + self changeUserChangesFileWhile: [ + newClass := self createTestDataClass. + definition := newClass definition. + newClass removeFromSystem. -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 8/28/2021 17:40:41'! -test03ExtractingToSelectorAlreadyDefinedInTheClassRaisesAWarning + self + assertIsLoggedOnce: '!!classRemoval: #', self testDataClassName, ' stamp:' + and: [ :logContents :nextPosition | + readStream := ReadStream on: logContents. + readStream position: nextPosition. + readStream nextLine. + loggedDefinition := readStream upToEnd. + + self assert: definition,'!!' equals: loggedDefinition ]]! ! - self compileMethodToExtractCodeFrom. - self - tryingToExtractWithSelectorNamed: self selectorOfMethodToExtractCodeFrom - raisesWarning: [ - NewSelectorPrecondition - warningMessageFor: self selectorOfMethodToExtractCodeFrom - isAlreadyDefinedIn: classToRefactor ]! ! +!ChangesTest methodsFor: 'log tests' stamp: 'MGD 3/30/2020 17:00:58'! +test06RenamingAClassShouldBeLogged + " Log format expected: -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 19:13:15'! -test04NewSelectorShouldNotStartWithANumber + !!classRenamed: #OldName as: #NewName stamp stamp:!! + Smalltalk renameClassNamed: #OldName as: #NewName + " + | newClass | - self - tryingToExtractWithSelectorNamed: #'2selector' - failsWith: [ NewSelectorPrecondition invalidStartingCharacterOfNewSelectorErrorMessage ]! ! + self changeUserChangesFileWhile: [ + newClass := self createTestDataClass. + newClass rename: #NewTestClass__. -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 19:13:15'! -test05NewUnarySelectorShouldNotStartWithASymbol + self assertIsLoggedOnce: '!!classRenamed: #', self testDataClassName, ' as: #NewTestClass__ stamp:'. + self assertIsLoggedOnce: 'Smalltalk renameClassNamed: #', self testDataClassName, ' as: #NewTestClass__'. + ]! ! - self - tryingToExtractWithSelectorNamed: #- - failsWith: [ NewSelectorPrecondition invalidStartingCharacterOfNewSelectorErrorMessage ]! ! +!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/5/2021 22:02:42'! +test01FindsSelectionOnSourceMethod -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 9/4/2021 21:25:24'! -test06IntervalToExtractIsNotBeforeMethodSourceCodeBoundaries + | sourceMethodName finder methodsToExtractFrom sourceMethod | + + sourceMethodName := classToRefactor compile: 'm1 10'. + + sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. + finder := ExtractMethodReplacementsFinder ofCodeIn: (4 to: 5) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). + finder value. + + self assert: finder hasOneReplacement. + methodsToExtractFrom := finder replacements. + + self assert: 1 equals: methodsToExtractFrom size. + self assert: (4 to: 5) equals: methodsToExtractFrom first intervalToExtract. + self assert: sourceMethod equals: methodsToExtractFrom first methodToExtractFrom.! ! - self compileMethodToExtractCodeFrom. - self - tryingToExtractOnInterval: (-1 to: 2) asSourceCodeInterval - failsWith: [ ExtractMethodNewMethod outOfBoundsSelectionErrorMessage ]! ! +!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/5/2021 22:02:49'! +test02FindsRepetitionsAfterSelection -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 9/4/2021 21:25:40'! -test07IntervalToExtractIsNotAfterMethodSourceCodeBoundaries + | sourceMethodName finder methodsToExtractFrom sourceMethod replacement | + + sourceMethodName := classToRefactor compile: 'm1 10. 10'. + + sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. + finder := ExtractMethodReplacementsFinder ofCodeIn: (4 to: 5) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). + finder value. + + self deny: finder hasOneReplacement. + methodsToExtractFrom := finder replacements. + + self assert: 2 equals: methodsToExtractFrom size. + replacement := methodsToExtractFrom first. + self assert: (4 to: 5) equals: replacement intervalToExtract. + self assert: (replacement isOf: sourceMethod). + + replacement := methodsToExtractFrom second. + self assert: (8 to: 9) equals: replacement intervalToExtract. + self assert: (replacement isOf: sourceMethod).! ! - self compileMethodToExtractCodeFrom. - self - tryingToExtractOnInterval: (1 to: self sourceCodeOfMethodToExtractCodeFrom size + 2) asSourceCodeInterval - failsWith: [ ExtractMethodNewMethod outOfBoundsSelectionErrorMessage ]! ! +!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/5/2021 22:02:58'! +test03FindsRepetitionsBeforeSelection -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/24/2020 21:51:01'! -test08IntervalToExtractShouldNotContainAReturnExpression + | sourceMethodName finder methodsToExtractFrom sourceMethod replacement | + + sourceMethodName := classToRefactor compile: 'm1 10. 10'. + + sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. + finder := ExtractMethodReplacementsFinder ofCodeIn: (8 to: 9) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). + finder value. + + self deny: finder hasOneReplacement. + methodsToExtractFrom := finder replacements. + + self assert: 2 equals: methodsToExtractFrom size. + replacement := methodsToExtractFrom first. + self assert: (4 to: 5) equals: replacement intervalToExtract. + self assert: (replacement isOf: sourceMethod). + + replacement := methodsToExtractFrom second. + self assert: (8 to: 9) equals: replacement intervalToExtract. + self assert: (replacement isOf: sourceMethod). + ! ! - self - tryingToExtract: '^ localVar + ((4))' - from: 'm1 ^ localVar + ((4))' - failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForSourceCodeIncludingAReturnStatement ]! ! +!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/5/2021 22:03:07'! +test04DoesNotIncludeComments -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:48:14'! -test10IntervalToExtractDoesNotContainsPartOfTheOriginalSelector + | sourceMethodName finder methodsToExtractFrom sourceMethod replacement | + + sourceMethodName := classToRefactor compile: 'm1 10. "10"'. + + sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. + finder := ExtractMethodReplacementsFinder ofCodeIn: (4 to: 5) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). + finder value. + + self assert: finder hasOneReplacement. + methodsToExtractFrom := finder replacements. + + self assert: 1 equals: methodsToExtractFrom size. + replacement := methodsToExtractFrom first. + self assert: (4 to: 5) equals: replacement intervalToExtract. + self assert: (replacement isOf: sourceMethod). + + ! ! - self - tryingToExtract: 'm1 ^ 8' - from: 'm1 ^ 8' - failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForSourceCodeContainingInvalidExpression ]! ! +!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/5/2021 22:03:14'! +test05DoesNotIncludeNotExtractableSourceCode -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/24/2020 22:55:57'! -test11IntervalToExtractDoesNotContainsPartOfLocalVariablesDefinition + | sourceMethodName finder methodsToExtractFrom sourceMethod replacement | + + sourceMethodName := classToRefactor compile: 'm1 10. 100'. + + sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. + finder := ExtractMethodReplacementsFinder ofCodeIn: (4 to: 5) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). + finder value. + + self assert: finder hasOneReplacement. + methodsToExtractFrom := finder replacements. + + self assert: 1 equals: methodsToExtractFrom size. + replacement := methodsToExtractFrom first. + self assert: (4 to: 5) equals: replacement intervalToExtract. + self assert: (replacement isOf: sourceMethod).! ! - self - tryingToExtract: '| localVar |' - from: 'm1 | localVar | ^ localVar + 3' - failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForExtractingTemporaryVariablesDefinition ]! ! +!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/8/2021 21:34:35'! +test06FindsRepetitionsInOtherClassMethods -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:48:14'! -test12IntervalToExtractDoesNotContainsPartOfPragmasDefinition + | sourceMethodName finder methodsToExtractFrom sourceMethod replacement | + + sourceMethodName := classToRefactor compile: 'm1 10'. + classToRefactor compile: 'm1b 100+10'. + + sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. + finder := ExtractMethodReplacementsFinder ofCodeIn: (4 to: 5) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). + finder value. + + self deny: finder hasOneReplacement. + methodsToExtractFrom := finder replacements. + + self assert: 2 equals: methodsToExtractFrom size. + replacement := methodsToExtractFrom detect: [ :aReplacement | aReplacement isOf: sourceMethod ]. + self assert: (4 to: 5) equals: replacement intervalToExtract. + + replacement := methodsToExtractFrom detect: [ :aReplacement | aReplacement isOf: (classToRefactor >> #m1b) asMethodReference ]. + self assert: (9 to: 10) equals: replacement intervalToExtract. + + ! ! - self - tryingToExtract: '' - from: 'm1 ' - failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForSourceCodeContainingInvalidExpression ]! ! +!ExtractMethodFinderTest methodsFor: 'tests' stamp: 'HAW 9/8/2021 21:36:53'! +test07FindsRepetitionsInSubclassesMethods -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:48:14'! -test13IntervalToExtractShouldBeAValidSmalltalkExpression + | sourceMethodName finder methodsToExtractFrom sourceMethod replacement subclassToRefactor | + + sourceMethodName := classToRefactor compile: 'm1 10. 10'. + classToRefactor compile: 'm1b 100+10'. + subclassToRefactor := self createClassNamed: self subclassToRefactorName subclassOf: classToRefactor. + subclassToRefactor compile: 'm3 10'. + + sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. + finder := ExtractMethodReplacementsFinder ofCodeIn: (4 to: 5) asSourceCodeInterval at: sourceMethod to: (Message selector: #m2). + finder value. + + self deny: finder hasOneReplacement. + methodsToExtractFrom := finder replacements. + + self assert: 4 equals: methodsToExtractFrom size. + replacement := (methodsToExtractFrom select: [ :aReplacement | aReplacement isOf: sourceMethod ]) first. + self assert: (4 to: 5) equals: replacement intervalToExtract. + + replacement := (methodsToExtractFrom select: [ :aReplacement | aReplacement isOf: sourceMethod ]) second. + self assert: (8 to: 9) equals: replacement intervalToExtract. + + replacement := methodsToExtractFrom detect: [ :aReplacement | aReplacement isOf: (classToRefactor >> #m1b) asMethodReference ]. + self assert: (9 to: 10) equals: replacement intervalToExtract. + + replacement := methodsToExtractFrom detect: [ :aReplacement | aReplacement isOf: (subclassToRefactor >> #m3) asMethodReference ]. + self assert: (4 to: 5) equals: replacement intervalToExtract. + self assert:(replacement isOf: (subclassToRefactor >> #m3) asMethodReference) + ! ! - self - tryingToExtract: '+ ((4))' - from: 'm1 ^ 3 + ((4))' - failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForSourceCodeContainingInvalidExpression ]! ! +!ExtractMethodFinderTest methodsFor: 'setup/teardown' stamp: 'HAW 9/2/2021 18:02:12'! +setUp -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 8/28/2021 17:41:13'! -test14ItIsNotPossibleToExtractTheLeftSideOfAnAssignment + super setUp. + classToRefactor := self createClassNamed: self classToRefactorName! ! - | firstOccurrence secondOccurrence intervalToExtract | +!ExtractMethodFinderTest methodsFor: 'class names' stamp: 'HAW 9/2/2021 16:54:18'! +classToRefactorName - self compileMethodToExtractCodeFrom. - firstOccurrence := self sourceCodeOfMethodToExtractCodeFrom - indexOfSubCollection: 'localVar' startingAt: 1. - secondOccurrence := self sourceCodeOfMethodToExtractCodeFrom - indexOfSubCollection: 'localVar' startingAt: firstOccurrence + 1. - intervalToExtract := secondOccurrence toSelfPlus: 'localVar' size. - self - tryingToExtractOnInterval: intervalToExtract asSourceCodeInterval - failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForExtractingLeftSideOfAssignment ]! ! - -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:48:13'! -test16CanNotExtractPartOfALiteral + ^#ClassToExtractMethod! ! - self - tryingToExtract: 'true' - from: 'm1 ^ ''hey true''' - failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForSourceCodeContainingInvalidExpression ]! ! +!ExtractMethodFinderTest methodsFor: 'class names' stamp: 'HAW 9/4/2021 20:53:12'! +subclassToRefactorName + + ^#SubclassToExtractMethod! ! -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 9/4/2021 21:26:00'! -test23CanNotExtractWithAnInvalidInterval +!RefactoringTest methodsFor: 'assertions' stamp: 'HAW 6/1/2017 19:01:00'! +assertCreation: aCreationBlock failsWith: aMessageTextCreator - self compileMethodToExtractCodeFrom. - self - tryingToExtractOnInterval: (10 to: 9) asSourceCodeInterval - failsWith: [ ExtractMethodNewMethod noSelectionErrorMessage ]! ! + self + should: aCreationBlock + raise: self refactoringError + withMessageText: aMessageTextCreator ! ! -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:26:46'! -test24ItIsNotPossibleToExtractAnIntervalIncludingATemporaryAssignmentExpression +!RefactoringTest methodsFor: 'assertions' stamp: 'HAW 6/1/2017 14:30:58'! +assertCreation: aCreationBlock warnsWith: aMessageTextCreator - self - tryingToExtract: 'localVar _ 8' - from: 'm1 | localVar | localVar _ 8' - failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForExtractedTemporaryAssignmentWithoutItsDeclaration ]! ! + self + should: aCreationBlock + raise: self refactoringWarning + withMessageText: aMessageTextCreator ! ! -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 19:13:15'! -test25NewUnarySelectorShouldNotContainInvalidCharacters +!RefactoringTest methodsFor: 'exceptions' stamp: 'HAW 8/17/2018 16:38:44'! +canNotRefactorDueToReferencesRefactoringError + + ^ Refactoring canNotRefactorDueToReferencesErrorClass - MessageNotUnderstood.! ! - self - tryingToExtractWithSelectorNamed: 'hola)' asSymbol - failsWith: [ NewSelectorPrecondition invalidCharacterInsideNewSelectorErrorMessage ]! ! +!RefactoringTest methodsFor: 'exceptions' stamp: 'HAW 6/3/2017 11:58:26'! +refactoringError -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:30:44'! -test28ItIsNotPossibleToExtractALocalVariableInsideOfItsDeclaration + ^ Refactoring refactoringErrorClass - MessageNotUnderstood.! ! - self - tryingToExtract: 'localVar' - from: 'm1 | localVar | ^ #foo' - failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForExtractingTemporaryVariablesDefinition ]! ! +!RefactoringTest methodsFor: 'exceptions' stamp: 'HAW 6/3/2017 12:05:52'! +refactoringWarning -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 9/4/2021 21:26:21'! -test34TryingToExtractAMethodWithLessArgumentsThanNeededFails + ^ Refactoring refactoringWarningClass - MessageNotUnderstood.! ! - self - tryingToExtract: 'localVar1 + localVar2 + 2' - from: 'm1 | localVar1 localVar2 | ^ localVar1 + localVar2 + 2' - using: (Message selector: #m1: arguments: #('localVar1')) - failsWith: [ ExtractMethodNewMethod wrongNumberOfArgumentsGivenErrorMessage ]! ! +!RefactoringTest methodsFor: 'exceptions' stamp: 'HAW 12/18/2019 16:02:50'! +referencesRefactoringWarning -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 9/4/2021 21:26:39'! -test35TryingToExtractAMethodWithMoreArgumentsThanNeededFails + ^ Refactoring referencesWarningClass - MessageNotUnderstood.! ! - self - tryingToExtract: 'localVar1 + localVar2 + 2' - from: 'm1 | localVar1 localVar2 | ^ localVar1 + localVar2 + 2' - using: (Message selector: #m1:m2:m3: arguments: #('localVar1' 'localVar2' 'localVar3')) - failsWith: [ ExtractMethodNewMethod wrongNumberOfArgumentsGivenErrorMessage ]! ! +!AddInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 6/11/2017 18:12:55'! +classToRefactorName -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 19:13:15'! -test39TryingToExtractToAMethodThatExistsInASuperclassRaisesAWarning + ^#ClassToAddInstVar! ! - self - tryingToExtract: '42' - from: 'm1 ^ 42' - using: (Message selector: #yourself) - raisesWarning: [ NewSelectorPrecondition warningMessageFor: #yourself isAlreadyDefinedIn: Object ]! ! +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:42:17'! +test01NewVariableNameCanNotBeEmpty + + newVariable := ' '. + self + assertCreation: [ AddInstanceVariable named: newVariable to: self class ] + failsWith: [NewInstanceVariablePrecondition newVariableCanNotBeEmptyErrorMessage ] +! ! -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:37:19'! -test40CanNotExtractTemporaryAssignmentWithDeclarationIfTheVariableIsUsedOutsideOfSelectionInterval +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:42:21'! +test02NewVariableNameCanNotContainBlanks + + newVariable := 'a b'. + self + assertCreation: [ AddInstanceVariable named: newVariable to: self class ] + failsWith: [NewInstanceVariablePrecondition errorMessageForInvalidInstanceVariable: newVariable ] - self - tryingToExtract: '|var| var _ 42.' - from: 'm1 |var| var _ 42. ^ var' - failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForTemporaryAssignmentWithUsagesOutsideOfSelectionInterval ]! ! + ! ! -!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 15:35:08'! -test41CannotExtractPartOfMethodSignature +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:42:25'! +test03NewVariableNameCanNotContainInvalidCharacters - self - tryingToExtract: 'arg' - from: 'm1: arg ^ self' - using: (Message selector: #m2: arguments: #('arg')) - failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForExtractingPartOfMethodSignature ]! ! + newVariable := '2a'. + self + assertCreation: [ AddInstanceVariable named: newVariable to: self class ] + failsWith: [NewInstanceVariablePrecondition errorMessageForInvalidInstanceVariable: newVariable ] -!ExtractMethodTest methodsFor: 'tests - many repetitions' stamp: 'HAW 9/5/2021 07:13:44'! -test42ExtractsManyRepetitionsOnSameMethod +! ! - | sourceMethodName finder sourceMethod extractMethod intervalToExtract newMessage | - - sourceMethodName := classToRefactor compile: 'm1 10. 10'. - - sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. - intervalToExtract := (4 to: 5) asSourceCodeInterval. - newMessage := Message selector: #m2. - finder := ExtractMethodReplacementsFinder ofCodeIn: intervalToExtract at: sourceMethod to: newMessage. - finder value. - - extractMethod := ExtractMethod - newDefinition: (ExtractMethodNewMethod - fromInterval: intervalToExtract - of: sourceMethod - to: newMessage - categorizedAs: #something) - replacements: finder replacements. - - extractMethod apply. - - self assert: - 'm2 +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 6/11/2017 18:38:49'! +test04ValidNewVariableNameGetBlanksTrimmed - ^ 10' equals: (classToRefactor >> #m2) sourceCode. - self assert: 'm1 self m2. self m2' equals: (classToRefactor >> #m1) sourceCode. - ! ! + newVariable := ' a '. + + self assert: newVariable withBlanksTrimmed equals: (AddInstanceVariable named: newVariable to: self class) newVariable! ! -!ExtractMethodTest methodsFor: 'tests - many repetitions' stamp: 'HAW 9/5/2021 07:13:44'! -test43ExtractsRepetitionsOnMoreThanOneMethod +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:42:31'! +test05NewVariableNameCanNotBeDefinedInClass - | sourceMethodName finder sourceMethod extractMethod intervalToExtract newMessage | - - sourceMethodName := classToRefactor compile: 'm1 10'. - classToRefactor compile: 'm1b 100+10'. - - sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. - intervalToExtract := (4 to: 5) asSourceCodeInterval. - newMessage := Message selector: #m2. - finder := ExtractMethodReplacementsFinder ofCodeIn: intervalToExtract at: sourceMethod to: newMessage. - finder value. + | classToRefactor | - extractMethod := ExtractMethod - newDefinition: (ExtractMethodNewMethod - fromInterval: intervalToExtract - of: sourceMethod - to: newMessage - categorizedAs: #something) - replacements: finder replacements. - - extractMethod apply. + newVariable := 'a'. + classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: newVariable. - self assert: 'm1 self m2' equals: (classToRefactor >> #m1) sourceCode. - self assert: 'm1b 100+self m2' equals: (classToRefactor >> #m1b) sourceCode. + self + assertCreation: [AddInstanceVariable named: newVariable to: classToRefactor ] + failsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariable: newVariable alreadyDefinedInAll: (Array with: classToRefactor )] ! ! -!ExtractToTemporaryTest methodsFor: 'class factory' stamp: 'RNG 2/22/2020 21:20:46'! -classToRefactorName - - ^ #ClassToDoExtractTemporary! ! - -!ExtractToTemporaryTest methodsFor: 'set up' stamp: 'RNG 3/24/2020 22:30:57'! -setUp - - super setUp. - classToRefactor _ self createClassNamed: self classToRefactorName! ! +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:42:43'! +test06NewVariableNameCanNotBeDefinedInSuperclasses -!ExtractToTemporaryTest methodsFor: 'test helpers' stamp: 'RNG 3/24/2020 22:42:02'! -assertExtracting: codeToExtract from: sourceCodeOfMethodToRefactor toVariableNamed: newVariable updatesTo: sourceCodeAfterRefactoring + | classToRefactorSuperclass classToRefactor | - self - assertExtracting: codeToExtract - from: sourceCodeOfMethodToRefactor - toVariableNamed: newVariable - updatesTo: sourceCodeAfterRefactoring - usingLeftArrowAssignment: true! ! + newVariable := 'a'. + classToRefactorSuperclass := self createClassNamed: #SuperclassWithInstVar instanceVariableNames: newVariable. + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass. + + self + assertCreation: [AddInstanceVariable named: newVariable to: classToRefactor ] + failsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariable: newVariable alreadyDefinedInAll: (Array with: classToRefactorSuperclass)] +! ! -!ExtractToTemporaryTest methodsFor: 'test helpers' stamp: 'jmv 5/16/2022 08:58:01'! -assertExtracting: codeToExtract from: sourceCodeOfMethodToRefactor toVariableNamed: newVariable updatesTo: sourceCodeAfterRefactoring usingLeftArrowAssignment: leftArrowAssignmentPreference +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:42:47'! +test07NewVariableNameCanNotBeDefinedInAnySubclass - | intervalToExtract methodToRefactor actualSourceCodeAfterRefactoring applyRefactoring | - classToRefactor compile: sourceCodeOfMethodToRefactor. - intervalToExtract _ self intervalOf: codeToExtract locatedIn: sourceCodeOfMethodToRefactor. - methodToRefactor _ classToRefactor >> #m1. + | classToRefactor classToRefactorSubclass | + + newVariable := 'a'. + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactorSubclass := self createClassNamed: #SubclassWithInstVar subclassOf: classToRefactor instanceVariableNames: newVariable. + + self + assertCreation: [AddInstanceVariable named: newVariable to: classToRefactor ] + failsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariable: newVariable alreadyDefinedInAll: (Array with: classToRefactorSubclass)] + + ! ! - applyRefactoring := [ actualSourceCodeAfterRefactoring := (ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor) apply ]. +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 12:33:14'! +test08AddCreatesNewInstanceVariable + + | classToRefactor add | - PreferenceNG - withTemporaryValue: leftArrowAssignmentPreference - of: #leftArrowAssignmentsInGeneratedCode - do: applyRefactoring. + newVariable := 'a'. + classToRefactor := self createClassNamed: self classToRefactorName. - self assert: sourceCodeAfterRefactoring equals: actualSourceCodeAfterRefactoring! ! + add := AddInstanceVariable named: newVariable to: classToRefactor. + add apply. + + self assert: (classToRefactor definesInstanceVariableNamed: newVariable). + ! ! -!ExtractToTemporaryTest methodsFor: 'test helpers' stamp: 'RNG 5/8/2020 21:06:24'! -intervalOf: aPieceOfSourceCode locatedIn: sourceCode +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:43:31'! +test09FailsWhenNewVariableEqualsTemporaryVariableOfAMethodInClass - | interval | - interval _ sourceCode intervalOfSubCollection: aPieceOfSourceCode. - ^ (interval first to: interval last - 1) asSourceCodeInterval! ! + | selector classToRefactor | -!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 2/25/2020 16:28:15'! -test12ItIsPossibleToExtractASingleLiteralFromAMethodWithoutAnyTempsOrArguments + newVariable := 'a'. + classToRefactor := self createClassNamed: self classToRefactorName. + selector := #m1. + classToRefactor compile: selector, ' | ', newVariable, ' | ', newVariable, ' := 10.'. + + self + assertCreation: [ AddInstanceVariable named: newVariable to: classToRefactor ] + failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. + ! ! - | sourceCode sourceCodeAfterRefactoring | - sourceCode _ 'm1 +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:43:45'! +test10FailsWhenNewVariableEqualsArgumentOfAMethodInClass - ^ 42'. - sourceCodeAfterRefactoring _ 'm1 + | selector classToRefactor | - | new | - new _ 42. - ^ new'. + newVariable := 'a'. + classToRefactor := self createClassNamed: self classToRefactorName. + selector := #m1:. + classToRefactor compile: selector, newVariable. + + self + assertCreation: [ AddInstanceVariable named: newVariable to: classToRefactor ] + failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. + ! ! - self assertExtracting: '42' from: sourceCode toVariableNamed: 'new' updatesTo: sourceCodeAfterRefactoring! ! +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:44:12'! +test11FailsWhenNewVariableEqualsArgumentOfABlockInAMethodInClass -!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 2/25/2020 16:32:52'! -test13ItIsPossibleToExtractASingleExpressionFromAMethodThatHasAlreadyOtherTemporary + | selector classToRefactor | - | sourceCode sourceCodeAfterRefactoring | - sourceCode _ 'm1 + newVariable := 'a'. + classToRefactor := self createClassNamed: self classToRefactorName. + selector := #m1. + classToRefactor compile: selector, ' [ :', newVariable, ' | ] value: 1'. + + self + assertCreation: [ AddInstanceVariable named: newVariable to: classToRefactor ] + failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. + ! ! - | four | - four _ 4. - ^ four + 2'. - sourceCodeAfterRefactoring _ 'm1 +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:44:28'! +test12FailsWhenNewVariableEqualsTemporaryOfABlockInAMethodInClass - | four two | - four _ 4. - two _ 2. - ^ four + two'. + | selector classToRefactor | - self assertExtracting: '2' from: sourceCode toVariableNamed: 'two' updatesTo: sourceCodeAfterRefactoring! ! + newVariable := 'a'. + classToRefactor := self createClassNamed: self classToRefactorName. + selector := #m1. + classToRefactor compile: selector, ' [ | ', newVariable, ' | ] value'. + + self + assertCreation: [ AddInstanceVariable named: newVariable to: classToRefactor ] + failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. + + ! ! -!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 3/24/2020 18:04:28'! -test14ItIsPossibleToExtractASingleExpressionFromAMethodThatHasAnEmptyTemporariesDeclaration +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:44:46'! +test13FailsWhenNewVariableIsHiddenInAnyMethodOfAnySubclass - | sourceCode sourceCodeAfterRefactoring | - sourceCode _ 'm1 + | selector classToRefactor subclass | - | | - ^ 3 factorial'. - sourceCodeAfterRefactoring _ 'm1 + newVariable := 'a'. + classToRefactor := self createClassNamed: self classToRefactorName. + subclass := self createClassNamed: #SubclassOfClassToRefactor subclassOf: classToRefactor. + selector := #m1. + subclass compile: selector, ' | ', newVariable, ' | '. + + self + assertCreation: [ AddInstanceVariable named: newVariable to: classToRefactor ] + failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (subclass>>selector)) ]. + + ! ! - | f | - f _ 3 factorial. - ^ f'. +!AddInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:43:17'! +test14NewVariableNameCanNotBeAReservedName - self assertExtracting: '3 factorial' from: sourceCode toVariableNamed: 'f' updatesTo: sourceCodeAfterRefactoring! ! + | classToRefactor | -!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 3/24/2020 22:43:08'! -test15ItIsPossibleToExtractCodeAndGenerateAssignmentUsingAnsiAssignmentStyle + classToRefactor := self createClassNamed: self classToRefactorName. + + ClassBuilder reservedNames do: [ :aReservedName | + self + assertCreation: [AddInstanceVariable named: aReservedName to: classToRefactor ] + failsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariableCanNotBeAReservedName: aReservedName ]] + ! ! - | sourceCode sourceCodeAfterRefactoring | - sourceCode _ 'm1 +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! +test01AddingParameterToUnaryMessageAddsColonAndParameter - ^ 42'. - sourceCodeAfterRefactoring _ 'm1 + | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod | + + oldSelector := 'm1' asSymbol. + newSelector := (oldSelector, ':') asSymbol. + newParameter := 'newParam'. + newParameterValue := '1'. + senderSelector := 'sender_m1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString. + classToRefactor compile: senderSelector asString, ' self ', oldSelector asString. + + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue toUnarySelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. + + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). + + newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. + self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). + + self assert: newParameterValue equals: (senderMethod methodNode block statements first arguments first literalValue) printString - | new | - new := 42. - ^ new'. - self assertExtracting: '42' from: sourceCode toVariableNamed: 'new' updatesTo: sourceCodeAfterRefactoring usingLeftArrowAssignment: false! ! +! ! -!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 5/4/2020 19:30:06'! -test16ItIsPossibleToExtractASingleLiteralFromABlockWithoutAnyTempsOrArguments +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! +test02AddingParameterToKeywordMessageAddsNewKeywordAndParameter - | sourceCode sourceCodeAfterRefactoring | - sourceCode _ 'm1 + | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword | + + oldSelector := 'm1:' asSymbol. + newSelectorAddedKeyword := 'm2:' asSymbol. + newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. + newParameter := 'newParam'. + newParameterValue := '2'. + senderSelector := 'sender_m1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: (oldSelector asString, ' oldParam'). + classToRefactor compile: senderSelector asString, ' self ', oldSelector asString, ' 1'. + + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. + + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). + + newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. + self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). + + self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments second literalValue) - ^ [ self m2 ]'. - sourceCodeAfterRefactoring _ 'm1 - ^ [ | new | - new _ self m2 ]'. +! ! - self assertExtracting: 'self m2' from: sourceCode toVariableNamed: 'new' updatesTo: sourceCodeAfterRefactoring! ! +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! +test03AddingParameterToKeywordMessageMultipleSendsInSameMethodSameLiteral -!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 4/12/2020 23:32:37'! -test19ItIsPossibleToExtractAnIntervalWithSomeExtraSpaces + | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword collaboration | + + oldSelector := 'm1:' asSymbol. + newSelectorAddedKeyword := 'm2:' asSymbol. + newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. + newParameter := 'newParam'. + newParameterValue := '2'. + senderSelector := 'sender_m1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: (oldSelector asString, ' oldParam'). + collaboration := ' self ', oldSelector asString, ' 1.'. + classToRefactor compile: senderSelector asString, collaboration, collaboration. + + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. + + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). + + newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. + self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). + + self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments second literalValue) - | sourceCode sourceCodeAfterRefactoring | - sourceCode _ 'm1 - ^ 42'. - sourceCodeAfterRefactoring _ 'm1 +! ! - | new | - new _ 42. - ^ new'. +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! +test04AddingParameterToKeywordMessageWithMessageSendAsLastFormalParameter - self assertExtracting: ' 42' from: sourceCode toVariableNamed: 'new' updatesTo: sourceCodeAfterRefactoring! ! + | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword collaboration | + + oldSelector := 'm1:' asSymbol. + newSelectorAddedKeyword := 'm2:' asSymbol. + newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. + newParameter := 'newParam'. + newParameterValue := '2'. + senderSelector := 'sender_m1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: (oldSelector asString, ' oldParam'). + collaboration := ' self ', oldSelector asString, ' self size.'. + classToRefactor compile: senderSelector asString, collaboration. + + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. + + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). + + newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. + self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). + + self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments second literalValue) -!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 4/24/2020 20:56:58'! -test20ItIsPossibleToExtractAnEmptyBlock - | sourceCode sourceCodeAfterRefactoring | - sourceCode _ 'm1 +! ! - ^ []'. - sourceCodeAfterRefactoring _ 'm1 +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! +test05AddingParameterToKeywordMessageWithBinaryMessageSendAsLastFormalParameter - | new | - new _ []. - ^ new'. + | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword collaboration | + + oldSelector := 'm1:' asSymbol. + newSelectorAddedKeyword := 'm2:' asSymbol. + newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. + newParameter := 'newParam'. + newParameterValue := '2'. + senderSelector := 'sender_m1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: (oldSelector asString, ' oldParam'). + collaboration := ' self ', oldSelector asString, ' self size + 4.'. + classToRefactor compile: senderSelector asString, collaboration. + + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. + + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). + + newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. + self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). + + self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments second literalValue) - self assertExtracting: '[]' from: sourceCode toVariableNamed: 'new' updatesTo: sourceCodeAfterRefactoring! ! -!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 4/25/2020 13:24:55'! -test22ItIsPossibleToExtractACascadeExpression +! ! - | sourceCode sourceCodeAfterRefactoring | - sourceCode _ 'm1 +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! +test06AddingParameterToKeywordMessageWithKeywordMessageSendAsLastFormalParameter - ^ 3 factorial; yourself'. - sourceCodeAfterRefactoring _ 'm1 + | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword collaboration | + + oldSelector := 'm1:' asSymbol. + newSelectorAddedKeyword := 'm2:' asSymbol. + newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. + newParameter := 'newParam'. + newParameterValue := '2'. + senderSelector := 'sender_m1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: (oldSelector asString, ' oldParam'). + collaboration := ' self ', oldSelector asString, ' (self at: 1 put: 2).'. + classToRefactor compile: senderSelector asString, collaboration. + + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. + + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). + + newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. + self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). + + self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments second literalValue) - | new | - new _ 3 factorial; yourself. - ^ new'. - self assertExtracting: '3 factorial; yourself' from: sourceCode toVariableNamed: 'new' updatesTo: sourceCodeAfterRefactoring! ! +! ! -!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 5/4/2020 19:11:34'! -test24WhenExtractingAnEntireStatementItOnlyGeneratesTheVariableAssignment +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! +test07AddingParameterToUnaryMessageChangesReferencesToSelector - | sourceCode sourceCodeAfterRefactoring | - sourceCode _ 'm1 + | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod | + + oldSelector := 'm1' asSymbol. + newSelector := (oldSelector, ':') asSymbol. + newParameter := 'newParam'. + newParameterValue := '1'. + senderSelector := 'sender_m1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString. + classToRefactor compile: senderSelector asString, ' #', oldSelector asString, ' size'. + + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue toUnarySelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. + + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). + + newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. + self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: 0 equals: (senderMethod indexOfLiteral: oldSelector). + self assert: 1 equals: (senderMethod indexOfLiteral: newSelector). + + +! ! - self run'. - sourceCodeAfterRefactoring _ 'm1 +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! +test08AddingParameterToKeywordMessageChangesReferencesToSelector - | action | - action _ self run'. + | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword collaboration | + + oldSelector := 'm1:' asSymbol. + newSelectorAddedKeyword := 'm2:' asSymbol. + newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. + newParameter := 'newParam'. + newParameterValue := '2'. + senderSelector := 'sender_m1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: (oldSelector asString, ' oldParam'). + collaboration := ' #', oldSelector asString, ' size.'. + classToRefactor compile: senderSelector asString, collaboration. + + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. + + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). + + newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. + self assert: (newImplementorMethodNode hasArgumentOrTemporaryNamed: newParameter). + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: 0 equals: (senderMethod indexOfLiteral: oldSelector). + self assert: 1 equals: (senderMethod indexOfLiteral: newSelector). + - self assertExtracting: 'self run' from: sourceCode toVariableNamed: 'action' updatesTo: sourceCodeAfterRefactoring! ! +! ! -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 2/25/2020 15:13:05'! -test01NewVariableCanNotBeEmpty +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 12:24:53'! +test09FailsIfNewParameterValueCanNotBeCompiled - | newVariable sourceCodeToExtract sourceCode intervalToExtract | - newVariable _ ''. - sourceCodeToExtract _ '2'. - sourceCode _ 'm1 ^ 2'. - intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. - classToRefactor compile: sourceCode. + self + assertCreation: [ AddParameter + named: 'newParam' initializedWith: '+' toUnarySelector: thisContext selector + implementors: {thisContext method} senders: {} ] + failsWith: [ AddParameter newParameterValueDoesNotCompileErrorMessage ] +! ! + +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 12:25:16'! +test10FailsIfNewParameterValueIsEmpty + self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: (classToRefactor >> #m1) ] - failsWith: [ NewTemporaryPrecondition errorMessageForEmptyTemporaryVariable ]! ! + assertCreation: [ AddParameter + named: 'newParam' initializedWith: ' ' toUnarySelector: thisContext selector + implementors: {thisContext method} senders: {} ] + failsWith: [ AddParameter newParameterValueCanNotBeEmptyErrorMessage ] +! ! -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 2/25/2020 15:13:01'! -test02NewVariableHasToBeValid +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 16:57:23'! +test11NewParameterNameCanNotBeEmpty - | newVariable sourceCodeToExtract sourceCode intervalToExtract | - newVariable _ 'a b'. - sourceCodeToExtract _ '2'. - sourceCode _ 'm1 ^ ', sourceCodeToExtract. - intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. - classToRefactor compile: sourceCode. + | newParameter | + newParameter := ' '. self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: (classToRefactor >> #m1) ] - failsWith: [ NewTemporaryPrecondition errorMessageForInvalidTemporaryVariable: newVariable ] - ! ! + assertCreation: [ AddParameter + named: newParameter initializedWith: '1' toUnarySelector: thisContext selector + implementors: {thisContext method} senders: {} ] + failsWith: [ AddParameter errorMessageForInvalidParameterName: newParameter withBlanksTrimmed ] + +! ! -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 2/25/2020 15:12:58'! -test03NewVariableNameCanNotBeDefinedInMethod +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 12:34:07'! +test12NewParameterNameCanNotStartWithNumber - | newVariable sourceCodeToExtract sourceCode intervalToExtract methodToRefactor | - newVariable _ 'new'. - sourceCodeToExtract _ '2'. - sourceCode _ 'm1 | ', newVariable, ' | ^ ', sourceCodeToExtract. - intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. - classToRefactor compile: sourceCode. - methodToRefactor _ classToRefactor >> #m1. + | newParameter | + newParameter := '1x'. self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] - failsWith: [ NewTemporaryPrecondition errorMessageForNewTemporaryVariable: newVariable isAlreadyDefinedIn: methodToRefactor methodNode ]! ! + assertCreation: [ AddParameter + named: newParameter initializedWith: '1' toUnarySelector: thisContext selector + implementors: {thisContext method} senders: {} ] + failsWith: [ AddParameter errorMessageForInvalidParameterName: newParameter ] + +! ! -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 5/24/2020 20:01:16'! -test04FailsIfNewTemporaryIsEqualToInstanceVariableInClass +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 12:34:28'! +test13NewParameterNameCanNotContainSpaces - | newVariable sourceCode sourceCodeToExtract methodToRefactor intervalToExtract | - newVariable _ 'new'. - classToRefactor addInstVarName: newVariable. - sourceCodeToExtract _ '78'. - sourceCode _ 'm1 ^ ', sourceCodeToExtract. - intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. - classToRefactor compile: sourceCode. - methodToRefactor _ classToRefactor >> #m1. + | newParameter | + newParameter := 'an Integer'. self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] - failsWith: [ NewTemporaryPrecondition errorMessageFor: newVariable canNotBeNamedDueToInstanceVariableDefinedIn: classToRefactor ]! ! + assertCreation: [ AddParameter + named: newParameter initializedWith: '1' toUnarySelector: thisContext selector + implementors: {thisContext method} senders: {} ] + failsWith: [ AddParameter errorMessageForInvalidParameterName: newParameter ] + +! ! -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 5/24/2020 20:01:16'! -test05FailsIfNewTemporaryIsEqualToInstanceVariableInAnySuperclass +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 15:14:45'! +test14NewParameterCanNotBeDefinedAsInstanceVariableInAnyImplementor - | newVariable sourceCode sourceCodeToExtract methodToRefactor superclassToRefactor intervalToExtract | - newVariable _ 'new'. - superclassToRefactor _ self createClassNamed: #ClassToRefactorSuperclass instanceVariableNames: newVariable. - classToRefactor superclass: superclassToRefactor. - sourceCodeToExtract _ '78'. - sourceCode _ 'm1 ^ ', sourceCodeToExtract. - intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. - classToRefactor compile: sourceCode. - methodToRefactor _ classToRefactor >> #m1. + | classToRefactor oldSelector newParameter | + + oldSelector := 'm1' asSymbol. + newParameter := 'newParam'. + + classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: newParameter. + classToRefactor compile: oldSelector asString. self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] - failsWith: [ NewTemporaryPrecondition errorMessageFor: newVariable canNotBeNamedDueToInstanceVariableDefinedIn: superclassToRefactor ]! ! + assertCreation: [ AddParameter + named: newParameter initializedWith: '1' toUnarySelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {} ] + failsWith: [ AddParameter errorMessageForNewParameter: newParameter definedAsInstanceVariableIn: {classToRefactor} ] + +! ! -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 17:10:14'! -test06SourceCodeToExtractCanNotIncludeReturn +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 9/2/2018 19:59:27'! +test15NewParameterCanNotBeDefinedAsParameterInAnyImplementor - | newVariable sourceCode sourceCodeToExtract intervalToExtract methodToRefactor | - newVariable := 'new'. - sourceCodeToExtract := '^ 1'. - sourceCode := 'm1 ', sourceCodeToExtract. - intervalToExtract := self intervalOf: sourceCodeToExtract locatedIn: sourceCode. - classToRefactor compile: sourceCode. - methodToRefactor := classToRefactor >> #m1. + | classToRefactor oldSelector newParameter implementors | + + oldSelector := 'm1:' asSymbol. + newParameter := 'newParam'. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString, newParameter. + implementors := {classToRefactor>>oldSelector}. self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] - failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForSourceCodeIncludingAReturnStatement ]! ! + assertCreation: [ AddParameter + named: newParameter initializedWith: '1' using: 'm2:' asSymbol toKeywordSelector: oldSelector + implementors: implementors senders: {} ] + failsWith: [ AddParameter errorMessageForNewParameterDefinedAsLocal: newParameter ] + +! ! -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 2/25/2020 15:12:44'! -test07SourceCodeToExtractCanNotBeEmpty +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 12:21:52'! +test16WhenCreatedForUnarySelectorMustBeUnary - | newVariable sourceCode sourceCodeToExtract intervalToExtract methodToRefactor | - newVariable _ 'new'. - sourceCodeToExtract _ ' '. - sourceCode _ 'm1 ^ 1'. - intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. - classToRefactor compile: sourceCode. - methodToRefactor _ classToRefactor >> #m1. - self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] - failsWith: [ ExtractToTemporary errorMessageForSourceCodeToExtractCanNotBeEmpty]! ! + assertCreation: [ AddParameter + named: 'newParam' initializedWith: '1' toUnarySelector: 'm1:' asSymbol + implementors: {thisContext method} senders: {} ] + failsWith: [ AddParameter selectorMustBeUnaryErrorMessage ] + +! ! -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 16:53:38'! -test08SourceCodeToExtractCanNotHaveSyntaxErrors +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 12:27:42'! +test17WhenCreatedForBinarySelectorMustBeBinary - | newVariable sourceCode sourceCodeToExtract intervalToExtract methodToRefactor expectedSyntaxErrorMessage | - newVariable _ 'new'. - sourceCodeToExtract _ '1 +'. - sourceCode _ 'm1 ^ 1 + 3'. - intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. - classToRefactor compile: sourceCode. - methodToRefactor _ classToRefactor >> #m1. - - [ Parser parse: sourceCodeToExtract class: classToRefactor noPattern: true. - self fail. ] - on: SyntaxErrorNotification - do: [ :anError | expectedSyntaxErrorMessage _ anError messageText]. + self + assertCreation: [ AddParameter + named: 'newParam' initializedWith: '1' using: 'm1:' asSymbol toKeywordSelector: thisContext selector + implementors: {thisContext method} senders: {} ] + failsWith: [ AddParameter selectorMustBeKeywordErrorMessage ] +! ! + +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 9/4/2018 20:10:41'! +test18CanNotAddParameterToBinaryKeyword + self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] - failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForSourceCodeToExtractHasSyntaxError: expectedSyntaxErrorMessage ]! ! + assertCreation: [ AddParameter + named: 'newParam' at: 1 addingLast: true initializedWith: '1' to: '+' asSymbol implementing: 'm1:' asSymbol + addingToImplementors: '' addingToSenders: '' + implementors: {} senders: {} ] + failsWith: [ AddParameter selectorCanNotBeBinaryErrorMessage ] + +! ! -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 16:18:15'! -test09SourceCodeToExtractHasToBeOneStatement +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 15:48:13'! +test19AllImplementorsMustImplementOldSelector - | newVariable sourceCode sourceCodeToExtract intervalToExtract methodToRefactor | - newVariable := 'new'. - sourceCodeToExtract := '1+2. 3+4'. - sourceCode := 'm1 ', sourceCodeToExtract. - intervalToExtract := self intervalOf: sourceCodeToExtract locatedIn: sourceCode. - classToRefactor compile: sourceCode. - methodToRefactor := classToRefactor >> #m1. + | implementors | + implementors := {thisContext method}. self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] - failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForSourceCodeToExtractHasToBeOneStatement ]! ! - -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 2/25/2020 15:12:27'! -test10FailsIfIntervalToExtractIsBeforeMethodSourceCodeBoundaries + assertCreation: [ AddParameter + named: 'newParam' initializedWith: '1' toUnarySelector: (thisContext selector, 'x') asSymbol + implementors: implementors senders: {} ] + failsWith: [ AddParameter errorMessageForInvalidImplementors: implementors ] + +! ! - | newVariable sourceCode methodToRefactor | - newVariable _ 'new'. - sourceCode _ 'm1 ^ 1'. - classToRefactor compile: sourceCode. - methodToRefactor _ classToRefactor >> #m1. +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 15:53:37'! +test20AllSendersShouldSendOldSelector + | oldSelector invalidSenders | + + oldSelector := thisContext selector. + invalidSenders := {thisContext method}. self - assertCreation: [ ExtractToTemporary named: newVariable at: (-1 to: 2) from: methodToRefactor ] - failsWith: [ ExtractToTemporary errorMessageForSourceCodeSelectionOutOfBounds ]! ! - -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 2/25/2020 15:22:19'! -test11FailsIfIntervalToExtractIsAfterMethodSourceCodeBoundaries + assertCreation: [ AddParameter + named: 'newParam' initializedWith: '1' toUnarySelector: oldSelector + implementors: {thisContext method} senders: invalidSenders ] + failsWith: [ AddParameter errorMessageForInvalidSenders: invalidSenders of: oldSelector ] + +! ! - | newVariable sourceCode methodToRefactor | - newVariable _ 'new'. - sourceCode _ 'm1 ^ 1'. - classToRefactor compile: sourceCode. - methodToRefactor _ classToRefactor >> #m1. +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 16:24:22'! +test21NewKeywordToAddToOldSelectorCanNotBeUnary self - assertCreation: [ ExtractToTemporary named: newVariable at: (sourceCode size - 1 to: sourceCode size + 2) from: methodToRefactor ] - failsWith: [ ExtractToTemporary errorMessageForSourceCodeSelectionOutOfBounds ]! ! - -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 18:47:52'! -test17CannotExtractPartOfMethodName + assertCreation: [ AddParameter + named: 'newParam' initializedWith: '1' using: 'm1' asSymbol toKeywordSelector: 'm1:' asSymbol + implementors: {} senders: {} ] + failsWith: [ AddParameter notValidKeywordForNewParameterErrorMessage ] + +! ! - | newVariable sourceCode methodToRefactor intervalToExtract sourceCodeToExtract | - newVariable := 'new'. - sourceCode := 'm1 ^ 1'. - classToRefactor compile: sourceCode. - sourceCodeToExtract := 'm1'. - intervalToExtract := self intervalOf: sourceCodeToExtract locatedIn: sourceCode. - methodToRefactor := classToRefactor >> #m1. +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 16:26:55'! +test22NewKeywordToAddToOldSelectorCanNotBeBinary self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] - failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForExtractingPartOfMethodSignature ]! ! - -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 16:20:08'! -test18CannotExtractPartOfMessageSend + assertCreation: [ AddParameter + named: 'newParam' initializedWith: '1' using: '+' asSymbol toKeywordSelector: 'm1:' asSymbol + implementors: {} senders: {} ] + failsWith: [ AddParameter notValidKeywordForNewParameterErrorMessage ] + +! ! - | newVariable sourceCode methodToRefactor intervalToExtract sourceCodeToExtract | - newVariable := 'new'. - sourceCode := 'm1 ^ self m2'. - classToRefactor compile: sourceCode. - sourceCodeToExtract := 'm2'. - intervalToExtract := self intervalOf: sourceCodeToExtract locatedIn: sourceCode. - methodToRefactor := classToRefactor >> #m1. +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 16:27:58'! +test23NewKeywordToAddToOldSelectorCanNotBeKeywordWithMoreThanOneParameter self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] - failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForSourceCodeContainingInvalidExpression ]! ! + assertCreation: [ AddParameter + named: 'newParam' initializedWith: '1' using: 'm1:m2:' asSymbol toKeywordSelector: 'm1:' asSymbol + implementors: {} senders: {} ] + failsWith: [ AddParameter notValidKeywordForNewParameterErrorMessage ] + +! ! -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 16:20:48'! -test21CannotExtractLeftSideOfAssignment +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/24/2018 17:10:04'! +test24AddingParameterToSendersTakeCaresOfSeparators - | newVariable sourceCode methodToRefactor intervalToExtract | - newVariable := 'new'. - sourceCode := 'm1 | existing | existing := 2'. - classToRefactor compile: sourceCode. - intervalToExtract := (17 to: 24) asSourceCodeInterval. "second occurrence of 'existing' variable " - methodToRefactor := classToRefactor >> #m1. + | refactoring classToRefactor oldSelector newSelector newParameter newParameterValue senderSelector | + + oldSelector := 'm1' asSymbol. + newSelector := (oldSelector, ':') asSymbol. + newParameter := 'newParam'. + newParameterValue := '1'. + senderSelector := 'sender_m1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString. + classToRefactor compile: senderSelector asString, ' self ', oldSelector asString, Character newLineCharacter asString,' '. - self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] - failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForSourceCodeContainingInvalidExpression ]! ! + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue toUnarySelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + self shouldnt: [ refactoring apply ] raise: Error. + + ! ! -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 4/26/2020 15:23:20'! -test23CannotUseAReservedNameAsTheNewTemporaryVariable +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 5/24/2019 10:06:10'! +test25IfNewParameterValueIsKeywordMessageSendAddParenthesisToItForUnaryMessages - | intervalToExtract methodToRefactor newVariable sourceCode | + | refactoring classToRefactor oldSelector newParameter newParameterValue senderSelector newSelector senderMethod senderMethodNode senderSourceCode senderSourceRange | + + oldSelector := 'm1' asSymbol. + newSelector := (oldSelector, ':') asSymbol. + newParameter := 'newParam'. + newParameterValue := 'self at: 1'. + senderSelector := 'sender_m1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString. + classToRefactor compile: senderSelector asString, ' self ', oldSelector asString. - ClassBuilder reservedNames do: [ :reservedName | - newVariable := reservedName asString. - sourceCode := 'm1 ^ 2'. - classToRefactor compile: sourceCode. - intervalToExtract := self intervalOf: '2' locatedIn: sourceCode. - methodToRefactor := classToRefactor >> #m1. + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue toUnarySelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: (senderMethod sendsOrRefersTo: newSelector). + + senderMethodNode := senderMethod methodNode. + senderSourceRange := senderMethodNode encoder rangeForNode: senderMethodNode block statements first ifAbsent: [ self fail ]. + senderSourceCode := senderMethodNode sourceText copyFrom: senderSourceRange first to: senderSourceRange last. + self assert: (senderSourceCode endsWith: '(',newParameterValue,')') + + ! ! - self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] - failsWith: [ NewTemporaryPrecondition errorMessageForNewTemporaryVariableCanNotBeAReservedName: newVariable ] ]! ! +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 5/24/2019 10:06:40'! +test26IfNewParameterValueIsKeywordMessageSendAddParenthesisToItForKeywordMessages -!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 18:48:18'! -test25CannotExtractArgumentNamesFromMethodSignature + | refactoring classToRefactor oldSelector newParameter newParameterValue senderSelector newSelector senderMethod newSelectorAddedKeyword senderMethodNode senderSourceCode senderSourceRange | + + oldSelector := 'm1:' asSymbol. + newSelectorAddedKeyword := 'm2:' asSymbol. + newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. + newParameter := 'newParam'. + newParameterValue := 'self at: 1'. + senderSelector := 'sender_m1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString, ' oldParam'. + classToRefactor compile: senderSelector asString, ' self ', oldSelector asString, ' 1'. - | intervalToExtract methodToRefactor newVariable sourceCode | - newVariable := 'new'. - sourceCode := 'm1: arg ^ self'. - classToRefactor compile: sourceCode. - intervalToExtract := self intervalOf: 'arg' locatedIn: sourceCode. - methodToRefactor := classToRefactor >> #m1:. + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: (senderMethod sendsOrRefersTo: newSelector). + + senderMethodNode := senderMethod methodNode. + senderSourceRange := senderMethodNode encoder rangeForNode: senderMethodNode block statements first ifAbsent: [ self fail ]. + senderSourceCode := senderMethodNode sourceText copyFrom: senderSourceRange first to: senderSourceRange last. + self assert: (senderSourceCode endsWith: '(',newParameterValue,')') + + ! ! + +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 8/25/2018 11:23:42'! +test27NewParameterValueCanNotHaveMoreThanOneStatement self - assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] - failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForExtractingPartOfMethodSignature ]! ! + assertCreation: [ AddParameter + named: 'newParameter' initializedWith: 'self m1. self m2.' toUnarySelector: thisContext selector + implementors: {thisContext method} senders: {} ] + failsWith: [ AddParameter newParameterValueCanNotHaveMoreThanOneStatementErrorMessage ]. + + ! ! -!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:01:00'! -test01ChangesTheSuperclassOfTheClassToRefactor +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 5/24/2019 10:07:01'! +test28WhenSenderLastParameterIsABlockAddedParameterIsNotAddedInsideTheBlock - | classToRefactor refactoring oldSuperclass newSuperclass | + | refactoring classToRefactor oldSelector newParameter newParameterValue senderSelector newSelector senderMethod newSelectorAddedKeyword senderMethodNode senderSourceCode senderSourceRange senderFirstParameterValue | + + oldSelector := 'm1:' asSymbol. + newSelectorAddedKeyword := 'm2:' asSymbol. + newSelector := (oldSelector,newSelectorAddedKeyword) asSymbol. + newParameter := 'newParam'. + newParameterValue := '1'. + senderSelector := 'sender_m1' asSymbol. + senderFirstParameterValue := '[ 1 factorial ]'. - classToRefactor := self createClassNamed: #ClassToAddSuperclass. - oldSuperclass := classToRefactor superclass. + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString, ' oldParam'. + classToRefactor compile: senderSelector asString, ' self ', oldSelector asString, senderFirstParameterValue. + + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. - refactoring := InsertSuperclass to: classToRefactor named: #AddedSuperclass. - newSuperclass := refactoring apply. + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: (senderMethod sendsOrRefersTo: newSelector). - self assert: newSuperclass equals: classToRefactor superclass. - self assert: (newSuperclass subclasses includes: classToRefactor). - self assert: oldSuperclass equals: newSuperclass superclass.! ! + senderMethodNode := senderMethod methodNode. + senderSourceRange := senderMethodNode encoder rangeForNode: senderMethodNode block statements first arguments first closureCreationNode ifAbsent: [ self fail ]. + senderSourceCode := senderMethodNode sourceText copyFrom: senderSourceRange first to: senderSourceRange last. + self assert: senderFirstParameterValue equals: senderSourceCode + ! ! -!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:02:51'! -test02ClassToRefactorStructureIsMaintained +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:42:08'! +test29AddingParameterAsFirstOneWorksAsExpected - | classToRefactor refactoring instanceVariables category classVariables poolDictionaries | + | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword | - instanceVariables := 'instVar1 instVar2'. - classVariables := 'ClassVar1 ClassVar2'. - poolDictionaries := 'SharedAAA'. - category := self classCategoryOfTestData. + oldSelector := 'm1:' asSymbol. + newSelectorAddedKeyword := 'm2:' asSymbol. + newSelector := 'm2:m1:' asSymbol. + newParameter := 'newParam'. + newParameterValue := '2'. + senderSelector := 'sender' asSymbol. - [ Smalltalk at: poolDictionaries asSymbol put: Dictionary new. - classToRefactor := self - createClassNamed: #ClassToAddSuperclass - subclassOf: RefactoringClassTestData - instanceVariableNames: instanceVariables - classVariableNames: classVariables - poolDictionaries: poolDictionaries - category: category. + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: 'm1: p1'. + classToRefactor compile: senderSelector asString, ' self m1: 1'. - refactoring := InsertSuperclass to: classToRefactor named: #AddedSuperclass. + refactoring := AddParameter + named: newParameter at: 1 initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. refactoring apply. - self assert: instanceVariables equals: classToRefactor instanceVariablesString. - self assert: classVariables equals: classToRefactor classVariablesString. - self assert: poolDictionaries equals: classToRefactor sharedPoolsString. - self assert: category equals: classToRefactor category ] ensure: [ Smalltalk removeKey: poolDictionaries asSymbol ].! ! - -!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:17:48'! -test03NewSuperclassCategoryIsTheSameAsClassToRefactorCategory - - | classToRefactor refactoring classToRefactorCategory newSuperclass | - - classToRefactorCategory := self classCategoryOfTestData. - classToRefactor := self createClassNamed: #ClassToAddSuperclass category: classToRefactorCategory. + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). - refactoring := InsertSuperclass to: classToRefactor named: #AddedSuperclass. - newSuperclass := refactoring apply. + newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. + self assert: (newImplementorMethodNode arguments at: 1) name equals: newParameter. - self assert: classToRefactorCategory equals: newSuperclass category.! ! - -!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:19:28'! -test04NewSuperclassHasNoVariables + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). + + self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments first literalValue). + self assert: senderMethod sourceCode equals: senderSelector asString, ' self m2: 2 m1: 1'. +! ! - | classToRefactor refactoring classToRefactorCategory newSuperclass | +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:45:09'! +test30AddingParameterInTheMiddleWorksAsExpected - classToRefactorCategory := self classCategoryOfTestData. - classToRefactor := self createClassNamed: #ClassToAddSuperclass category: classToRefactorCategory. + | refactoring classToRefactor oldSelector newSelector newImplementorMethodNode newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword | - refactoring := InsertSuperclass to: classToRefactor named: #AddedSuperclass. - newSuperclass := refactoring apply. + oldSelector := 'm1:m3:' asSymbol. + newSelectorAddedKeyword := 'm2:' asSymbol. + newSelector := 'm1:m2:m3:' asSymbol. + newParameter := 'newParam'. + newParameterValue := '2'. + senderSelector := 'sender' asSymbol. - self assert: newSuperclass instVarNames isEmpty. - self assert: newSuperclass classVarNames isEmpty. - self assert: newSuperclass sharedPools isEmpty.! ! + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: 'm1: p1 m3: p3'. + classToRefactor compile: senderSelector asString, ' self m1: 1 m3: 3'. + + refactoring := AddParameter + named: newParameter at: 2 initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. + + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). + + newImplementorMethodNode := (classToRefactor>>newSelector) methodNode. + self assert: (newImplementorMethodNode arguments at: 2) name equals: newParameter. + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). + + self assert: newParameterValue asNumber equals: (senderMethod methodNode block statements first arguments second literalValue). + self assert: senderMethod sourceCode equals: senderSelector asString, ' self m1: 1 m2: 2 m3: 3'. +! ! -!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:21:16'! -test05NewSuperclassShouldNotExist +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:45:01'! +test31AddingParameterInTheMiddleWithManySendersWorksAsExpected - | classToRefactor existingClass existingClassName | + | refactoring classToRefactor oldSelector newSelector newParameter newParameterValue senderSelector senderMethod newSelectorAddedKeyword | - classToRefactor := self createClassNamed: #ClassToAddSuperclass. - existingClassName := #AlreadyExistingClass. - existingClass := self createClassNamed: existingClassName. + oldSelector := 'm1:m3:' asSymbol. + newSelectorAddedKeyword := 'm2:' asSymbol. + newSelector := 'm1:m2:m3:' asSymbol. + newParameter := 'newParam'. + newParameterValue := '2'. + senderSelector := 'sender' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: 'm1: p1 m3: p3'. + classToRefactor compile: senderSelector asString, ' + self m1: 1 m3: 3. + self + m1: 4 + m3: 6'. + + refactoring := AddParameter + named: newParameter at: 2 initializedWith: newParameterValue using: newSelectorAddedKeyword toKeywordSelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: senderMethod sourceCode equals: senderSelector asString, ' + self m1: 1 m2: 2 m3: 3. self - assertCreation: [ InsertSuperclass to: classToRefactor named: existingClassName ] - failsWith: [ NewClassPrecondition errorMessageForAlreadyExistClassNamed: existingClass name ].! ! + m1: 4 + m2: 2 m3: 6'. +! ! -!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:22:13'! -test06NewSuperclassNameHasToBeASymbol +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:44:50'! +test32IndexCanNotBeLessThanOne + + self + assertCreation: [ + AddParameter + named: 'newParam' + at: 0 + initializedWith: '1' + using: 'm2:' asSymbol + toKeywordSelector: 'm1:' asSymbol + implementors: {} + senders: {} ] + failsWith: [ AddParameter errorMessageForInvalidParameterIndex: 0 for: 1 ]! ! +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:44:43'! +test33IndexCanNotBeBiggerThanNumberOfParametersPlusOne + self - assertCreation: [ InsertSuperclass to: self class named: 'aString' ] - failsWith: [ NewClassPrecondition newNameMustBeSymbolErrorMessage ].! ! + assertCreation: [ + AddParameter + named: 'newParam' + at: 3 + initializedWith: '1' + using: 'm2:' asSymbol + toKeywordSelector: 'm1:' asSymbol + implementors: {} + senders: {} ] + failsWith: [ AddParameter errorMessageForInvalidParameterIndex: 3 for: 1 ]! ! -!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 5/24/2019 10:09:41'! -test07NewSuperclassNameHasToStartWithUppercaseLetter +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:44:36'! +test34IndexMustBeInteger - self - assertCreation: [ InsertSuperclass to: self class named: #_A ] - failsWith: [ NewClassPrecondition newNameMustStartWithRightLetterErrorMessage ].! ! + self + assertCreation: [ + AddParameter + named: 'newParam' + at: 1.5 + initializedWith: '1' + using: 'm2:' asSymbol + toKeywordSelector: 'm1:' asSymbol + implementors: {} + senders: {} ] + failsWith: [ AddParameter errorMessageForInvalidParameterIndex: 1.5 for: 1 ]! ! -!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:22:31'! -test08WhenAppliedToMetaclassWorksAsWithClass +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:44:23'! +test35AddingParameterRetractsInsertionPointWhenAtInsertionPointIsANewLine - | classToRefactor refactoring newSuperclass | - - classToRefactor := self createClassNamed: #ClassToAddSuperclass. + | refactoring classToRefactor oldSelector newParameter newParameterValue senderSelector | - refactoring := InsertSuperclass to: classToRefactor class named: #AddedSuperclass. - newSuperclass := refactoring apply. + oldSelector := 'm1' asSymbol. + newParameter := 'newParam'. + newParameterValue := '1'. + senderSelector := 'sender_m1' asSymbol. - self assert: newSuperclass equals: classToRefactor superclass.! ! + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString, Character newLineCharacter asString, Character newLineCharacter asString. + classToRefactor compile: senderSelector asString, ' self ', oldSelector asString. -!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:22:56'! -test09NewSuperclassNameCanNotBeEmpty + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue toUnarySelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + self shouldnt: [ refactoring apply ] raise: Error. + + ! ! - self - assertCreation: [ InsertSuperclass to: self class named: '' asSymbol ] - failsWith: [ NewClassPrecondition newClassNameCanNotBeEmptyErrorMessage ].! ! +!AddParameterTest methodsFor: 'tests' stamp: 'HAW 1/7/2019 13:44:13'! +test36ParentesisAreAddedToSendersOfUnaryMessage -!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 09:13:27'! -test10NewSuperclassNameCanNotHaveSpaces + self shouldFail: [ | refactoring classToRefactor oldSelector newParameter newParameterValue senderSelector | - self - assertCreation: [ InsertSuperclass to: self class named: 'With spaces' asSymbol ] - failsWith: [ NewClassPrecondition newClassNameCanNotHaveSeparatorsErrorMessage ].! ! - -!MoveToInstanceOrClassMethodTest methodsFor: 'tests' stamp: 'LMY 12/8/2019 18:08:54'! -test01CannotMoveWhenReferencingInstanceVariables + oldSelector := 'm1' asSymbol. + newParameter := 'newParam'. + newParameterValue := '1'. + senderSelector := 'sender_m1' asSymbol. - | classToRefactor selector referencedVariable | - - selector := #newMethod. - referencedVariable := 'a'. + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString. + classToRefactor compile: senderSelector asString, ' self ', oldSelector asString, ', self size'. - classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: referencedVariable. - classToRefactor compile: selector asString,' ^', referencedVariable. + refactoring := AddParameter + named: newParameter initializedWith: newParameterValue toUnarySelector: oldSelector + implementors: {classToRefactor>>oldSelector} senders: {classToRefactor>>senderSelector}. + refactoring apply. - self - assertCreation: [ MoveToInstanceOrClassMethod for: classToRefactor >> selector ] - failsWith: [ MoveToInstanceOrClassMethod referencingInstanceVariablesErrorMessage ] -! ! + self assert: senderSelector asString, ' (self ', oldSelector asString, '), self size' equals: (classToRefactor>>senderSelector) sourceCode + ]! ! -!MoveToInstanceOrClassMethodTest methodsFor: 'tests' stamp: 'LMY 12/8/2019 18:43:15'! -test02CannotMoveToClassWhenLocalVariableIsTheSameAsClassInstanceVariable +!AddParameterTest methodsFor: 'class factory' stamp: 'HAW 8/24/2018 17:20:56'! +classToRefactorName - | classToRefactor selector referencedVariable | - - selector := #newMethod. - referencedVariable := 'a'. + ^#ClassToAddParameter! ! - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor class addInstVarName: referencedVariable. - classToRefactor compile: selector asString, '|', referencedVariable, '|'. - - self - assertCreation: [ MoveToInstanceOrClassMethod for: classToRefactor >> selector ] - failsWith: [ MoveToInstanceOrClassMethod localVariableConflictsWithInstanceVariableErrorMessage ] -! ! +!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:18:58'! +test01CannotChangeSelectorOrderInUnaryMessages -!MoveToInstanceOrClassMethodTest methodsFor: 'tests' stamp: 'LMY 12/8/2019 23:35:40'! -test03CannotMoveToInstanceWhenLocalVariableIsTheSameAsClassInstanceVariable - - | classToRefactor selector referencedVariable | + self + assertCreation: [ ChangeKeywordsSelectorOrder from: #m1 to: #m1 implementors: #() senders: #() ] + failsWith: [ ChangeKeywordsSelectorOrder selectorToChangeIsNotKeywordWithMoreThanOneParameterErrorMessage ]! ! - selector := #newMethod. - referencedVariable := 'a'. +!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:18:58'! +test02CannotChangeSelectorOrderInBinaryMessages - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor addInstVarName: referencedVariable. - classToRefactor class compile: selector asString, '|', referencedVariable, '|'. - - self - assertCreation: [ MoveToInstanceOrClassMethod for: classToRefactor class >> selector ] - failsWith: [ MoveToInstanceOrClassMethod localVariableConflictsWithInstanceVariableErrorMessage ] -! ! + self + assertCreation: [ ChangeKeywordsSelectorOrder from: #+ to: #+ implementors: #() senders: #() ] + failsWith: [ ChangeKeywordsSelectorOrder selectorToChangeIsNotKeywordWithMoreThanOneParameterErrorMessage ]! ! -!MoveToInstanceOrClassMethodTest methodsFor: 'tests' stamp: 'LMY 12/8/2019 23:44:00'! -test04InstanceMethodIsMovedToClassMethod - - | classToRefactor selector moveMethod | +!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 06:18:58'! +test03CannotChangeSelectorOrderInKeywordMessagesWithOneParameterOnly - selector := #newMethod. + self + assertCreation: [ ChangeKeywordsSelectorOrder from: #m1: to: #m1: implementors: #() senders: #() ] + failsWith: [ ChangeKeywordsSelectorOrder selectorToChangeIsNotKeywordWithMoreThanOneParameterErrorMessage ]! ! - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: selector asString. - - moveMethod := MoveToInstanceOrClassMethod for: classToRefactor >> selector. - moveMethod apply. - - self assert: (classToRefactor class includesSelector: selector). - self deny: (classToRefactor includesSelector: selector). -! ! +!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 05:44:03'! +test04ChangesKeywordsOrder -!MoveToInstanceOrClassMethodTest methodsFor: 'tests' stamp: 'LMY 12/8/2019 23:51:21'! -test05ClassMethodIsMovedToInstanceMethod - - | classToRefactor selector moveMethod | + | classToRefactor refactoring oldSelector newSelector | - selector := #newMethod. + oldSelector := #m1:m2:. + newSelector := #m2:m1:. + classToRefactor := self createClassNamed: #ClassToChangeSelectorOrder. + classToRefactor compile: (self selectorAndParametersFor: oldSelector). - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor class compile: selector asString. - - moveMethod := MoveToInstanceOrClassMethod for: classToRefactor class >> selector. - moveMethod apply. - - self assert: (classToRefactor includesSelector: selector). - self deny: (classToRefactor class includesSelector: selector). -! ! + refactoring := ChangeKeywordsSelectorOrder from: oldSelector to: newSelector implementors: { classToRefactor >> oldSelector } senders: #(). + refactoring apply. -!MoveToInstanceOrClassMethodTest methodsFor: 'class factory' stamp: 'LMY 12/8/2019 17:35:59'! -classToRefactorName + self assert: (classToRefactor includesSelector: newSelector). + self deny: (classToRefactor includesSelector: oldSelector)! ! - ^#ClassToMoveMethod! ! +!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 05:52:51'! +test05ChangesParametersOrder -!PushDownInstanceVariableTest methodsFor: 'class factory' stamp: 'MSC 12/21/2019 09:49:48'! -classToRefactorName - ^#ClassToPushInstanceVariableDown.! ! + | classToRefactor refactoring oldSelector newSelector renamedMethod parameters selectorAndParameters | -!PushDownInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:13:23'! -test01AnInstanceVariableDoesNotExistOnClassToFactorCannotBePushedDownToSubclasses - - classToRefactor := self createClassNamed: self classToRefactorName. - - self assertPushDownCreationFailsWith: PushDownInstanceVariable instanceVariableDoesNotExistOnClassToRefactor . - - self deny: (classToRefactor definesInstanceVariableNamed: instanceVariableToPushDown). - classToRefactor subclassesDo: [ :subClass | - self deny: (subClass definesInstanceVariableNamed: instanceVariableToPushDown). - ].! ! + oldSelector := #m1:m2:. + newSelector := #m2:m1:. + classToRefactor := self createClassNamed: #ClassToChangeSelectorOrder. + selectorAndParameters := self selectorAndParametersFor: oldSelector. + classToRefactor compile: selectorAndParameters. -!PushDownInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:10:51'! -test02AnInstanceVariableThatIsAccessedOnClassToRefactorCannotBePushedDownToAllSubclasses + refactoring := ChangeKeywordsSelectorOrder from: oldSelector to: newSelector implementors: { classToRefactor >> oldSelector } senders: #(). + refactoring apply. - | selector | - - selector := #newMethod. - - classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: instanceVariableToPushDown. - classToRefactor compile: selector, '^ ', instanceVariableToPushDown. - - self createClassNamed: #SubclassWithoutInstVarOne subclassOf: classToRefactor. - self createClassNamed: #SubclassWithoutInstVarTwo subclassOf: classToRefactor. - - self assertPushDownCreationFailsWith: (PushDownInstanceVariable - errorMessageForInstanceVariable: instanceVariableToPushDown - isAccessedInMethodsOf: classToRefactor). - - self assert: (classToRefactor definesInstanceVariableNamed: instanceVariableToPushDown). - classToRefactor subclassesDo: [ :subClass | - self deny: (subClass definesInstanceVariableNamed: instanceVariableToPushDown)].! ! + renamedMethod := classToRefactor >> newSelector. + parameters := selectorAndParameters substrings reject: [ :aKeywordOrParameter | oldSelector keywords includes: aKeywordOrParameter ]. + self + assert: (OrderedCollection with: parameters second with: parameters first) + equals: renamedMethod methodNode argumentNames ! ! -!PushDownInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:49:31'! -test03AnInstanceVariableThatIsNotAccessedOnClassToRefactorShouldBePushedDownToAllSubclasses +!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 05:31:03'! +test06NewSelectorMustIncludeOldSelectorKeywords - | pushDown | - - classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: instanceVariableToPushDown. - self createClassNamed: #SubclassWithoutInstVarOne subclassOf: classToRefactor. - self createClassNamed: #SubclassWithoutInstVarTwo subclassOf: classToRefactor. - - pushDown := PushDownInstanceVariable named: instanceVariableToPushDown from: classToRefactor. - pushDown apply. - - self deny: (classToRefactor definesInstanceVariableNamed: instanceVariableToPushDown). - classToRefactor subclassesDo: [ :subClass | - self assert: (subClass definesInstanceVariableNamed: instanceVariableToPushDown). - ].! ! + self + assertCreation: [ ChangeKeywordsSelectorOrder from: #m1:m2: to: #m3:m1: implementors: #() senders: #() ] + failsWith: [ ChangeKeywordsSelectorOrder newSelectorDoesNotIncludeOldSelectorKeywordsErrorMessage ] + ! ! -!PushDownInstanceVariableTest methodsFor: 'setup' stamp: 'MSC 12/21/2019 22:01:42'! -setUp +!ChangeKeywordsSelectorOrderTest methodsFor: 'tests' stamp: 'HAW 3/17/2019 05:52:00'! +test07ChangesKeywordsAndParametersOrderForMoreThanTwoKeywords - super setUp. - - instanceVariableToPushDown := 'a'.! ! + | classToRefactor refactoring renamedMethod oldSelector newSelector selectorAndParameters parameters | -!PushDownInstanceVariableTest methodsFor: 'assertions' stamp: 'HAW 12/26/2019 19:41:11'! -assertPushDownCreationFailsWith: aMessageTextCreator + oldSelector := #m1:m2:m3:. + newSelector := #m2:m3:m1:. + classToRefactor := self createClassNamed: #ClassToChangeSelectorOrder. + selectorAndParameters := self selectorAndParametersFor: oldSelector. + classToRefactor compile: selectorAndParameters. + + refactoring := ChangeKeywordsSelectorOrder from: oldSelector to: newSelector implementors: { classToRefactor >> oldSelector } senders: #(). + refactoring apply. + renamedMethod := classToRefactor >> newSelector. + parameters := selectorAndParameters substrings reject: [ :aKeywordOrParameter | oldSelector keywords includes: aKeywordOrParameter ]. self - assertCreation: [ PushDownInstanceVariable named: instanceVariableToPushDown from: classToRefactor. ] - failsWith: aMessageTextCreator ! ! + assert: (OrderedCollection with: parameters second with: parameters third with: parameters first) + equals: renamedMethod methodNode argumentNames ! ! -!PushDownMethodTest methodsFor: 'tests' stamp: 'fz 12/4/2019 14:09:00'! -test01AnEmptyMethodOnClassToRefactorShouldBePushedDownToSubclasses +!ChangeKeywordsSelectorOrderTest methodsFor: 'source code creation' stamp: 'HAW 3/17/2019 05:43:44'! +selectorAndParametersFor: aKeywordSelector - | classToRefactorSubclass1 classToRefactorSubclass2 classToRefactor selector push | + ^String streamContents: [ :stream | + aKeywordSelector keywords + withIndexDo: [ :aKeyword :index | + stream + nextPutAll: aKeyword; + space; + nextPut: $p; + print: index ] + separatedBy: [ stream space ]] + ! ! - selector := #newMethod. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactorSubclass1 := self createClassNamed: #Subclass1 subclassOf: classToRefactor. - classToRefactorSubclass2 := self createClassNamed: #Subclass2 subclassOf: classToRefactor. - - classToRefactor compile: selector asString. - - push := PushDownMethod for: classToRefactor >> selector. - push apply. - - self assert: (classToRefactorSubclass1 includesSelector: selector). - self assert: (classToRefactorSubclass2 includesSelector: selector). - self deny: (classToRefactor includesSelector: selector). - - ! ! +!ExtractAsParameterTest methodsFor: 'assertions' stamp: 'HAW 9/22/2021 16:02:51'! +assertCanExtractAsParameter: toExtract -!PushDownMethodTest methodsFor: 'tests' stamp: 'HAW 12/14/2019 11:23:35'! -test02AMethodTemporaryVarDeclaredAsInstVarOnASubclassCanNotBePushedDownToSubclasses - | classToRefactorSubclass1 classToRefactorSubclass2 classToRefactor selector newVariable | + self assertCanExtractFrom: toExtract size: toExtract size introducing: toExtract! ! + +!ExtractAsParameterTest methodsFor: 'assertions' stamp: 'HAW 9/22/2021 15:11:43'! +assertCanExtractFrom: sourceCode interval: interval introducing: toIntroduced + + | refactoring classToRefactor oldSelector newSelector newImplementorSourceCode newParameter senderSelector senderMethod | + + oldSelector := 'm1' asSymbol. + newSelector := (oldSelector, ':') asSymbol. + newParameter := 'newParam'. + senderSelector := 'sender_m1' asSymbol. - selector := #newMethod. - newVariable := 'a'. - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactorSubclass1 := self createClassNamed: #Subclass1 subclassOf: classToRefactor. - classToRefactorSubclass2 := self createClassNamed: #Subclass2 subclassOf: classToRefactor instanceVariableNames: newVariable. + classToRefactor compile: oldSelector asString, ' ', sourceCode. + classToRefactor compile: senderSelector asString, ' self ', oldSelector asString. - classToRefactor compile: selector, '|', newVariable, '|'. - - self - assertCreation: [ PushDownMethod for: classToRefactor >> selector ] - failsWith: [ PushDownMethod errorMessageCanNotPushDownWithShadowedInstVarsOf: - {classToRefactorSubclass2 -> {newVariable }} asDictionary ]. - - self deny: (classToRefactorSubclass1 includesSelector: selector). - self deny: (classToRefactorSubclass2 includesSelector: selector). - self assert: (classToRefactor includesSelector: selector).! ! - -!PushDownMethodTest methodsFor: 'tests' stamp: 'HAW 12/14/2019 11:24:14'! -test03AMethodArgumentDeclaredAsInstVarOnASubclassCanNotBePushedDownToSubclasses - | classToRefactorSubclass1 classToRefactorSubclass2 classToRefactor selector newVariable | + refactoring := ExtractAsParameter + named: newParameter + extractedFrom: interval + 3 + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} + senders: {classToRefactor>>senderSelector}. + refactoring apply. - selector := #newMethod:. - newVariable := 'a'. - - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactorSubclass1 := self createClassNamed: #Subclass1 subclassOf: classToRefactor. - classToRefactorSubclass2 := self createClassNamed: #Subclass2 subclassOf: classToRefactor instanceVariableNames: newVariable. + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). - classToRefactor compile: selector, newVariable. - - self - assertCreation: [ PushDownMethod for: classToRefactor >> selector ] - failsWith: [ PushDownMethod errorMessageCanNotPushDownWithShadowedInstVarsOf: - {classToRefactorSubclass2 -> {newVariable }} asDictionary]. - - self deny: (classToRefactorSubclass1 includesSelector: selector). - self deny: (classToRefactorSubclass2 includesSelector: selector). - self assert: (classToRefactor includesSelector: selector).! ! + newImplementorSourceCode := (classToRefactor>>newSelector) sourceCode. + self assert: newSelector, ' ', newParameter, ' ', (sourceCode first: interval first - 1), newParameter, (sourceCode last: sourceCode size - interval last) equals: newImplementorSourceCode. + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: senderSelector asString, ' self ', newSelector asString, ' ', toIntroduced equals: senderMethod sourceCode! ! -!PushDownMethodTest methodsFor: 'tests' stamp: 'fz 12/4/2019 14:58:23'! -test04AMethodAccessesClassToRefactorInstVarShouldBePushedDownToSubclasses - | classToRefactorSubclass1 classToRefactorSubclass2 classToRefactor newVariable selector push | +!ExtractAsParameterTest methodsFor: 'assertions' stamp: 'HAW 9/22/2021 11:51:22'! +assertCanExtractFrom: sourceCode size: toExtractSize introducing: toIntroduced - selector := #newMethod. - newVariable := 'a'. - - classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: newVariable. - classToRefactorSubclass1 := self createClassNamed: #Subclass1 subclassOf: classToRefactor. - classToRefactorSubclass2 := self createClassNamed: #Subclass2 subclassOf: classToRefactor. - - classToRefactor compile: selector, '^ 1 + ', newVariable. - - push := PushDownMethod for: classToRefactor >> selector. - push apply. - - self assert: (classToRefactorSubclass1 includesSelector: selector). - self assert: (classToRefactorSubclass2 includesSelector: selector). - self deny: (classToRefactor includesSelector: selector).! ! + self assertCanExtractFrom: sourceCode interval: (1 to: toExtractSize) introducing: toIntroduced ! ! -!PushDownMethodTest methodsFor: 'tests' stamp: 'fz 12/4/2019 14:58:27'! -test05AMethodWritesClassToRefactorInstVarShouldBePushedDownToSubclasses - | classToRefactorSubclass1 classToRefactorSubclass2 classToRefactor newVariable selector push | +!ExtractAsParameterTest methodsFor: 'assertions' stamp: 'HAW 9/22/2021 16:03:34'! +assertCannotExtractAsParameter: newParameterValue withErrorMessage: anErrorMessage - selector := #newMethod. - newVariable := 'a'. - - classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: newVariable. - classToRefactorSubclass1 := self createClassNamed: #Subclass1 subclassOf: classToRefactor. - classToRefactorSubclass2 := self createClassNamed: #Subclass2 subclassOf: classToRefactor. + | classToRefactor oldSelector | - classToRefactor compile: selector, ' a = 1'. - - push := PushDownMethod for: classToRefactor >> selector. - push apply. - - self assert: (classToRefactorSubclass1 includesSelector: selector). - self assert: (classToRefactorSubclass2 includesSelector: selector). - self deny: (classToRefactor includesSelector: selector).! ! - -!PushDownMethodTest methodsFor: 'tests' stamp: 'HAW 12/14/2019 11:24:59'! -test06AMethodInClassToRefactorExistsInSubClassesShouldOverrideTheExistingSubClassesMethod + oldSelector := 'm1' asSymbol. - | classToRefactor classToRefactorSubclass newVariable selector subclassMethodContent | + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString, ' ', newParameterValue. - newVariable := 'a'. - selector := #newMethod. - subclassMethodContent := selector, ' - ^ 2 + ', newVariable, '.'. + self + assertCreation: [ ExtractAsParameter + named: 'newParam' + extractedFrom: (4 to: 3+newParameterValue size) + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} + senders: {} ] + failsWith: anErrorMessage ! ! - classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: newVariable. - classToRefactor compile: subclassMethodContent. - - classToRefactorSubclass := self createClassNamed: #Subclass subclassOf: classToRefactor. - classToRefactorSubclass compile: selector, '^ 1 + ', newVariable. +!ExtractAsParameterTest methodsFor: 'assertions' stamp: 'HAW 9/22/2021 16:06:03'! +assertCannotExtractInvalidNodeAsParameter: newParameterValue self - assertCreation: [ PushDownMethod for: classToRefactor >> selector ] - warnsWith: [ PushDownMethod warningMesssageForMessageAlreadyImplementedIn: { classToRefactorSubclass } ]. - - self assert: (classToRefactorSubclass includesSelector: selector). - self assert: (classToRefactor includesSelector: selector).! ! + assertCannotExtractAsParameter: newParameterValue + withErrorMessage: ExtractAsParameter errorMessageForInvalidExpressionToExtractAsParameter! ! -!PushDownMethodTest methodsFor: 'class factory' stamp: 'fz 12/4/2019 14:05:35'! -classToRefactorName +!ExtractAsParameterTest methodsFor: 'assertions' stamp: 'HAW 9/22/2021 16:05:39'! +assertCannotExtractInvalidSelectionAsParameter: newParameterValue - ^#ClassToPushMethodDown! ! + self + assertCannotExtractAsParameter: newParameterValue + withErrorMessage: ExtractAsParameter errorMessageForInvalidSelection ! ! -!PushUpInstanceVariableTest methodsFor: 'class factory' stamp: 'MSC 12/15/2019 12:44:48'! -classToRefactorName - ^#ClassToPushInstanceVariableUp.! ! +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:07:02'! +test01CanExtractLiterals -!PushUpInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:18:51'! -test01AnInstanceVariableThatIsNotUsedOnClassToRefactorShouldBePushedUpToSuperclass + self assertCanExtractAsParameter: '1' +! ! - | pushUp | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:07:26'! +test02CannotExtract_self + + self assertCannotExtractInvalidNodeAsParameter: 'self'. - classToRefactorSuperClass := self createClassNamed: #SuperclassWithoutInstVar. - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperClass instanceVariableNames: instanceVariableToPushUp. + ! ! - pushUp := PushUpInstanceVariable named: instanceVariableToPushUp from: classToRefactor. - pushUp apply. +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:08:15'! +test03CannotExtract_super + + self assertCannotExtractInvalidNodeAsParameter: 'super'. - self assert: (classToRefactorSuperClass definesInstanceVariableNamed: instanceVariableToPushUp). - classToRefactorSuperClass subclassesDo: [ :subClass | - self deny: (subClass definesInstanceVariableNamed: instanceVariableToPushUp) - ].! ! + ! ! -!PushUpInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:18:52'! -test02AnInstanceVariableOnMultipleSubclassesShouldBeRemovedFromAllSubclassesAndPushedUpToSuperClass +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:09:04'! +test04CannotExtract_thisContext - | pushUp | - - classToRefactorSuperClass := self createClassNamed: #SuperclassWithoutInstVar. - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperClass instanceVariableNames: instanceVariableToPushUp. - self createClassNamed: #AnoterSubClassWithInstVar subclassOf: classToRefactorSuperClass instanceVariableNames: instanceVariableToPushUp. - - pushUp := PushUpInstanceVariable named: instanceVariableToPushUp from: classToRefactor. - pushUp apply. + self assertCannotExtractInvalidNodeAsParameter: 'thisContext'. - self assert: (classToRefactorSuperClass definesInstanceVariableNamed: instanceVariableToPushUp). - classToRefactorSuperClass subclassesDo: [ :subClass | - self deny: (subClass definesInstanceVariableNamed: instanceVariableToPushUp) - ].! ! + ! ! -!PushUpInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:13:23'! -test03AnInstanceVariableDoesNotExistOnClassToRefactorCannotBePushedUp +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:08:57'! +test05CanExtractMessageSendToLiteralWithLiterals + + self assertCanExtractAsParameter: '1 + 1'. - classToRefactor := self createClassNamed: self classToRefactorName. + ! ! + +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:09:15'! +test06CanExtract_true + + self assertCanExtractAsParameter: 'true'! ! + +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:09:30'! +test07CannotExtract_comment + + self assertCannotExtractInvalidSelectionAsParameter: '"comment"'. - self assertPushUpCreationFailsWith: PushUpInstanceVariable instanceVariableDoesNotExistOnClassToRefactor. + ! ! + +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:09:52'! +test08CanExtractSelectionWithSeparators + + self assertCanExtractFrom: ' 10 ' size: 4 introducing: '10' - self deny: (classToRefactor definesInstanceVariableNamed: instanceVariableToPushUp).! ! + ! ! -!PushUpInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:34:42'! -test04AnInstanceVariableThatIsUsedOnSuperClassAsTemporaryVariableCannotBePushedUp +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:10:22'! +test09RemovesTrailingDotsFromSelection - | selector | + | refactoring classToRefactor oldSelector newSelector newImplementorSourceCode newParameter senderSelector senderMethod toExtract | - selector := #newMethod. + oldSelector := 'm1' asSymbol. + newSelector := (oldSelector, ':') asSymbol. + newParameter := 'newParam'. + senderSelector := 'sender_m1' asSymbol. + toExtract := '1.'. - classToRefactorSuperClass := self createClassNamed: #SuperclassWithVariableAsTemporaryVariable. - classToRefactorSuperClass compile: selector, '| ' , instanceVariableToPushUp , ' |'. + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString, ' ', toExtract, ' self printString'. + classToRefactor compile: senderSelector asString, ' self ', oldSelector asString. - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperClass instanceVariableNames: instanceVariableToPushUp. + refactoring := ExtractAsParameter + named: newParameter + extractedFrom: (4 to: 5) + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} + senders: {classToRefactor>>senderSelector}. + refactoring apply. - self assertPushUpCreationFailsWith: (PushUpInstanceVariable - errorMessageForInstanceVariable: instanceVariableToPushUp - isDefinedInMethodsOf: classToRefactorSuperClass). + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). - self deny: (classToRefactorSuperClass definesInstanceVariableNamed: instanceVariableToPushUp). - self assert: (classToRefactor definesInstanceVariableNamed: instanceVariableToPushUp).! ! - -!PushUpInstanceVariableTest methodsFor: 'setup' stamp: 'MSC 12/21/2019 22:12:16'! -setUp - - super setUp. + newImplementorSourceCode := (classToRefactor>>newSelector) sourceCode. + self assert: newSelector, ' ', newParameter, ' ', newParameter, '. self printString' equals: newImplementorSourceCode. - instanceVariableToPushUp := 'a'.! ! - -!PushUpInstanceVariableTest methodsFor: 'assertions' stamp: 'HAW 12/26/2019 20:18:51'! -assertPushUpCreationFailsWith: aMessageTextCreator - - self - assertCreation: [ PushUpInstanceVariable named: instanceVariableToPushUp from: classToRefactor. ] - failsWith: aMessageTextCreator.! ! - -!PushUpMethodTest methodsFor: 'tests' stamp: 'MSC 11/12/2019 11:47:47'! -test01AnEmptyMethodOnClassToRefactorShouldBePushedUpToSuperclass + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: senderSelector asString, ' self ', newSelector asString, ' 1' equals: senderMethod sourceCode! ! - | classToRefactorSuperclass classToRefactor selector push | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:10:35'! +test10CanExtractWithParenthesis - selector := #newMethod. - - classToRefactorSuperclass := self createClassNamed: #Superclass. - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass. - classToRefactor compile: selector asString. - - push := PushUpMethod for: classToRefactor >> selector. - push apply. - - self assert: (classToRefactorSuperclass includesSelector: selector). - self deny: (classToRefactor includesSelector: selector). + self assertCanExtractFrom: '(1)' size: 3 introducing: '1' ! ! -!PushUpMethodTest methodsFor: 'tests' stamp: 'MSC 11/12/2019 11:47:51'! -test02AMethodAccessesClassToRefactorInstVarCanNotBePushedUpToSuperclass - - | classToRefactorSuperclass classToRefactor selector newVariable | - - newVariable := 'a'. - selector := #newMethod. - - classToRefactorSuperclass := self createClassNamed: #Superclass. +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:10:45'! +test11CanExtract_symbol - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass instanceVariableNames: newVariable. - classToRefactor compile: selector, '^ 1 + ', newVariable. + self assertCanExtractAsParameter: '#assert:'! ! - self - assertCreation: [ PushUpMethod for: classToRefactor >> selector ] - failsWith: [ PushUpMethod errorMessageForMethodCannotAccessInstanceVariable ]. - - self deny: (classToRefactorSuperclass includesSelector: selector). - self assert: (classToRefactor includesSelector: selector).! ! +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:10:55'! +test12CanExtract_false -!PushUpMethodTest methodsFor: 'tests' stamp: 'MSC 11/12/2019 11:47:54'! -test03AMethodWritesClassToRefactorInstVarCanNotBePushedUpToSuperclass + self assertCanExtractAsParameter: 'false'! ! - | classToRefactorSuperclass classToRefactor selector newVariable | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:11:03'! +test13CanExtract_nil - newVariable := 'a'. - selector := #newMethod. - - classToRefactorSuperclass := self createClassNamed: #Superclass. + self assertCanExtractAsParameter: 'nil'! ! - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass instanceVariableNames: newVariable. - classToRefactor compile: selector, ' a = 1'. +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:11:34'! +test14CanExtactFromKeywordSelector - self - assertCreation: [ PushUpMethod for: classToRefactor >> selector ] - failsWith: [ PushUpMethod errorMessageForMethodCannotAccessInstanceVariable ]. - - self deny: (classToRefactorSuperclass includesSelector: selector). - self assert: (classToRefactor includesSelector: selector).! ! + | refactoring classToRefactor oldSelector newSelector newImplementorSourceCode newParameter senderSelector senderMethod toExtract newKeyword | + + oldSelector := 'm1:' asSymbol. + newKeyword := 'm2:' asSymbol. + newSelector := (oldSelector, newKeyword) asSymbol. + newParameter := 'newParam'. + senderSelector := 'sender_m1' asSymbol. + toExtract := '1.'. -!PushUpMethodTest methodsFor: 'tests' stamp: 'MSC 11/12/2019 11:47:57'! -test04AMethodWritesSuperClassInstVarShouldBePushedUpToSuperclass + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector, ' p1 ', toExtract, ' self printString'. + classToRefactor compile: senderSelector, ' self ', oldSelector, ' #x '. + + refactoring := ExtractAsParameter + named: newParameter + extractedFrom: (8 to: 9) + at: 2 + newKeyword: newKeyword + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} + senders: {classToRefactor>>senderSelector}. + refactoring apply. + + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). + + newImplementorSourceCode := (classToRefactor>>newSelector) sourceCode. + self assert: oldSelector, ' p1 ', newKeyword, ' ', newParameter, ' ', newParameter, '. self printString' equals: newImplementorSourceCode. + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: senderSelector, ' self ', oldSelector, ' #x ', newKeyword, ' 1 ' equals: senderMethod sourceCode! ! - | classToRefactorSuperclass classToRefactor selector newVariable push | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:12:01'! +test15CanExtractMessageSendToLiteral - newVariable := 'a'. - selector := #newMethod. - - classToRefactorSuperclass := self createClassNamed: #Superclass instanceVariableNames: newVariable. + | refactoring classToRefactor oldSelector newSelector newImplementorSourceCode newParameter senderSelector senderMethod toExtract | + + oldSelector := 'm1' asSymbol. + newSelector := (oldSelector, ':') asSymbol. + newParameter := 'newParam'. + senderSelector := 'sender_m1' asSymbol. + toExtract := '10 factorial'. - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass. - classToRefactor compile: selector, ' a = 1'. + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector, ' ', toExtract. + classToRefactor compile: senderSelector, ' self ', oldSelector. + + refactoring := ExtractAsParameter + named: newParameter + extractedFrom: (4 to: 15) + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} + senders: {classToRefactor>>senderSelector}. + refactoring apply. + + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector). + + newImplementorSourceCode := (classToRefactor>>newSelector) sourceCode. + self assert: newSelector, ' ', newParameter, ' ', newParameter equals: newImplementorSourceCode. + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: senderSelector, ' self ', newSelector, ' ', toExtract equals: senderMethod sourceCode! ! - push := PushUpMethod for: classToRefactor >> selector. - push apply. - - self assert: (classToRefactorSuperclass includesSelector: selector). - self deny: (classToRefactor includesSelector: selector).! ! +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:12:21'! +test16CannotExtractMessageSendWithInvalidNode -!PushUpMethodTest methodsFor: 'tests' stamp: 'MSC 11/12/2019 11:48:00'! -test05AMethodAccessesSuperClassClassToRefactorInstVarShouldBePushedUpToSuperclass + self assertCannotExtractInvalidNodeAsParameter: '10 + self'! ! - | classToRefactorSuperclass classToRefactor selector newVariable push | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:12:38'! +test17CannotExtractMessageSendToInvalidNode - newVariable := 'a'. - selector := #newMethod. - - classToRefactorSuperclass := self createClassNamed: #Superclass instanceVariableNames: newVariable. + self assertCannotExtractInvalidNodeAsParameter: 'self + 10'! ! - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass. - classToRefactor compile: selector, '^ 1 + ', newVariable. +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:12:59'! +test18CanExtractManyMessageSends - push := PushUpMethod for: classToRefactor >> selector. - push apply. - - self assert: (classToRefactorSuperclass includesSelector: selector). - self deny: (classToRefactor includesSelector: selector).! ! + self assertCanExtractAsParameter: '10 + 10 + 10'! ! -!PushUpMethodTest methodsFor: 'tests' stamp: 'MSC 11/12/2019 11:48:03'! -test06AMethodAccessesSuperClassClassToRefactorInstVarShouldBePushedUpToSuperclass +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:13:19'! +test19CannotExtractManyMessageSendsWithInvalidNode - | classToRefactorSuperclass classToRefactor selector newVariable push | + self assertCannotExtractInvalidNodeAsParameter: '10 + 10 + self'! ! - newVariable := 'a'. - selector := #newMethod. - - classToRefactorSuperclass := self createClassNamed: #Superclass instanceVariableNames: newVariable. +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:13:38'! +test20CanExtractPartOfAValidExpression - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass. - classToRefactor compile: selector, '^ 1 + ', newVariable. + self assertCanExtractFrom: '10 + 10' size: 2 introducing: '10' + ! ! - push := PushUpMethod for: classToRefactor >> selector. - push apply. - - self assert: (classToRefactorSuperclass includesSelector: selector). - self deny: (classToRefactor includesSelector: selector).! ! +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:13:48'! +test21CanExtractABlock -!PushUpMethodTest methodsFor: 'tests' stamp: 'HAW 12/14/2019 11:25:39'! -test07AMethodInClassToRefactorExistsInSuperClassShouldOverrideTheExistingSuperClassMethod - - | classToRefactor classToRefactorSuperclass newVariable selector superclassMethodContent | - - newVariable := 'a'. - selector := #newMethod. - superclassMethodContent := selector, ' - ^ 2 + ', newVariable, '.'. - - classToRefactorSuperclass := self createClassNamed: #Superclass instanceVariableNames: newVariable. - classToRefactorSuperclass compile: selector, '^ 1 + ', newVariable. + self assertCanExtractAsParameter: '[10]' + ! ! - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass. - classToRefactor compile: superclassMethodContent. +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:14:01'! +test22CannotExtractBlockWithInvalidNode - self - assertCreation: [ PushUpMethod for: classToRefactor >> selector ] - warnsWith: [ PushUpMethod methodToPushUpExistOnSuperclassWarningMessage ]. - - self assert: (classToRefactorSuperclass includesSelector: selector). - self assert: (classToRefactor includesSelector: selector).! ! + self assertCannotExtractInvalidNodeAsParameter: '[self]' + ! ! -!PushUpMethodTest methodsFor: 'class factory' stamp: 'MSC 11/12/2019 11:48:09'! -classToRefactorName +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:14:17'! +test23CannotExtractBlockWithMessageSendWithInvalidNode - ^#ClassToPushMethodUp! ! + self assertCannotExtractInvalidNodeAsParameter: '[1 + self]' + ! ! -!RemoveAllUnreferencedInstanceVariablesTest methodsFor: 'tests' stamp: 'HAW 8/2/2018 16:15:11'! -test01NoVariableIsRemovedWhenClassHasNoInstanceVariable +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:14:34'! +test24CanExtractBlockWithManyExpressions - | classToRefactor refactoring removedInstanceVariables | - - classToRefactor := self createClassNamed: #ClassWithoutInstVar. - - refactoring := RemoveAllUnreferencedInstanceVariables from: classToRefactor. - removedInstanceVariables := refactoring apply. - - self assert: removedInstanceVariables isEmpty! ! + self assertCanExtractAsParameter: '[1 + 1. 2 + 2]' + ! ! -!RemoveAllUnreferencedInstanceVariablesTest methodsFor: 'tests' stamp: 'HAW 8/2/2018 16:15:14'! -test02UnreferencedVariablesAreRemoved +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:14:44'! +test25CanExtractBlockWithParameters - | classToRefactor refactoring removedInstanceVariables unreferencedVariable | - - unreferencedVariable := 'a'. - classToRefactor := self createClassNamed: #ClassWithInstVar instanceVariableNames: unreferencedVariable. - - refactoring := RemoveAllUnreferencedInstanceVariables from: classToRefactor. - removedInstanceVariables := refactoring apply. - - self assert: 1 equals: removedInstanceVariables size. - self assert: (removedInstanceVariables includes: unreferencedVariable) + self assertCanExtractAsParameter: '[:p1 | 1 + p1]' ! ! -!RemoveAllUnreferencedInstanceVariablesTest methodsFor: 'tests' stamp: 'HAW 8/2/2018 16:15:18'! -test03VariablesWithReferencesAreNotRemoved +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:15:06'! +test26CannotExtractBlockThatReferencesMethodVariable - | classToRefactor refactoring removedInstanceVariables unreferencedVariableName referencedVariableName | - - referencedVariableName := 'a'. - unreferencedVariableName := 'b'. - classToRefactor := self createClassNamed: #ClassWithInstVar instanceVariableNames: referencedVariableName, ' ', unreferencedVariableName. - classToRefactor compile: 'm1 ^', referencedVariableName. - - refactoring := RemoveAllUnreferencedInstanceVariables from: classToRefactor. - removedInstanceVariables := refactoring apply. + | classToRefactor oldSelector | - self assert: 1 equals: removedInstanceVariables size. - self assert: (removedInstanceVariables includes: unreferencedVariableName). + oldSelector := 'm1' asSymbol. + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString, ' | var1 | [ 1 + var1 ]'. + self + assertCreation: [ ExtractAsParameter + named: 'newParam' + extractedFrom: (13 to: 24) + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} + senders: {} ] + failsWith: ExtractAsParameter errorMessageForInvalidExpressionToExtractAsParameter + ! ! -!RemoveAllUnreferencedInstanceVariablesTest methodsFor: 'tests' stamp: 'HAW 8/2/2018 16:22:44'! -test04VariablesWithReferencesInSubclassesAreNotRemoved +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:15:23'! +test27CanExtractBlockWithParameterAndLocalVariable - | classToRefactor refactoring removedInstanceVariables unreferencedVariableName referencedVariableName classToRefactorSubclass | - - referencedVariableName := 'a'. - unreferencedVariableName := 'b'. - classToRefactor := self createClassNamed: #ClassWithInstVar instanceVariableNames: referencedVariableName, ' ', unreferencedVariableName. - classToRefactorSubclass := self createClassNamed: #ClassWithReferenceInstVar subclassOf: classToRefactor. - classToRefactorSubclass compile: 'm1 ^', referencedVariableName. - - refactoring := RemoveAllUnreferencedInstanceVariables from: classToRefactor. - removedInstanceVariables := refactoring apply. - - self assert: 1 equals: removedInstanceVariables size. - self assert: (removedInstanceVariables includes: unreferencedVariableName). - -! ! + self assertCanExtractAsParameter: '[:p1 | | v1 | v1 := 1. v1 + p1]' + ! ! -!RemoveInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 6/12/2017 19:10:08'! -test01CanNotRemoveAnInstanceVariableNotDefinedInClass +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:16:13'! +test28CanExtractBlockEvaluation - | variableToRemove classToRefactor | - - variableToRemove := 'a'. - classToRefactor := self createClassNamed: #ClassWithoutInstVar. - - self - assertCreation: [ RemoveInstanceVariable named: variableToRemove from: classToRefactor ] - failsWith: [ RemoveInstanceVariable errorMessageForInstanceVariable: variableToRemove notDefinedIn: classToRefactor ]. - + | toExtract | + toExtract := '[:p1 | p1] value: 1'. + self assertCanExtractFrom: toExtract size: toExtract size introducing: '(', toExtract ,')' ! ! -!RemoveInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 8/2/2018 15:24:17'! -test02CanNotRemoveInstanceVariableWithReferences +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:16:32'! +test29CannotExtractInvalidInterval - | variableToRemove classToRefactor selector | + | classToRefactor oldSelector | - variableToRemove := 'a'. - classToRefactor := self createClassNamed: #ClassWithInstVar instanceVariableNames: variableToRemove. - selector := #m1. - classToRefactor compile: selector,' ^', variableToRemove. + oldSelector := 'm1' asSymbol. - self - assertCreation: [ RemoveInstanceVariable named: variableToRemove from: classToRefactor ] - failsWith: [ RemoveInstanceVariable errorMessageForInstanceVariable: variableToRemove isReferencedInAll: (Array with: classToRefactor>>selector) ]. - + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString. - ! ! + self + assertCreation: [ ExtractAsParameter + named: 'newParam' + extractedFrom: (2 to: 1) + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} + senders: {} ] + failsWith: ExtractMethodNewMethod noSelectionErrorMessage ! ! -!RemoveInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 8/2/2018 15:24:28'! -test03WhenAppliedRemovesInstanceVariable +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:16:45'! +test30CannotExtractIntervalOutOfBounds - | variableToRemove classToRefactor remove | - - variableToRemove := 'a'. - classToRefactor := self createClassNamed: #ClassWithInstVar instanceVariableNames: variableToRemove. + | classToRefactor oldSelector | - remove := RemoveInstanceVariable named: variableToRemove from: classToRefactor. - remove apply. + oldSelector := 'm1' asSymbol. - self deny: (classToRefactor definesInstanceVariableNamed: variableToRemove) + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString. - ! ! - -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 1/2/2020 06:58:49'! -test01CanNotRemoveParameterFromUnaryMessages - - self - assertCreation: [ RemoveParameter - atIndex: 1 - named: 'aParameter' - from: #m1 - implementors: {} + self + assertCreation: [ ExtractAsParameter + named: 'newParam' + extractedFrom: (2 to: 20) + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} senders: {} ] - failsWith: [ RemoveParameter canNotRemoveParameterFromUnaryMessagesErrorMessage ] -! ! + failsWith: ExtractMethodNewMethod outOfBoundsSelectionErrorMessage ! ! -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 1/2/2020 06:59:13'! -test02CanNotRemoveParameterFromBinaryMessages +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:17:03'! +test31CannotExtractIfOriginalMethodIsNotInImplementors - self - assertCreation: [ RemoveParameter - atIndex: 1 - named: '+' asSymbol - from: #+ + | classToRefactor oldSelector | + + oldSelector := 'm1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString, ' 1'. + + self + assertCreation: [ ExtractAsParameter + named: 'newParam' + extractedFrom: (4 to: 4) + at: classToRefactor>>oldSelector implementors: {} senders: {} ] - failsWith: [ RemoveParameter canNotRemoveParameterFromBinaryMessagesErrorMessage ] -! ! + failsWith: ExtractAsParameter errorMessageForOrigialMethodMustBeInImplementorsToChange! ! -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/2/2018 19:46:52'! -test03CanNotRemoveParameterNotInMessage +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 16:21:15'! +test32CannotExtractMoreThanOneExpression - | classToRefactor selectorToRemoveParameterFrom parameterNotInMessage | + self assertCannotExtractInvalidSelectionAsParameter: '1+1. 2+2' ! ! + +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 19:54:04'! +test33WhenAddingToUnaryMessageSelectorMustBeUnary + + | classToRefactor oldSelector | + + oldSelector := 'm1:' asSymbol. classToRefactor := self createClassNamed: self classToRefactorName. - selectorToRemoveParameterFrom := 'm1:' asSymbol. - classToRefactor compile: selectorToRemoveParameterFrom asString, ' parameter'. - parameterNotInMessage := 'otherParameter'. - - self - assertCreation: [ RemoveParameter - named: parameterNotInMessage - from: classToRefactor>>selectorToRemoveParameterFrom - implementors: {classToRefactor >> selectorToRemoveParameterFrom } + classToRefactor compile: oldSelector asString, ' p1 1'. + + self + assertCreation: [ ExtractAsParameter + named: 'newParam' + extractedFrom: (8 to: 8) + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} senders: {} ] - failsWith: [ RemoveParameter errorMessageForParameterNotInMessage: parameterNotInMessage ] -! ! - -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/2/2018 19:46:03'! -test04AllImplementorsMustImplementSelector + failsWith: AddParameter selectorMustBeUnaryErrorMessage ! ! - | classToRefactor selectorToRemoveParameterFrom parameterToRemove implementors | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/22/2021 19:54:11'! +test34WhenAddingToKeywordMessageSelectorMustBeKeyword + + | classToRefactor oldSelector | + + oldSelector := 'm1' asSymbol. classToRefactor := self createClassNamed: self classToRefactorName. - selectorToRemoveParameterFrom := 'm1:' asSymbol. - parameterToRemove := 'parameter'. - classToRefactor compile: selectorToRemoveParameterFrom asString, ' parameter'. - implementors := {thisContext method}. + classToRefactor compile: oldSelector asString, ' 1'. - self - assertCreation: [ RemoveParameter - named: parameterToRemove - from: classToRefactor>>selectorToRemoveParameterFrom - implementors: implementors + self + assertCreation: [ ExtractAsParameter + named: 'newParam' + extractedFrom: (4 to: 4) + at: 1 + newKeyword: #m2: + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} senders: {} ] - failsWith: [ RemoveParameter errorMessageForInvalidImplementors: implementors ] -! ! - -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/2/2018 19:49:28'! -test05AllSendersShouldSendSelector + failsWith: AddParameter selectorMustBeKeywordErrorMessage ! ! - | classToRefactor selectorToRemoveParameterFrom parameterToRemove invalidSenders | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 18:19:43'! +test35CanExtractManyIntervals + + | classToRefactor oldSelector refactoring | + + oldSelector := 'm1' asSymbol. classToRefactor := self createClassNamed: self classToRefactorName. - selectorToRemoveParameterFrom := 'm1:' asSymbol. - parameterToRemove := 'parameter'. - classToRefactor compile: selectorToRemoveParameterFrom asString, ' parameter'. - invalidSenders := {thisContext method}. + classToRefactor compile: oldSelector asString, ' 10 + 10'. - self - assertCreation: [ RemoveParameter - named: parameterToRemove - from: classToRefactor>>selectorToRemoveParameterFrom - implementors: {} - senders: invalidSenders ] - failsWith: [ RemoveParameter errorMessageForInvalidSenders: invalidSenders of: selectorToRemoveParameterFrom ] + refactoring := ExtractAsParameter + named: 'newParam' + extractedFromAll: { (4 to: 5). (9 to: 10) } + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} + senders: {}. + + refactoring apply. -! ! - -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/2/2018 19:57:35'! -test06NoImplementorReferencesParameterToRemove + self assert: 'm1: newParam newParam + newParam' equals: (classToRefactor >> #m1:) sourceCode + ! ! - | classToRefactor selectorToRemoveParameterFrom parameterToRemove implementorsReferencingParameter | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 18:20:26'! +test36CannotExtractIfAnyIntervalIsNotValid + + | classToRefactor oldSelector | + + oldSelector := 'm1' asSymbol. classToRefactor := self createClassNamed: self classToRefactorName. - selectorToRemoveParameterFrom := 'm1:' asSymbol. - parameterToRemove := 'parameter'. - classToRefactor compile: selectorToRemoveParameterFrom asString, ' parameter ^parameter'. - implementorsReferencingParameter := {classToRefactor>>selectorToRemoveParameterFrom }. + classToRefactor compile: oldSelector asString, ' 10 + self'. - self - assertCreation: [ RemoveParameter - named: parameterToRemove - from: classToRefactor>>selectorToRemoveParameterFrom - implementors: implementorsReferencingParameter + self + assertCreation: [ ExtractAsParameter + named: 'newParam' + extractedFromAll: { (4 to: 5). (9 to: 12) } + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} senders: {} ] - failsWith: [ RemoveParameter errorMessageForParameterToRemoveIsReferenced: parameterToRemove ]! ! - -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/3/2018 17:58:11'! -test07FirstParameterIsRemovedCorrectly + failsWith: ExtractAsParameter errorMessageForInvalidExpressionToExtractAsParameter + + + ! ! - | classToRefactor selectorToRemoveParameterFrom parameterToRemove keywordToRemove keywordToKeep parameterToKeep refactoring | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 18:20:36'! +test37CannotExtractIfSourceToExtractAreNotEqualInAllIntervals + + | classToRefactor oldSelector | + + oldSelector := 'm1' asSymbol. classToRefactor := self createClassNamed: self classToRefactorName. - keywordToRemove := 'm1:'. - keywordToKeep := 'm2:'. - selectorToRemoveParameterFrom := (keywordToRemove, keywordToKeep) asSymbol. - parameterToRemove := 'parameter1'. - parameterToKeep := 'parameter2'. - classToRefactor compile: keywordToRemove,parameterToRemove, ' - ', keywordToKeep, parameterToKeep. + classToRefactor compile: oldSelector asString, ' 10 + 11'. - refactoring := RemoveParameter - named: parameterToRemove - from: classToRefactor>>selectorToRemoveParameterFrom - implementors: { classToRefactor>>selectorToRemoveParameterFrom } - senders: {}. - refactoring apply. + self + assertCreation: [ ExtractAsParameter + named: 'newParam' + extractedFromAll: { (4 to: 5). (9 to: 10) } + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} + senders: {} ] + failsWith: ExtractAsParameter errorMessageNotAllExpressionsToExtractAreEqual + - self assert: (classToRefactor canUnderstand: keywordToKeep asSymbol). - self assert: (classToRefactor sourceCodeAt: keywordToKeep asSymbol) equals: (keywordToKeep, parameterToKeep) ! ! - -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/3/2018 18:45:48'! -test08LastParameterIsRemovedCorrectly + ! ! - | classToRefactor selectorToRemoveParameterFrom parameterToRemove keywordToRemove keywordToKeep parameterToKeep refactoring | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 18:20:55'! +test38CanExtractManyBlocksIfAreEqual + + | classToRefactor oldSelector refactoring | + + oldSelector := 'm1' asSymbol. classToRefactor := self createClassNamed: self classToRefactorName. - keywordToKeep := 'm1:'. - keywordToRemove := 'm2:'. - selectorToRemoveParameterFrom := (keywordToKeep, keywordToRemove) asSymbol. - parameterToKeep := 'parameter1'. - parameterToRemove := 'parameter2'. - classToRefactor compile: keywordToKeep,parameterToKeep, ' ', keywordToRemove, parameterToRemove,' - | t1 |'. + classToRefactor compile: oldSelector asString, ' [10] + [10]'. - refactoring := RemoveParameter - named: parameterToRemove - from: classToRefactor>>selectorToRemoveParameterFrom - implementors: { classToRefactor>>selectorToRemoveParameterFrom } - senders: {}. + refactoring := ExtractAsParameter + named: 'newParam' + extractedFromAll: { (4 to: 7). (11 to: 14) } + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} + senders: {}. + refactoring apply. - self assert: (classToRefactor canUnderstand: keywordToKeep asSymbol). - self assert: (classToRefactor sourceCodeAt: keywordToKeep asSymbol) equals: (keywordToKeep, parameterToKeep,' - | t1 |') ! ! - -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/4/2018 14:34:22'! -test09MiddleParameterIsRemovedCorrectly + self assert: 'm1: newParam newParam + newParam' equals: (classToRefactor >> #m1:) sourceCode + ! ! - | classToRefactor selectorToRemoveParameterFrom parameterToRemove keywordToRemove keywordToKeep parameterToKeep refactoring newSelector | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 18:21:22'! +test39CanExtractManyBlocksIfSourceCodeNotEqualButSameAst + + | classToRefactor oldSelector refactoring | + + oldSelector := 'm1' asSymbol. classToRefactor := self createClassNamed: self classToRefactorName. - keywordToRemove := 'm1:'. - keywordToKeep := 'm2:'. - selectorToRemoveParameterFrom := ('m0:',keywordToRemove, keywordToKeep) asSymbol. - newSelector := ('m0:', keywordToKeep) asSymbol. - parameterToRemove := 'parameter1'. - parameterToKeep := 'parameter2'. - classToRefactor compile: 'm0: parameter0 - ',keywordToRemove,parameterToRemove, ' - ', keywordToKeep, parameterToKeep. + classToRefactor compile: oldSelector asString, ' [10] + [ 10 ]'. - refactoring := RemoveParameter - named: parameterToRemove - from: classToRefactor>>selectorToRemoveParameterFrom - implementors: { classToRefactor>>selectorToRemoveParameterFrom } - senders: {}. + refactoring := ExtractAsParameter + named: 'newParam' + extractedFromAll: { (4 to: 7). (11 to: 16) } + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} + senders: {}. + refactoring apply. - self assert: (classToRefactor canUnderstand: newSelector). - self assert: (classToRefactor sourceCodeAt: newSelector) equals: ('m0: parameter0 - ',keywordToKeep, parameterToKeep) ! ! + self assert: 'm1: newParam newParam + newParam' equals: (classToRefactor >> #m1:) sourceCode + ! ! -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/3/2018 17:34:00'! -test10ParameterFromOneKeywordSelectorIsRemovedCorrectly +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 18:21:48'! +test40CannotExtractWithoutIntervals + + | classToRefactor oldSelector | + + oldSelector := 'm1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString, ' 10 + 11'. + + self + assertCreation: [ ExtractAsParameter + named: 'newParam' + extractedFromAll: {} + at: classToRefactor>>oldSelector + implementors: {classToRefactor>>oldSelector} + senders: {} ] + failsWith: ExtractAsParameter errorMessageForNoExpressionToExtract + + + ! ! - | classToRefactor selectorToRemoveParameterFrom parameterToRemove refactoring | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 20:32:04'! +test41DetectsAllRangesForLiteral + + | classToRefactor selector intervals | + + selector := 'm1' asSymbol. classToRefactor := self createClassNamed: self classToRefactorName. - selectorToRemoveParameterFrom := 'm1:' asSymbol. - parameterToRemove := 'parameter1'. - classToRefactor compile: selectorToRemoveParameterFrom asString,parameterToRemove. + classToRefactor compile: selector, ' 10 + 10'. - refactoring := RemoveParameter - named: parameterToRemove - from: classToRefactor>>selectorToRemoveParameterFrom - implementors: { classToRefactor>>selectorToRemoveParameterFrom } - senders: {}. - refactoring apply. + intervals := ExtractAsParameter intervalsForEquivalentExpressionIn: classToRefactor >> selector at: (4 to: 5). + + self assert: { (4 to: 5). (9 to: 10) } equals: intervals asArray.! ! + +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 20:32:28'! +test42DoesNotMixesRangesForDifferentLiterals - self assert: (classToRefactor canUnderstand: 'm1' asSymbol).! ! + | classToRefactor selector intervals | + + selector := 'm1' asSymbol. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: selector, ' 10 + 100'. + + intervals := ExtractAsParameter intervalsForEquivalentExpressionIn: classToRefactor >> selector at: (4 to: 5). -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:29:53'! -test11ParameterOfSendersOfMoreThanOneKeywordSelectorsIsRemovedCorrectly + self assert: { (4 to: 5) } equals: intervals asArray.! ! - | classToRefactor selectorToRemoveParameterFrom parameterToRemove keywordToRemove keywordToKeep parameterToKeep refactoring senderSelector senderMethod | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 20:32:48'! +test43DetectsRangesForEquivalentBlocks - classToRefactor := self createClassNamed: self classToRefactorName. - keywordToRemove := 'm1:'. - keywordToKeep := 'm2:'. - selectorToRemoveParameterFrom := (keywordToRemove, keywordToKeep) asSymbol. - parameterToRemove := 'parameter1'. - parameterToKeep := 'parameter2'. - senderSelector := 'sender' asSymbol. - classToRefactor compile: keywordToRemove,parameterToRemove, ' ', keywordToKeep, parameterToKeep. - classToRefactor compile: senderSelector asString,' - self - ', keywordToRemove, ' 1 - ', keywordToKeep, ' 2 '. + | classToRefactor selector intervals | - refactoring := RemoveParameter - named: parameterToRemove - from: classToRefactor>>selectorToRemoveParameterFrom - implementors: { classToRefactor>>selectorToRemoveParameterFrom } - senders: {classToRefactor>>senderSelector}. - refactoring apply. + selector := 'm1' asSymbol. - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: (senderMethod sendsOrRefersTo: keywordToKeep asSymbol). - self assert: senderMethod sourceCode equals: (senderSelector asString,' - self - ', keywordToKeep, ' 2 ') + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: selector, ' [10] + [ 10 ]'. - ! ! + intervals := ExtractAsParameter intervalsForEquivalentExpressionIn: classToRefactor >> selector at: (4 to: 7). -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:30:01'! -test12ParameterOfSendersOfOneKeywordSelectorsIsRemovedCorrectly + self assert: { (4 to: 7). (11 to: 16) } equals: intervals asArray.! ! - | classToRefactor selectorToRemoveParameterFrom parameterToRemove refactoring senderSelector senderMethod | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 20:33:01'! +test44DetectsRangesForEquivalentMessageSends - classToRefactor := self createClassNamed: self classToRefactorName. - selectorToRemoveParameterFrom := 'm1:' asSymbol. - parameterToRemove := 'parameter1'. - senderSelector := 'sender' asSymbol. - classToRefactor compile: selectorToRemoveParameterFrom,parameterToRemove. - classToRefactor compile: senderSelector asString,' - self - ', selectorToRemoveParameterFrom, ' - (1+2).'. + | classToRefactor selector intervals | - refactoring := RemoveParameter - named: parameterToRemove - from: classToRefactor>>selectorToRemoveParameterFrom - implementors: { classToRefactor>>selectorToRemoveParameterFrom } - senders: {classToRefactor>>senderSelector}. - refactoring apply. + selector := 'm1' asSymbol. - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: (senderMethod sendsOrRefersTo: 'm1' asSymbol). - self assert: senderMethod sourceCode equals: (senderSelector asString,' - self - m1.') + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: selector, ' 10 factorial + 10 factorial'. - ! ! + intervals := ExtractAsParameter intervalsForEquivalentExpressionIn: classToRefactor >> selector at: (4 to: 15). -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 3/4/2019 09:22:15'! -test13ParameterIsRemovedCorrecltyFromSendersWithMoreThanOneSend + self assert: { (4 to: 15). (19 to: 33) } equals: intervals asArray.! ! - | classToRefactor selectorToRemoveParameterFrom parameterToRemove keywordToRemove keywordToKeep parameterToKeep refactoring senderSelector senderMethod | +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 9/24/2021 20:34:32'! +test45DoesNotDetectEquiallySemanticBlocks + + | classToRefactor selector intervals | + + "This is something to improve - Hernan" + + selector := 'm1' asSymbol. classToRefactor := self createClassNamed: self classToRefactorName. - keywordToRemove := 'm1:'. - keywordToKeep := 'm2:'. - selectorToRemoveParameterFrom := (keywordToRemove, keywordToKeep) asSymbol. - parameterToRemove := 'parameter1'. - parameterToKeep := 'parameter2'. - senderSelector := 'sender' asSymbol. - classToRefactor compile: keywordToRemove,parameterToRemove, ' ', keywordToKeep, parameterToKeep. - classToRefactor compile: senderSelector asString,' - self ', keywordToRemove, ' (1+1) ', keywordToKeep, ' 2. - self ', keywordToRemove, ' 3 ', keywordToKeep, ' 4.'. + classToRefactor compile: selector, ' [:p1 | 1 ] + [:p2 | 1]'. - refactoring := RemoveParameter - named: parameterToRemove - from: classToRefactor>>selectorToRemoveParameterFrom - implementors: { classToRefactor>>selectorToRemoveParameterFrom } - senders: {classToRefactor>>senderSelector}. - refactoring apply. + intervals := ExtractAsParameter intervalsForEquivalentExpressionIn: classToRefactor >> selector at: (4 to: 13). + + self assert: { (4 to: 13) } equals: intervals asArray.! ! + +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 12/6/2021 11:44:09'! +test46CanExtractMessageSendToClassWithValidParameters + + | toExtract | - senderMethod := classToRefactor compiledMethodAt: senderSelector. - self assert: (senderMethod sendsOrRefersTo: keywordToKeep asSymbol). - self assert: senderMethod sourceCode equals: (senderSelector asString,' - self ', keywordToKeep, ' 2. - self ', keywordToKeep, ' 4.') + toExtract := 'Array with: 1'. + + self assertCanExtractFrom: toExtract size: toExtract size introducing: '(', toExtract, ')' ! ! -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 1/1/2020 23:33:19'! -test14CanNotRemoveParameterIndexLessThanOne +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 12/6/2021 11:44:47'! +test47CanExtractEmptyBraceArray - | parameterNotInMessage | - - parameterNotInMessage := 'otherParameter'. + self assertCanExtractAsParameter: '{}'! ! - self - assertCreation: [ RemoveParameter - atIndex: 0 - named: parameterNotInMessage - from: #m1: - implementors: {} - senders: {} ] - failsWith: [ RemoveParameter invalidParameterIndexErrorMessage ] -! ! +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 12/6/2021 11:46:33'! +test48CanExtractBraceArrayWithExtractableElements -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 1/1/2020 23:36:16'! -test15CanNotRemoveParameterIndexBiggerThanOldSelectorNumberOfKeywords + self assertCanExtractAsParameter: '{1. {}. Array with: 1}'! ! - | parameterNotInMessage | - - parameterNotInMessage := 'otherParameter'. +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 12/6/2021 11:49:29'! +test49CannotExtractBraceArrayWithNoExtractableElements - self - assertCreation: [ RemoveParameter - atIndex: 2 - named: parameterNotInMessage - from: #m1: - implementors: {} - senders: {} ] - failsWith: [ RemoveParameter invalidParameterIndexErrorMessage ] -! ! + self assertCannotExtractInvalidNodeAsParameter: '{1. self m2 }'! ! -!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 1/1/2020 23:38:57'! -test16ParameterIndexMustBeInteger +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 12/6/2021 12:05:47'! +test50CanExtractReferenceToGlobal - | parameterNotInMessage | + self assertCanExtractAsParameter: 'Smalltalk'! ! + +!ExtractAsParameterTest methodsFor: 'tests' stamp: 'HAW 12/6/2021 12:05:01'! +test51CannotExtractNotExistingGlobalReference + + self assertCannotExtractInvalidNodeAsParameter: '__Smalltalk__'! ! + +!ExtractAsParameterTest methodsFor: 'class factory' stamp: 'HAW 9/8/2021 22:00:32'! +classToRefactorName - parameterNotInMessage := 'otherParameter'. + ^#ClassToIntroduceParameter! ! - self - assertCreation: [ RemoveParameter - atIndex: 1.5 - named: parameterNotInMessage - from: #m1:m2: - implementors: {} - senders: {} ] - failsWith: [ RemoveParameter invalidParameterIndexErrorMessage ] -! ! +!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 9/28/2019 00:49:10'! +assertClassHasDefined: aSelector withBody: newSourceCode + + self + assert: newSourceCode + equals: (classToRefactor >> aSelector) sourceCode! ! + +!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 6/23/2019 18:30:02'! +assertClassHasDefined: aSelector withBody: newSourceCode inCategory: aCategory + + self assertClassHasDefined: aSelector withBody: newSourceCode. + self assert: aCategory equals: (classToRefactor >> aSelector) category! ! + +!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 1/12/2020 21:08:55'! +assertExtracting: codeToExtract from: originalCode named: newMessage defines: newCode andUpdates: updatedCode + + | originalSelector category | + category _ #category. + originalSelector _ classToRefactor compile: originalCode classified: category. + + (ExtractMethod + fromInterval: (self intervalOf: codeToExtract locatedIn: originalCode) + of: classToRefactor >> originalSelector + to: newMessage + categorizedAs: category) apply. + + self + assertClassHasDefined: originalSelector withBody: updatedCode inCategory: category; + assertClassHasDefined: newMessage selector withBody: newCode inCategory: category! ! + +!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:10:35'! +creationWithMessage: aMessage onInterval: anIntervalToExtract ofMethod: methodToExtractCodeFrom failsWith: aRefactoringExceptionMessageEvaluationBlock errorCondition: anExceptionHandlingCondition + + self + should: [ + ExtractMethod + fromInterval: anIntervalToExtract + of: methodToExtractCodeFrom + to: aMessage + categorizedAs: Categorizer default ] + raise: anExceptionHandlingCondition + withMessageText: aRefactoringExceptionMessageEvaluationBlock! ! + +!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:13:01'! +creationWithSelectorNamed: aSelectorName onInterval: anIntervalToExtract ofMethod: aMethodToRefactor failsWith: aRefactoringErrorMessageEvaluationBlock errorCondition: anExceptionHandlingCondition + + self + creationWithMessage: (Message selector: aSelectorName) + onInterval: anIntervalToExtract + ofMethod: aMethodToRefactor + failsWith: aRefactoringErrorMessageEvaluationBlock + errorCondition: anExceptionHandlingCondition! ! + +!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:09:14'! +tryingToExtract: someCode from: anExistingSourceCode failsWith: aRefactoringErrorMessageEvaluationBlock + + | existingSelector | + existingSelector := classToRefactor compile: anExistingSourceCode. + + self + creationWithSelectorNamed: #aValidSelector + onInterval: (self intervalOf: someCode locatedIn: anExistingSourceCode) + ofMethod: classToRefactor >> existingSelector + failsWith: aRefactoringErrorMessageEvaluationBlock + errorCondition: self refactoringError! ! + +!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:11:49'! +tryingToExtract: someCode from: anExistingSourceCode using: aMessage failsWith: aRefactoringErrorMessageEvaluationBlock + + | existingSelector | + existingSelector := classToRefactor compile: anExistingSourceCode. + + self + creationWithMessage: aMessage + onInterval: (self intervalOf: someCode locatedIn: anExistingSourceCode) + ofMethod: classToRefactor >> existingSelector + failsWith: aRefactoringErrorMessageEvaluationBlock + errorCondition: self refactoringError! ! -!RemoveParameterTest methodsFor: 'class factory' stamp: 'HAW 9/1/2018 12:24:23'! -classToRefactorName - - ^#ClassToRemoveParameter! ! +!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:12:03'! +tryingToExtract: someCode from: anExistingSourceCode using: aMessage raisesWarning: aRefactoringWarningMessageEvaluationBlock -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 6/1/2017 19:44:41'! -test01NewClassNameHasToBeDifferentToOldOne + | existingSelector | + existingSelector := classToRefactor compile: anExistingSourceCode. - self - assertCreation: [ RenameClass from: self class to: self class name ] - failsWith: [ RenameClass newNameEqualsOldNameErrorMessage]! ! + self + creationWithMessage: aMessage + onInterval: (self intervalOf: someCode locatedIn: anExistingSourceCode) + ofMethod: classToRefactor >> existingSelector + failsWith: aRefactoringWarningMessageEvaluationBlock + errorCondition: self refactoringWarning! ! -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:36:20'! -test02NewClassNameHasToBeASymbol +!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:09:47'! +tryingToExtractOnInterval: anIntervalToExtract failsWith: aRefactoringErrorMessageEvaluationBlock - self - assertCreation: [ RenameClass from: self class to: 'aString' ] - failsWith: [ NewClassPrecondition newNameMustBeSymbolErrorMessage]! ! + self + creationWithSelectorNamed: #aValidSelector + onInterval: anIntervalToExtract + ofMethod: self methodToExtractCodeFrom + failsWith: aRefactoringErrorMessageEvaluationBlock + errorCondition: self refactoringError! ! -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 5/24/2019 10:09:47'! -test03NewClassNameHasToStartWithUppercaseLetter +!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:10:02'! +tryingToExtractWithSelectorNamed: aSelectorName failsWith: aRefactoringErrorMessageEvaluationBlock - self - assertCreation: [ RenameClass from: self class to: #_A ] - failsWith: [ NewClassPrecondition newNameMustStartWithRightLetterErrorMessage]! ! + | originalSource selectorOfOriginalMethod | + originalSource := 'm1 ^ 8'. + selectorOfOriginalMethod := classToRefactor compile: originalSource. -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:33:08'! -test04NewClassShouldNotExist + self + creationWithSelectorNamed: aSelectorName + onInterval: (self intervalOf: '8' locatedIn: originalSource) + ofMethod: classToRefactor >> selectorOfOriginalMethod + failsWith: aRefactoringErrorMessageEvaluationBlock + errorCondition: self refactoringError! ! - | newClassName | - - newClassName := #Object. - - self - assertCreation: [ RenameClass from: self class to: newClassName in: Smalltalk ] - failsWith: [ NewClassPrecondition errorMessageForAlreadyExistClassNamed: newClassName ]! ! +!ExtractMethodTest methodsFor: 'assertions' stamp: 'RNG 5/25/2020 01:08:00'! +tryingToExtractWithSelectorNamed: aSelectorName raisesWarning: aRefactoringWarningMessageEvaluationBlock -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 12/13/2018 17:59:19'! -test04_01NewClassNameShouldNotBeAGlobalVariable + | originalSource selectorOfOriginalMethod | + originalSource := 'm1 ^ 8'. + selectorOfOriginalMethod := classToRefactor compile: originalSource. - | newClassName | - - newClassName := #Smalltalk. - - self - assertCreation: [ RenameClass from: self class to: newClassName in: Smalltalk ] - failsWith: [ NewClassPrecondition errorMessageForAlreadyExistGlobalNamed: newClassName ]! ! + self + creationWithSelectorNamed: aSelectorName + onInterval: (self intervalOf: '8' locatedIn: originalSource) + ofMethod: classToRefactor >> selectorOfOriginalMethod + failsWith: aRefactoringWarningMessageEvaluationBlock + errorCondition: self refactoringWarning + ! ! -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:33:35'! -test05NewClassShouldNotBeUndeclare +!ExtractMethodTest methodsFor: 'class factory' stamp: 'RNG 4/20/2019 21:31:05'! +classToRefactorName - | newClassName undeclared | - - newClassName := #UndeclareClass. - undeclared := Dictionary new. - undeclared at: newClassName put: nil. - - self - assertCreation: [ RenameClass from: self class to: newClassName in: Smalltalk undeclared: undeclared ] - failsWith: [ NewClassPrecondition errorMessageForNewClassIsUndeclared: newClassName ]! ! + ^ #ClassToExtractMethod! ! -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 6/4/2017 19:12:10'! -test06OldClassIsRenamedToNewClass +!ExtractMethodTest methodsFor: 'method and source code helpers' stamp: 'RNG 5/12/2019 23:21:30'! +compileMethodToExtractCodeFrom - | oldClassName newClassName classToRefactor rename | + classToRefactor compile: self sourceCodeOfMethodToExtractCodeFrom! ! - oldClassName := 'OldClassTest07' asSymbol. - newClassName := 'NewClassTest07' asSymbol. - classToRefactor := self createClassNamed: oldClassName. - - rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. - rename apply. - - self assert: (Smalltalk classNamed: oldClassName) isNil. - self deny: (Smalltalk classNamed: newClassName) isNil.! ! +!ExtractMethodTest methodsFor: 'method and source code helpers' stamp: 'RNG 5/12/2019 23:22:01'! +methodToExtractCodeFrom -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 6/4/2017 18:18:12'! -test07OldClassDirectReferencesAreRenamed + ^ classToRefactor >> self selectorOfMethodToExtractCodeFrom! ! - | oldClassName newClassName classToRefactor selector rename referencingMethod | - - oldClassName := 'OldClassTest07' asSymbol. - newClassName := 'NewClassTest07' asSymbol. - classToRefactor := self createClassNamed: oldClassName. - selector := #m1. - classToRefactor compile: selector, ' ', oldClassName asString, ' new'. - - rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. - rename apply. - - referencingMethod := (Smalltalk classNamed: newClassName) compiledMethodAt: selector. - self assert: (referencingMethod hasLiteralThorough: newClassName). - self deny: (referencingMethod hasLiteralThorough: oldClassName)! ! +!ExtractMethodTest methodsFor: 'method and source code helpers' stamp: 'RNG 5/12/2019 23:25:05'! +selectorOfMethodToExtractCodeFrom -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 6/4/2017 18:19:04'! -test08OldClassLiteralReferencesAreRenamed + ^ #mExtractMethodExample:! ! - | oldClassName newClassName classToRefactor selector rename referencingMethod | - - oldClassName := 'OldClassTest08' asSymbol. - newClassName := 'NewClassTest8' asSymbol. - classToRefactor := self createClassNamed: oldClassName. - selector := #m1. - classToRefactor compile: selector, ' #', oldClassName asString, ' size'. - - rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. - rename apply. - - referencingMethod := (Smalltalk classNamed: newClassName) compiledMethodAt: selector. - self assert: (referencingMethod hasLiteralThorough: newClassName). - self deny: (referencingMethod hasLiteralThorough: oldClassName)! ! +!ExtractMethodTest methodsFor: 'method and source code helpers' stamp: 'RNG 9/8/2019 18:40:40'! +sourceCodeOfMethodToExtractCodeFrom -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 6/4/2017 18:36:22'! -test09OtherClassDirectReferencesAreNotRenamed + ^ self selectorOfMethodToExtractCodeFrom, ' anArgument - | oldClassName newClassName classToRefactor selector rename referencingMethod | - - oldClassName := 'OldClassTest09' asSymbol. - newClassName := 'NewClassTest09' asSymbol. - classToRefactor := self createClassNamed: oldClassName. - selector := #m1. - classToRefactor compile: selector, ' ', oldClassName asString, ' new. Object new'. - - rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. - rename apply. - - referencingMethod := (Smalltalk classNamed: newClassName) compiledMethodAt: selector. - self assert: (referencingMethod hasLiteralThorough: newClassName). - self deny: (referencingMethod hasLiteralThorough: oldClassName). - self assert: (referencingMethod hasLiteralThorough: #Object). -! ! + + | localVar | + + self m1. + self m2: ''hey true''. + self m3: anArgument , ''^ 21''. + localVar _ Set with: ''hello''. + localVar := #($x $y $z) size and: [ (9) * 3 ]. + ^ localVar + ((4))'! ! -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 6/4/2017 19:07:19'! -test10OtherLiteralReferencesAreNotRenamed +!ExtractMethodTest methodsFor: 'refactoring helpers' stamp: 'RNG 5/8/2020 21:06:17'! +intervalOf: aPieceOfSourceCode locatedIn: sourceCode - | oldClassName newClassName classToRefactor selector rename referencingMethod | - - oldClassName := 'OldClassTest10' asSymbol. - newClassName := 'NewClassTest10' asSymbol. - classToRefactor := self createClassNamed: oldClassName. - selector := #m1. - classToRefactor compile: selector, ' #', oldClassName asString, ' size. #Object size'. - - rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. - rename apply. - - referencingMethod := (Smalltalk classNamed: newClassName) compiledMethodAt: selector. - self assert: (referencingMethod hasLiteralThorough: newClassName). - self deny: (referencingMethod hasLiteralThorough: oldClassName). - self assert: (referencingMethod hasLiteralThorough: #Object). -! ! + | interval | + interval _ sourceCode intervalOfSubCollection: aPieceOfSourceCode. + ^ (interval first to: interval last - 1) asSourceCodeInterval! ! -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 16:30:56'! -test11OldClassDirectAndLiteralReferencesAreRenameAtOnce +!ExtractMethodTest methodsFor: 'set up' stamp: 'HAW 8/28/2021 17:39:00'! +setUp - | oldClassName newClassName classToRefactor selector rename renamedReferences | - - oldClassName := 'OldClassTest11' asSymbol. - newClassName := 'NewClassTest11' asSymbol. - classToRefactor := self createClassNamed: oldClassName. - selector := #m1. - classToRefactor compile: selector, ' ', oldClassName asString, ' new. #', oldClassName asString, ' size'. - - rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. - renamedReferences := rename apply. - - self assert: 1 equals: renamedReferences size. - self assert: selector equals: renamedReferences anyOne selector. - self assert: newClassName equals: renamedReferences anyOne classSymbol. - self assert: ((classToRefactor sourceCodeAt: selector) includesSubString: '#', newClassName)! ! + super setUp. + classToRefactor _ self createClassNamed: self classToRefactorName. + ! ! -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 4/4/2018 19:56:09'! -test12CanNotRenameAMetaclass +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! +test09ExtractingALiteralCreatesANewMethodAndChangesExistingCodeToCallThatNewMethod - self - assertCreation: [ RenameClass from: self class class to: #Object ] - failsWith: [ RenameClass classToRenameCanNotBeMetaclassErrorMessage]! ! + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '4'. + originalCode _ 'm1 ^ ' , codeToExtract. + newMethodCode _ 'm2 -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:35:38'! -test13NewClassNameHasToBeASymbol + ^ ' , codeToExtract. + updatedCode _ 'm1 ^ self m2'. - self - assertCreation: [ RenameClass from: self class to: '' asSymbol ] - failsWith: [ NewClassPrecondition newClassNameCanNotBeEmptyErrorMessage]! ! + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 09:20:07'! -test14NewClassNameCanNotHaveSpaces +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! +test15ExtractingAListOfStatementsCreatesANewMethodWithoutReturn + + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ 'self m3. + self m4: 5'. + originalCode _ 'm1 ' , codeToExtract. + newMethodCode _ 'm2 - | oldClassName classToRefactor | + ', codeToExtract. + updatedCode _ 'm1 self m2'. - oldClassName := 'OldClassTest14' asSymbol. - classToRefactor := self createClassNamed: oldClassName. + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! - self - assertCreation: [ RenameClass from: classToRefactor to: 'With spaces' asSymbol ] - failsWith: [ NewClassPrecondition newClassNameCanNotHaveSeparatorsErrorMessage]! ! +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! +test17AStringContainingTheReturnCharacterCanBeExtracted + "this is to make sure the return is found using AST logic, not by text" -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 14:44:13'! -test15ItDoesNotRenameReferencesToClassVariableWithSameName + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '''^ 3'' size'. + originalCode _ 'm1 ^ ' , codeToExtract. + newMethodCode _ 'm2 - | classWithClassVariable oldClassName classToRefactor newClassName rename renamedReferences | + ^ ' , codeToExtract. + updatedCode _ 'm1 ^ self m2'. - oldClassName := 'OldClassTest15' asSymbol. - newClassName := 'NewClassTest15' asSymbol. - "First I create a class var with the same name as the class to rename and a reference to it - Hernan" - classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol. - classWithClassVariable addClassVarName: oldClassName. - classWithClassVariable compile: 'm1 ^', oldClassName. + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! - classToRefactor := self createClassNamed: oldClassName. +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! +test18ExtractingAListOfStatementsIncludingDotsRemovesThemAndContinuesWithMethodExtraction - rename := RenameClass from: classToRefactor to: newClassName. - renamedReferences := rename apply. - - self assert: renamedReferences isEmpty. - + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ ' + self m3. + self m4: 5.'. + originalCode _ 'm1 + ' , codeToExtract. + newMethodCode _ 'm2 + + self m3. + self m4: 5'. + updatedCode _ 'm1 - ! ! + self m2.'. -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 14:45:20'! -test16ItDoesNotRenameReferencesToClassVariableWithSameNameDefinedInAnySuperclass + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! - | classWithClassVariable oldClassName classToRefactor newClassName rename renamedReferences superClassOfClassWithClassVarReference | +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! +test19ASelectionContainingAdditionalParenthesesAtTheBeginningAndOrEndCanBeExtracted - oldClassName := 'OldClassTest16' asSymbol. - newClassName := 'NewClassTest16' asSymbol. + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '((42))'. + originalCode _ 'm1 ^ ' , codeToExtract. + newMethodCode _ 'm2 - superClassOfClassWithClassVarReference := self createClassNamed: 'ClassReferencingClassVarSuperclass' asSymbol. - superClassOfClassWithClassVarReference addClassVarName: oldClassName. - - classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol subclassOf: superClassOfClassWithClassVarReference. - classWithClassVariable compile: 'm1 ^', oldClassName. + ^ 42'. + updatedCode _ 'm1 ^ ((self m2))'. - classToRefactor := self createClassNamed: oldClassName. + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! - rename := RenameClass from: classToRefactor to: newClassName. - renamedReferences := rename apply. - - self assert: renamedReferences isEmpty. - - - ! ! +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! +test20ASelectionContainingALocalVariableIsParameterizedOnTheExtractedMessage -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 14:46:34'! -test17ItDoesNotRenameReferencesToClassVariableWithSameNameAsNewClassDefinedInAnySuperclass + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ 'local + 3'. + originalCode _ 'm1 | local | ^ ' , codeToExtract. + newMethodCode _ 'm2: local - | classWithClassVariable oldClassName classToRefactor newClassName rename renamedReferences superClassOfClassWithClassVarReference | + ^ ' , codeToExtract. + updatedCode _ 'm1 | local | ^ self m2: local'. - oldClassName := 'OldClassTest17' asSymbol. - newClassName := 'NewClassTest17' asSymbol. + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2: arguments: #('local')) + defines: newMethodCode andUpdates: updatedCode! ! - superClassOfClassWithClassVarReference := self createClassNamed: 'ClassReferencingClassVarSuperclass' asSymbol. - superClassOfClassWithClassVarReference addClassVarName: newClassName. - - classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol subclassOf: superClassOfClassWithClassVarReference. - classWithClassVariable compile: 'm1 ^', newClassName. +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! +test21ASelectionContainingAdditionalParenthesesOnOneSideCanBeExtractedAndItIsNotTrimmed - classToRefactor := self createClassNamed: oldClassName. + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '(9) * 3'. + originalCode _ 'm1 ^ ' , codeToExtract. + newMethodCode _ 'm2 - rename := RenameClass from: classToRefactor to: newClassName. - renamedReferences := rename apply. - - self assert: renamedReferences isEmpty. - - - ! ! + ^ ' , codeToExtract. + updatedCode _ 'm1 ^ self m2'. -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 16:21:35'! -test18WorksCorrectlyWhenSourceCodeEndsWithClassToRename + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! - | oldClassName newClassName classToRefactor selector rename referencingMethod | - - oldClassName := 'OldClassTest18' asSymbol. - newClassName := 'NewClassTest18' asSymbol. - classToRefactor := self createClassNamed: oldClassName. - selector := #m1. - classToRefactor compile: selector, ' ^', oldClassName asString. - - rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. - rename apply. - - referencingMethod := (Smalltalk classNamed: newClassName) compiledMethodAt: selector. - self assert: (referencingMethod hasLiteralThorough: newClassName). - self deny: (referencingMethod hasLiteralThorough: oldClassName)! ! +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! +test22ItIsPossibleToExtractTheLastExpressionOfAMethod -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 16:24:09'! -test19RenamesClassWhenMethodReferencesClassAndDoesNothing + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ 'localVar + ((4))'. + originalCode _ 'm1 | localVar | ^ ' , codeToExtract. + newMethodCode _ 'm2: localVar - | oldClassName newClassName classToRefactor selector rename referencingMethod | - - "Currently the rename class is not handling this case becuase message #allCallsOn: does not return a method - that references a class but does nothing becuase it is optimize to return self... it is a really wierd case so I decided - no to solve it by now - Hernan" - self shouldFail: [ - oldClassName := 'OldClassTest18' asSymbol. - newClassName := 'NewClassTest18' asSymbol. - classToRefactor := self createClassNamed: oldClassName. - selector := #m1. - classToRefactor compile: selector, ' ', oldClassName asString. - - rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. - rename apply. - - referencingMethod := (Smalltalk classNamed: newClassName) compiledMethodAt: selector. - self assert: (referencingMethod hasLiteralThorough: newClassName). - self deny: (referencingMethod hasLiteralThorough: oldClassName)] ! ! + ^ ' , codeToExtract. + updatedCode _ 'm1 | localVar | ^ self m2: localVar'. -!RenameClassTest methodsFor: 'tests' stamp: 'HAW 12/30/2021 16:31:36'! -test20ItDoesNotRenameReferencesToClassVariableWithSameNameAndReferencedInClassMethod + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2: arguments: #('localVar')) + defines: newMethodCode andUpdates: updatedCode! ! - | classWithClassVariable oldClassName classToRefactor newClassName rename renamedReferences | +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! +test26ItIsPossibleToExtractAnEntireBlockIncludingALocalAssignment - oldClassName := 'OldClassTest15' asSymbol. - newClassName := 'NewClassTest15' asSymbol. - "First I create a class var with the same name as the class to rename and a reference to it - Hernan" - classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol. - classWithClassVariable addClassVarName: oldClassName. - classWithClassVariable class compile: 'm1 ^', oldClassName. + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '[ |something| something _ 3 ]'. + originalCode _ 'm1 ^ ' , codeToExtract. + newMethodCode _ 'm2 - classToRefactor := self createClassNamed: oldClassName. + ^ ' , codeToExtract. + updatedCode _ 'm1 ^ self m2'. - rename := RenameClass from: classToRefactor to: newClassName. - renamedReferences := rename apply. - - self assert: renamedReferences isEmpty. - self assert: (classWithClassVariable definesClassVariableNamedInHierarchy: oldClassName) - - - ! ! + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 17:53:53'! -define: anOldName with: aGlobalValue toBeRenamedAs: aNewName while: aBlock +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! +test27ItIsPossibleToExtractExpressionsWithOptimizedSelectors - | oldNameAsSymbol newNameAsSymbol | - - oldNameAsSymbol := anOldName asSymbol. - newNameAsSymbol := aNewName asSymbol. - - self assert: (Smalltalk at: oldNameAsSymbol ifAbsent: [ nil ]) isNil. - self assert: (Smalltalk at: newNameAsSymbol ifAbsent: [ nil ]) isNil. - - [ - Smalltalk at: oldNameAsSymbol put: aGlobalValue. - aBlock value: oldNameAsSymbol value: newNameAsSymbol value: aGlobalValue ] ensure: [ - Smalltalk removeKey: oldNameAsSymbol ifAbsent: []. - Smalltalk removeKey: newNameAsSymbol ifAbsent: []]. - ! ! + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '2 ifNil: [ #boo ] ifNotNil: [ #yay ]'. + originalCode _ 'm1 ^ ' , codeToExtract. + newMethodCode _ 'm2 -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:20:03'! -test00GlobalCanNotBeClass + ^ ' , codeToExtract. + updatedCode _ 'm1 ^ self m2'. - self - assertCreation: [ RenameGlobal from: #Object to: 'NewObject__' asSymbol ] - failsWith: [ RenameGlobal globalCanNotBeClassErrorMessage]! ! + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:20:37'! -test01NewNameHasToBeDifferentToOldOne +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:08:55'! +test29ExtractingABinaryExpressionToAKeywordMessageIntroducesParenthesesToNotBreakOriginalPrecedence - self - define: 'OldNameToRename__' - with: Object new - toBeRenamedAs: 'OldNameToRename__' - while: [ :oldName :newName :globalValue | - self - assertCreation: [ RenameGlobal from: oldName to: newName ] - failsWith: [ RenameGlobal newNameEqualsOldNameErrorMessage]]! ! + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '2 + arg'. + originalCode _ 'm1: arg ^ ' , codeToExtract , ' * 3'. + newMethodCode _ 'm2: arg + + ^ ' , codeToExtract. + updatedCode _ 'm1: arg ^ (self m2: arg) * 3'. + + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2: arguments: #('arg')) + defines: newMethodCode andUpdates: updatedCode! ! -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:26:40'! -test02NewNameHasToBeASymbol +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 1/12/2020 21:11:36'! +test30ItIsPossibleToExtractAQuotedExpression - self withDefaultsDo: [ :oldName :newName :globalValue | - self - assertCreation: [ RenameGlobal from: oldName to: newName asString ] - failsWith: [ NewGlobalPrecondition newNameMustBeSymbolErrorMessage]]! ! + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '`3 + 4`'. + originalCode _ 'm1 ^ ' , codeToExtract. + newMethodCode _ 'm2 -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:27:23'! -test03NewNameShouldNotBeAClass + ^ ' , codeToExtract. + updatedCode _ 'm1 ^ self m2'. - | className | - - className := #Object. - - self withDefaultsDo: [ :oldName :newName :globalValue | - self - assertCreation: [ RenameGlobal from: oldName to: className in: Smalltalk ] - failsWith: [ NewGlobalPrecondition errorMessageForAlreadyExistClassNamed: className ]]! ! + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:27:33'! -test04NewNameShouldNotBeAGlobalVariable +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'HAW 3/30/2020 16:16:37'! +test31ItIsPossibleToExtractExpressionsWithOptimizedSelectorsWhereTheReceiverIsNotASimpleLiteral - | globalName | - - globalName := #Smalltalk. - - self withDefaultsDo: [ :oldName :newName :globalValue | - self - assertCreation: [ RenameGlobal from: oldName to: globalName in: Smalltalk ] - failsWith: [ NewGlobalPrecondition errorMessageForAlreadyExistGlobalNamed: globalName ]]! ! + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '2 factorial ifNotNil: [ #boo ]'. + originalCode _ 'm1 ^ ' , codeToExtract. + newMethodCode _ 'm2 -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:27:45'! -test06OldNameIsRenamedToNewName + ^ ' , codeToExtract. + updatedCode _ 'm1 ^ self m2'. - | rename | + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! - self withDefaultsDo: [ :oldName :newName :globalValue | - rename := RenameGlobal from: oldName to: newName in: Smalltalk. - rename apply. +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 4/5/2020 23:19:13'! +test32ItIsPossibleToExtractATemporaryDeclarationOfABlockIfItIsNotUsedOutsideOfSelectionInterval - self assert: (Smalltalk at: oldName ifAbsent: [nil]) isNil. - self assert: (Smalltalk at: newName) equals: globalValue ].! ! + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '| a | a _ 3 factorial'. + originalCode _ 'm1 ^ [ ' , codeToExtract , ' ]'. + newMethodCode _ 'm2 -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:27:58'! -test07OldDirectReferencesAreRenamed + ' , codeToExtract. + updatedCode _ 'm1 ^ [ self m2 ]'. - | rename classToRefactor referencingMethod selector | + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! - self withDefaultsDo: [ :oldName :newName :globalValue | - classToRefactor := self createClassNamed: #AClassToRefactor. - selector := 'm1' asSymbol. - classToRefactor compile: selector, ' ^', oldName asString. +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 4/5/2020 23:19:23'! +test33ItIsPossibleToExtractATemporaryDeclarationIfItIsNotUsedOutsideOfSelectionInterval - rename := RenameGlobal from: oldName to: newName in: Smalltalk. - rename apply. + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '| a | a _ 3 factorial'. + originalCode _ 'm1 ' , codeToExtract. + newMethodCode _ 'm2 - referencingMethod := classToRefactor compiledMethodAt: selector. - self assert: (referencingMethod hasLiteralThorough: newName). - self deny: (referencingMethod hasLiteralThorough: oldName). - self assert: (classToRefactor new perform: selector) equals: globalValue ]. - - - -! ! + ' , codeToExtract. + updatedCode _ 'm1 self m2'. -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:28:09'! -test08OldNameLiteralReferencesAreRenamed + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! - | rename classToRefactor referencingMethod selector | +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 4/14/2020 20:52:00'! +test36ItIsPossibleToExtractACascadeExpression - self withDefaultsDo: [ :oldName :newName :globalValue | - classToRefactor := self createClassNamed: #AClassToRefactor. - selector := 'm1' asSymbol. - classToRefactor compile: selector, ' ^#', oldName asString. + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '(3 + 2) factorial; yourself'. + originalCode _ 'm1 ^ ' , codeToExtract. + newMethodCode _ 'm2 - rename := RenameGlobal from: oldName to: newName in: Smalltalk. - rename apply. + ^ ' , codeToExtract. + updatedCode _ 'm1 ^ self m2'. - referencingMethod := classToRefactor compiledMethodAt: selector. - self assert: (referencingMethod hasLiteralThorough: newName). - self deny: (referencingMethod hasLiteralThorough: oldName). - self assert: (classToRefactor new perform: selector) equals: newName ]. - - ! ! + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:28:21'! -test09NewNameHasToBeASymbol +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 4/24/2020 20:32:48'! +test37ItIsPossibleATempDeclarationAlongWithABlock - self withDefaultsDo: [ :oldName :newName :globalValue | - self - assertCreation: [ RenameGlobal from: oldName to: '' asSymbol ] - failsWith: [ NewGlobalPrecondition newNameCanNotBeEmptyErrorMessage]]! ! + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '| temp | []'. + originalCode _ 'm1 ' , codeToExtract. + newMethodCode _ 'm2 -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:28:30'! -test10NewNameCanNotHaveSpaces + ' , codeToExtract. + updatedCode _ 'm1 self m2'. - self withDefaultsDo: [ :oldName :newName :globalValue | - self - assertCreation: [ RenameGlobal from: oldName to: 'With spaces' asSymbol ] - failsWith: [ NewGlobalPrecondition newNameCanNotHaveSeparatorsErrorMessage]]! ! + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 18:33:27'! -test11ItDoesNotRenameReferencesToClassVariableWithSameName +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'RNG 5/4/2020 20:08:01'! +test38ItIsPossibleToExtractCodeThatContainsMultipleParenthesisWithSpacesBetweenThem - | rename classWithClassVariable renamedReferences oldNameAsString | + | codeToExtract newMethodCode originalCode updatedCode | + codeToExtract _ '( (3 + 4))'. + originalCode _ 'm1 ^ ' , codeToExtract. + newMethodCode _ 'm2 - oldNameAsString := 'OldNameToRename__'. - classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol. - classWithClassVariable addClassVarName: oldNameAsString asSymbol. - classWithClassVariable compile: 'm1 ^', oldNameAsString. + ^ 3 + 4'. + updatedCode _ 'm1 ^ ( (self m2))'. - self - define: oldNameAsString - with: Object new - toBeRenamedAs: 'NewNameRenamed__' - while: [ :oldName :newName :globalValue | + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! - rename := RenameGlobal from: oldName to: newName. - renamedReferences := rename apply. - - self assert: renamedReferences isEmpty ] +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'HAW 9/22/2021 15:01:48'! +test44CanExtractManyStatementsInsideABlock + + | codeToExtract newMethodCode originalCode updatedCode | - ! ! + codeToExtract _ 'self m1. + self m2'. + originalCode _ 'm1 true ifTrue: [' , codeToExtract, ']'. + newMethodCode _ 'm2 -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 18:33:34'! -test12ItDoesNotRenameReferencesToClassVariableWithSameNameDefinedInAnySuperclass + self m1. + self m2'. + updatedCode _ 'm1 true ifTrue: [self m2]'. - | classWithClassVariable rename renamedReferences superClassOfClassWithClassVarReference oldNameAsString | + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m2) + defines: newMethodCode andUpdates: updatedCode! ! - oldNameAsString := 'OldNameRenamed__'. +!ExtractMethodTest methodsFor: 'tests - successful' stamp: 'HAW 10/18/2021 18:42:26'! +test45CanExtractCodeWithMoreThanOneBlockAndABlockAtTheEndInsideAnotherBlock - superClassOfClassWithClassVarReference := self createClassNamed: 'ClassReferencingClassVarSuperclass' asSymbol. - superClassOfClassWithClassVarReference addClassVarName: oldNameAsString asSymbol. + | codeToExtract newMethodCode originalCode updatedCode | - classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol subclassOf: superClassOfClassWithClassVarReference. - classWithClassVariable compile: 'm1 ^', oldNameAsString. + codeToExtract _ 'true ifTrue: [ self m1 ]. + true ifTrue: [ self m2 ].'. + originalCode _ 'm1 [true] whileTrue: [ ' , codeToExtract, ' + self m3]'. + newMethodCode _ 'm4 - self - define: oldNameAsString - with: Object new - toBeRenamedAs: 'NewNameRenamed__' - while: [ :oldName :newName :globalValue | + true ifTrue: [ self m1 ]. + true ifTrue: [ self m2 ]'. + updatedCode _ 'm1 [true] whileTrue: [ self m4. + self m3]'. - rename := RenameGlobal from: oldName to: newName. - renamedReferences := rename apply. - - self assert: renamedReferences isEmpty ] - - - ! ! + self + assertExtracting: codeToExtract from: originalCode named: (Message selector: #m4) + defines: newMethodCode andUpdates: updatedCode! ! -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:29:03'! -test13OldNameMustBeDefined - - self - assertCreation: [ RenameGlobal from: 'AGlobal__' asSymbol to: 'AGlobal' asSymbol in: Smalltalk ] - failsWith: [ RenameGlobal errorMessageForGlobalNotDefined: 'AGlobal__' asSymbol ]! ! +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 19:13:15'! +test01NewSelectorShouldNotBeEmpty -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:34:06'! -test14ItDoesNotRenameReferencesToClassVariableFromClassSideWithSameName + self + tryingToExtractWithSelectorNamed: #'' + failsWith: [ NewSelectorPrecondition newSelectorCanNotBeEmptyErrorMessage ]! ! - | rename classWithClassVariable renamedReferences oldNameAsString | +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 19:13:15'! +test02NewSelectorShouldNotContainSeparators - oldNameAsString := 'OldNameToRename__'. - classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol. - classWithClassVariable addClassVarName: oldNameAsString asSymbol. - classWithClassVariable class compile: 'm1 ^', oldNameAsString. + self + tryingToExtractWithSelectorNamed: #'my selector' + failsWith: [ NewSelectorPrecondition newSelectorCanNotContainSeparatorsErrorMessage ]! ! - self - define: oldNameAsString - with: Object new - toBeRenamedAs: 'NewNameRenamed__' - while: [ :oldName :newName :globalValue | +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 8/28/2021 17:40:41'! +test03ExtractingToSelectorAlreadyDefinedInTheClassRaisesAWarning + + self compileMethodToExtractCodeFrom. + self + tryingToExtractWithSelectorNamed: self selectorOfMethodToExtractCodeFrom + raisesWarning: [ + NewSelectorPrecondition + warningMessageFor: self selectorOfMethodToExtractCodeFrom + isAlreadyDefinedIn: classToRefactor ]! ! - rename := RenameGlobal from: oldName to: newName. - renamedReferences := rename apply. - - self assert: renamedReferences isEmpty ] - - ! ! +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 19:13:15'! +test04NewSelectorShouldNotStartWithANumber -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:49:43'! -test15OldNameCanNotBeEmpty - - self - assertCreation: [ RenameGlobal from: '' asSymbol to: 'AGlobal' asSymbol in: Smalltalk ] - failsWith: [ RenameGlobal oldNameCanNotBeEmptyErrorMessage ]! ! + self + tryingToExtractWithSelectorNamed: #'2selector' + failsWith: [ NewSelectorPrecondition invalidStartingCharacterOfNewSelectorErrorMessage ]! ! -!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:26:58'! -withDefaultsDo: aBlock +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 19:13:15'! +test05NewUnarySelectorShouldNotStartWithASymbol - self - define: 'OldNameToRename__' - with: Object new - toBeRenamedAs: 'NewNameToRename__' - while: aBlock! ! + self + tryingToExtractWithSelectorNamed: #- + failsWith: [ NewSelectorPrecondition invalidStartingCharacterOfNewSelectorErrorMessage ]! ! -!RenameInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 6/11/2017 18:13:05'! -classToRefactorName +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 9/4/2021 21:25:24'! +test06IntervalToExtractIsNotBeforeMethodSourceCodeBoundaries - ^#ClassToRenameInstVar! ! + self compileMethodToExtractCodeFrom. + self + tryingToExtractOnInterval: (-1 to: 2) asSourceCodeInterval + failsWith: [ ExtractMethodNewMethod outOfBoundsSelectionErrorMessage ]! ! -!RenameInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 6/1/2017 14:28:02'! -createClassToRefactor - - classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: oldVariable ! ! +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 9/4/2021 21:25:40'! +test07IntervalToExtractIsNotAfterMethodSourceCodeBoundaries -!RenameInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 5/28/2017 21:36:47'! -createClassToRefactorAndAssertRenameCreationFailsWith: aMessageTextCreator + self compileMethodToExtractCodeFrom. + self + tryingToExtractOnInterval: (1 to: self sourceCodeOfMethodToExtractCodeFrom size + 2) asSourceCodeInterval + failsWith: [ ExtractMethodNewMethod outOfBoundsSelectionErrorMessage ]! ! - self createClassToRefactor. - self assertRenameCreationFailsWith: aMessageTextCreator ! ! +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/24/2020 21:51:01'! +test08IntervalToExtractShouldNotContainAReturnExpression -!RenameInstanceVariableTest methodsFor: 'assertions' stamp: 'HAW 6/1/2017 19:00:37'! -assertRenameCreationFailsWith: aMessageTextCreator + self + tryingToExtract: '^ localVar + ((4))' + from: 'm1 ^ localVar + ((4))' + failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForSourceCodeIncludingAReturnStatement ]! ! + +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:48:14'! +test10IntervalToExtractDoesNotContainsPartOfTheOriginalSelector self - assertCreation: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] - failsWith: aMessageTextCreator ! ! + tryingToExtract: 'm1 ^ 8' + from: 'm1 ^ 8' + failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForSourceCodeContainingInvalidExpression ]! ! -!RenameInstanceVariableTest methodsFor: 'setup' stamp: 'HAW 5/28/2017 21:33:44'! -setUp +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/24/2020 22:55:57'! +test11IntervalToExtractDoesNotContainsPartOfLocalVariablesDefinition - super setUp. - - oldVariable := 'old'. - newVariable := 'new'.! ! + self + tryingToExtract: '| localVar |' + from: 'm1 | localVar | ^ localVar + 3' + failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForExtractingTemporaryVariablesDefinition ]! ! -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/27/2017 11:21:06'! -test01CanNotRenameAnInstanceVariableNotDefinedInClass +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:48:14'! +test12IntervalToExtractDoesNotContainsPartOfPragmasDefinition - classToRefactor := self createClassNamed: #ClassWithoutInstVar instanceVariableNames: ''. - - self assertRenameCreationFailsWith: [ RenameInstanceVariable errorMessageForInstanceVariable: oldVariable notDefinedIn: classToRefactor ] - ! ! + self + tryingToExtract: '' + from: 'm1 ' + failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForSourceCodeContainingInvalidExpression ]! ! -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:45:01'! -test02NewVariableNameCanNotBeEmpty - - newVariable := ' '. - self createClassToRefactorAndAssertRenameCreationFailsWith: [NewInstanceVariablePrecondition newVariableCanNotBeEmptyErrorMessage ] -! ! +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:48:14'! +test13IntervalToExtractShouldBeAValidSmalltalkExpression -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:45:05'! -test03NewVariableNameCanNotContainBlanks - - newVariable := 'a b'. - self createClassToRefactorAndAssertRenameCreationFailsWith: [NewInstanceVariablePrecondition errorMessageForInvalidInstanceVariable: newVariable] -! ! + self + tryingToExtract: '+ ((4))' + from: 'm1 ^ 3 + ((4))' + failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForSourceCodeContainingInvalidExpression ]! ! -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:45:10'! -test04NewVariableNameCanNotContainInvalidCharacters +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 8/28/2021 17:41:13'! +test14ItIsNotPossibleToExtractTheLeftSideOfAnAssignment - newVariable := '2a'. - self createClassToRefactorAndAssertRenameCreationFailsWith: [NewInstanceVariablePrecondition errorMessageForInvalidInstanceVariable: newVariable] -! ! + | firstOccurrence secondOccurrence intervalToExtract | + + self compileMethodToExtractCodeFrom. + firstOccurrence := self sourceCodeOfMethodToExtractCodeFrom + indexOfSubCollection: 'localVar' startingAt: 1. + secondOccurrence := self sourceCodeOfMethodToExtractCodeFrom + indexOfSubCollection: 'localVar' startingAt: firstOccurrence + 1. + intervalToExtract := secondOccurrence toSelfPlus: 'localVar' size. + self + tryingToExtractOnInterval: intervalToExtract asSourceCodeInterval + failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForExtractingLeftSideOfAssignment ]! ! -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/28/2017 21:33:30'! -test05ValidNewVariableNameGetBlanksTrimmed +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:48:13'! +test16CanNotExtractPartOfALiteral - newVariable := ' a '. - self createClassToRefactor. - self - shouldnt: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] - raise: self refactoringError ! ! + tryingToExtract: 'true' + from: 'm1 ^ ''hey true''' + failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForSourceCodeContainingInvalidExpression ]! ! -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:45:17'! -test06NewVariableNameCanNotBeDefinedInClass +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 9/4/2021 21:26:00'! +test23CanNotExtractWithAnInvalidInterval - newVariable := oldVariable. - self createClassToRefactorAndAssertRenameCreationFailsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariable: newVariable alreadyDefinedInAll: (Array with: classToRefactor )] - ! ! + self compileMethodToExtractCodeFrom. + self + tryingToExtractOnInterval: (10 to: 9) asSourceCodeInterval + failsWith: [ ExtractMethodNewMethod noSelectionErrorMessage ]! ! -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:45:22'! -test07NewVariableNameCanNotBeDefinedInSuperclasses +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:26:46'! +test24ItIsNotPossibleToExtractAnIntervalIncludingATemporaryAssignmentExpression - | classToRefactorSuperclass | + self + tryingToExtract: 'localVar _ 8' + from: 'm1 | localVar | localVar _ 8' + failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForExtractedTemporaryAssignmentWithoutItsDeclaration ]! ! - classToRefactorSuperclass := self createClassNamed: #SuperclassWithInstVar instanceVariableNames: newVariable. - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass instanceVariableNames: oldVariable. - - self assertRenameCreationFailsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariable: newVariable alreadyDefinedInAll: (Array with: classToRefactorSuperclass)] - - -! ! +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 19:13:15'! +test25NewUnarySelectorShouldNotContainInvalidCharacters -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:45:39'! -test08NewVariableNameCanNotBeDefinedInAnySubclass + self + tryingToExtractWithSelectorNamed: 'hola)' asSymbol + failsWith: [ NewSelectorPrecondition invalidCharacterInsideNewSelectorErrorMessage ]! ! - | classToRefactorSubclass | +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:30:44'! +test28ItIsNotPossibleToExtractALocalVariableInsideOfItsDeclaration - self createClassToRefactor. - classToRefactorSubclass := self createClassNamed: #SubclassWithInstVar subclassOf: classToRefactor instanceVariableNames: newVariable. - - self assertRenameCreationFailsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariable: newVariable alreadyDefinedInAll: (Array with: classToRefactorSubclass)] - - ! ! + self + tryingToExtract: 'localVar' + from: 'm1 | localVar | ^ #foo' + failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForExtractingTemporaryVariablesDefinition ]! ! -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/27/2017 11:36:03'! -test09RenameCreatesNewInstanceVariableAndDeletesOldOne +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 9/4/2021 21:26:21'! +test34TryingToExtractAMethodWithLessArgumentsThanNeededFails - | rename | + self + tryingToExtract: 'localVar1 + localVar2 + 2' + from: 'm1 | localVar1 localVar2 | ^ localVar1 + localVar2 + 2' + using: (Message selector: #m1: arguments: #('localVar1')) + failsWith: [ ExtractMethodNewMethod wrongNumberOfArgumentsGivenErrorMessage ]! ! - self createClassToRefactor. - - rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor . - rename apply. - - self assert: (classToRefactor definesInstanceVariableNamed: newVariable). - self deny: (classToRefactor definesInstanceVariableNamed: oldVariable) -! ! +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'HAW 9/4/2021 21:26:39'! +test35TryingToExtractAMethodWithMoreArgumentsThanNeededFails -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/28/2017 21:05:15'! -test10ReadReferencesToOldVariableAreRenamed + self + tryingToExtract: 'localVar1 + localVar2 + 2' + from: 'm1 | localVar1 localVar2 | ^ localVar1 + localVar2 + 2' + using: (Message selector: #m1:m2:m3: arguments: #('localVar1' 'localVar2' 'localVar3')) + failsWith: [ ExtractMethodNewMethod wrongNumberOfArgumentsGivenErrorMessage ]! ! - | selector method rename | +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 19:13:15'! +test39TryingToExtractToAMethodThatExistsInASuperclassRaisesAWarning - selector := #m1. - self createClassToRefactor. - classToRefactor compile: selector , ' ^' , oldVariable. - - rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor. - rename apply. + self + tryingToExtract: '42' + from: 'm1 ^ 42' + using: (Message selector: #yourself) + raisesWarning: [ NewSelectorPrecondition warningMessageFor: #yourself isAlreadyDefinedIn: Object ]! ! - method := classToRefactor >> selector. - self assert: (method readsInstanceVariable: newVariable). - self deny: (method readsInstanceVariable: oldVariable) -! ! +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 5/25/2020 00:37:19'! +test40CanNotExtractTemporaryAssignmentWithDeclarationIfTheVariableIsUsedOutsideOfSelectionInterval -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/28/2017 21:07:27'! -test11WriteReferencesToOldVariableAreRenamed + self + tryingToExtract: '|var| var _ 42.' + from: 'm1 |var| var _ 42. ^ var' + failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForTemporaryAssignmentWithUsagesOutsideOfSelectionInterval ]! ! - | selector method rename | +!ExtractMethodTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 15:35:08'! +test41CannotExtractPartOfMethodSignature - selector := #m1. - self createClassToRefactor. - classToRefactor compile: selector , ' ' , oldVariable, ' := 10'. - - rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor. - rename apply. + self + tryingToExtract: 'arg' + from: 'm1: arg ^ self' + using: (Message selector: #m2: arguments: #('arg')) + failsWith: [ SourceCodeOfMethodToBeExtractedPrecondition errorMessageForExtractingPartOfMethodSignature ]! ! - method := classToRefactor >> selector. - self assert: (method writesInstanceVariable: newVariable). - self deny: (method writesInstanceVariable: oldVariable) -! ! +!ExtractMethodTest methodsFor: 'tests - many repetitions' stamp: 'HAW 9/5/2021 07:13:44'! +test42ExtractsManyRepetitionsOnSameMethod -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/28/2017 21:10:59'! -test12ReferencesInSubclassesAreRenamed + | sourceMethodName finder sourceMethod extractMethod intervalToExtract newMessage | + + sourceMethodName := classToRefactor compile: 'm1 10. 10'. + + sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. + intervalToExtract := (4 to: 5) asSourceCodeInterval. + newMessage := Message selector: #m2. + finder := ExtractMethodReplacementsFinder ofCodeIn: intervalToExtract at: sourceMethod to: newMessage. + finder value. + + extractMethod := ExtractMethod + newDefinition: (ExtractMethodNewMethod + fromInterval: intervalToExtract + of: sourceMethod + to: newMessage + categorizedAs: #something) + replacements: finder replacements. + + extractMethod apply. + + self assert: + 'm2 - | selector method classToRefactorSubclass rename | + ^ 10' equals: (classToRefactor >> #m2) sourceCode. + self assert: 'm1 self m2. self m2' equals: (classToRefactor >> #m1) sourceCode. + ! ! - selector := #m1. - self createClassToRefactor. - classToRefactorSubclass _ self createClassNamed: #SubclassWithInstVar subclassOf: classToRefactor instanceVariableNames: ''. - classToRefactorSubclass compile: selector , ' ' , oldVariable, ' := 10. ^' , oldVariable. +!ExtractMethodTest methodsFor: 'tests - many repetitions' stamp: 'HAW 9/5/2021 07:13:44'! +test43ExtractsRepetitionsOnMoreThanOneMethod - rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor. - rename apply. + | sourceMethodName finder sourceMethod extractMethod intervalToExtract newMessage | + + sourceMethodName := classToRefactor compile: 'm1 10'. + classToRefactor compile: 'm1b 100+10'. + + sourceMethod := (classToRefactor >> sourceMethodName) asMethodReference. + intervalToExtract := (4 to: 5) asSourceCodeInterval. + newMessage := Message selector: #m2. + finder := ExtractMethodReplacementsFinder ofCodeIn: intervalToExtract at: sourceMethod to: newMessage. + finder value. + + extractMethod := ExtractMethod + newDefinition: (ExtractMethodNewMethod + fromInterval: intervalToExtract + of: sourceMethod + to: newMessage + categorizedAs: #something) + replacements: finder replacements. + + extractMethod apply. + + self assert: 'm1 self m2' equals: (classToRefactor >> #m1) sourceCode. + self assert: 'm1b 100+self m2' equals: (classToRefactor >> #m1b) sourceCode. + ! ! - method := classToRefactorSubclass >> selector. - self assert: (method readsInstanceVariable: newVariable). - self assert: (method writesInstanceVariable: newVariable). - self deny: (method readsInstanceVariable: oldVariable). - self deny: (method writesInstanceVariable: oldVariable) ! ! +!ExtractToTemporaryTest methodsFor: 'class factory' stamp: 'RNG 2/22/2020 21:20:46'! +classToRefactorName -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/28/2017 21:46:36'! -test13ReferencesToOtherVariablesAreNotRenamed + ^ #ClassToDoExtractTemporary! ! - | variableToKeep selector method rename | +!ExtractToTemporaryTest methodsFor: 'set up' stamp: 'RNG 3/24/2020 22:30:57'! +setUp - variableToKeep := 'keep'. - selector := #m1. - classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: oldVariable, ' ', variableToKeep. - classToRefactor compile: selector , ' ' , variableToKeep, ' := ' , oldVariable, '. ^' , variableToKeep. + super setUp. + classToRefactor _ self createClassNamed: self classToRefactorName! ! - rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor. - rename apply. +!ExtractToTemporaryTest methodsFor: 'test helpers' stamp: 'RNG 3/24/2020 22:42:02'! +assertExtracting: codeToExtract from: sourceCodeOfMethodToRefactor toVariableNamed: newVariable updatesTo: sourceCodeAfterRefactoring - method := classToRefactor >> selector. - self assert: (method readsInstanceVariable: variableToKeep). - self assert: (method writesInstanceVariable: variableToKeep) -! ! + self + assertExtracting: codeToExtract + from: sourceCodeOfMethodToRefactor + toVariableNamed: newVariable + updatesTo: sourceCodeAfterRefactoring + usingLeftArrowAssignment: true! ! -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/28/2017 21:15:59'! -test14NewVariableOfExistingInstancesReferToOldVariableValue +!ExtractToTemporaryTest methodsFor: 'test helpers' stamp: 'jmv 5/16/2022 08:58:01'! +assertExtracting: codeToExtract from: sourceCodeOfMethodToRefactor toVariableNamed: newVariable updatesTo: sourceCodeAfterRefactoring usingLeftArrowAssignment: leftArrowAssignmentPreference - | rename instance | + | intervalToExtract methodToRefactor actualSourceCodeAfterRefactoring applyRefactoring | + classToRefactor compile: sourceCodeOfMethodToRefactor. + intervalToExtract _ self intervalOf: codeToExtract locatedIn: sourceCodeOfMethodToRefactor. + methodToRefactor _ classToRefactor >> #m1. - self createClassToRefactor. - instance := classToRefactor new. - instance instVarNamed: oldVariable put: 1. - - rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor . - rename apply. + applyRefactoring := [ actualSourceCodeAfterRefactoring := (ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor) apply ]. - self assert: 1 equals: (instance instVarNamed: newVariable). - ! ! + PreferenceNG + withTemporaryValue: leftArrowAssignmentPreference + of: #leftArrowAssignmentsInGeneratedCode + do: applyRefactoring. -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:45:27'! -test15FailsWhenNewVariableEqualsTemporaryVariableOfAMethodInClass + self assert: sourceCodeAfterRefactoring equals: actualSourceCodeAfterRefactoring! ! - | selector | +!ExtractToTemporaryTest methodsFor: 'test helpers' stamp: 'RNG 5/8/2020 21:06:24'! +intervalOf: aPieceOfSourceCode locatedIn: sourceCode - self createClassToRefactor. - selector := #m1. - classToRefactor compile: selector, ' | ', newVariable, ' | ', newVariable, ' := 10.'. - - self - assertCreation: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] - failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. - ! ! + | interval | + interval _ sourceCode intervalOfSubCollection: aPieceOfSourceCode. + ^ (interval first to: interval last - 1) asSourceCodeInterval! ! -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:45:44'! -test16FailsWhenNewVariableEqualsArgumentOfAMethodInClass +!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 2/25/2020 16:28:15'! +test12ItIsPossibleToExtractASingleLiteralFromAMethodWithoutAnyTempsOrArguments - | selector | + | sourceCode sourceCodeAfterRefactoring | + sourceCode _ 'm1 - self createClassToRefactor. - selector := #m1:. - classToRefactor compile: selector, newVariable. - - self - assertCreation: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] - failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. - ! ! + ^ 42'. + sourceCodeAfterRefactoring _ 'm1 -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:45:59'! -test17FailsWhenNewVariableEqualsArgumentOfABlockInAMethodInClass + | new | + new _ 42. + ^ new'. - | selector | + self assertExtracting: '42' from: sourceCode toVariableNamed: 'new' updatesTo: sourceCodeAfterRefactoring! ! - self createClassToRefactor. - selector := #m1. - classToRefactor compile: selector, ' [ :', newVariable, ' | ] value: 1'. - - self - assertCreation: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] - failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. - ! ! +!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 2/25/2020 16:32:52'! +test13ItIsPossibleToExtractASingleExpressionFromAMethodThatHasAlreadyOtherTemporary -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:46:25'! -test18FailsWhenNewVariableEqualsTemporaryOfABlockInAMethodInClass + | sourceCode sourceCodeAfterRefactoring | + sourceCode _ 'm1 - | selector | + | four | + four _ 4. + ^ four + 2'. + sourceCodeAfterRefactoring _ 'm1 - self createClassToRefactor. - selector := #m1. - classToRefactor compile: selector, ' [ | ', newVariable, ' | ] value'. - - self - assertCreation: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] - failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. - ! ! + | four two | + four _ 4. + two _ 2. + ^ four + two'. -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:46:39'! -test19FailsWhenNewVariableIsHiddenInAnyMethodOfAnySubclass + self assertExtracting: '2' from: sourceCode toVariableNamed: 'two' updatesTo: sourceCodeAfterRefactoring! ! - | selector subclass | +!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 3/24/2020 18:04:28'! +test14ItIsPossibleToExtractASingleExpressionFromAMethodThatHasAnEmptyTemporariesDeclaration - self createClassToRefactor. - subclass := self createClassNamed: #SubclassOfClassToRefactor subclassOf: classToRefactor. - selector := #m1. - subclass compile: selector, ' | ', newVariable, ' | '. - - self - assertCreation: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] - failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (subclass>>selector)) ]. - ! ! + | sourceCode sourceCodeAfterRefactoring | + sourceCode _ 'm1 -!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:55:59'! -test20ClassChangeIsAddedWhenRenamingAnInstanceVariable + | | + ^ 3 factorial'. + sourceCodeAfterRefactoring _ 'm1 - | rename classChanges refactorClassChangeSet refactorClassChangeSets | + | f | + f _ 3 factorial. + ^ f'. - "I have to do this because on this case I want to keep track of the changes - Hernan" - [ classToRefactor := self - createClassNamed: self classToRefactorName - subclassOf: Object - instanceVariableNames: oldVariable - classVariableNames: '' - poolDictionaries: '' - category: self classCategoryOfTestData. + self assertExtracting: '3 factorial' from: sourceCode toVariableNamed: 'f' updatesTo: sourceCodeAfterRefactoring! ! - refactorClassChangeSets := ChangeSet allChangeSetsWithClass: classToRefactor. - self assert: 1 = refactorClassChangeSets size description: 'Can not run the test because the class is in more than one changeset (or in none)'. - refactorClassChangeSet := refactorClassChangeSets anyOne. - refactorClassChangeSet removeClassChanges: classToRefactor. - - rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor . - rename apply. - - classChanges := refactorClassChangeSet classChangeAt: classToRefactor name. - self assert: (classChanges includes: #change). ] - ensure: [ | package | - classToRefactor class compile: 'wantsChangeSetLogging ^false'. - ChangeSet allChangeSets remove: refactorClassChangeSet. - package := CodePackage packageOfClass: classToRefactor ifNone: nil. - self assert: package notNil. - package hasUnsavedChanges: false ]. - ! ! +!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 3/24/2020 22:43:08'! +test15ItIsPossibleToExtractCodeAndGenerateAssignmentUsingAnsiAssignmentStyle -!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 5/28/2017 23:26:45'! -allClassCategoriesOfTestData + | sourceCode sourceCodeAfterRefactoring | + sourceCode _ 'm1 - ^Array - with: self classCategoryOfTestData - with: self anotherClassCategoryOfTestData - with: self classCategoryOfTestDataToAvoid ! ! + ^ 42'. + sourceCodeAfterRefactoring _ 'm1 -!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 3/4/2019 14:59:42'! -anotherClassCategoryOfTestData + | new | + new := 42. + ^ new'. - ^self classCategoryOfTestData,'-Another'! ! + self assertExtracting: '42' from: sourceCode toVariableNamed: 'new' updatesTo: sourceCodeAfterRefactoring usingLeftArrowAssignment: false! ! -!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 3/4/2019 14:59:50'! -classCategoryOfTestDataToAvoid +!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 5/4/2020 19:30:06'! +test16ItIsPossibleToExtractASingleLiteralFromABlockWithoutAnyTempsOrArguments - ^self classCategoryOfTestData,'-toAvoid'! ! + | sourceCode sourceCodeAfterRefactoring | + sourceCode _ 'm1 -!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 8/15/2018 12:03:16'! -classToRefactorName + ^ [ self m2 ]'. + sourceCodeAfterRefactoring _ 'm1 - ^#ClassToRenameSelector! ! + ^ [ | new | + new _ self m2 ]'. -!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 12/18/2019 20:32:41'! -createClassToRefactor + self assertExtracting: 'self m2' from: sourceCode toVariableNamed: 'new' updatesTo: sourceCodeAfterRefactoring! ! - classToRefactor := self createClassWithImplementorAndSenderNamed: self classToRefactorName subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. -! ! +!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 4/12/2020 23:32:37'! +test19ItIsPossibleToExtractAnIntervalWithSomeExtraSpaces -!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 5/25/2017 23:14:02'! -createClassWithImplementorAndSenderInMetaTooNamed: aName subclassOf: aSuperclass categorizedAd: aCategory + | sourceCode sourceCodeAfterRefactoring | + sourceCode _ 'm1 - | newClass | - - newClass := self createClassWithImplementorAndSenderNamed: aName subclassOf: aSuperclass categorizedAd: aCategory. - newClass class compile: oldSelector asString. - newClass class compile: senderOfOldSelector asString , ' self ' , oldSelector asString. + ^ 42'. + sourceCodeAfterRefactoring _ 'm1 - ^newClass -! ! + | new | + new _ 42. + ^ new'. -!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 5/28/2017 21:49:40'! -createClassWithImplementorAndSenderNamed: aName subclassOf: aSuperclass categorizedAd: aCategory + self assertExtracting: ' 42' from: sourceCode toVariableNamed: 'new' updatesTo: sourceCodeAfterRefactoring! ! - | newClass | - - newClass := self createClassNamed: aName subclassOf: aSuperclass category: aCategory. - newClass compile: oldSelector asString. - newClass compile: senderOfOldSelector asString , ' self ' , oldSelector asString. +!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 4/24/2020 20:56:58'! +test20ItIsPossibleToExtractAnEmptyBlock - ^newClass -! ! + | sourceCode sourceCodeAfterRefactoring | + sourceCode _ 'm1 -!RenameSelectorTest methodsFor: 'assertions' stamp: 'HAW 11/8/2018 15:30:15'! -assertWasNotRenamedInClass: aClass + ^ []'. + sourceCodeAfterRefactoring _ 'm1 - | senderMethod | - - senderMethod := aClass compiledMethodAt: senderOfOldSelector. - self deny: (senderMethod sendsOrRefersTo: newSelector). - self assert: (senderMethod sendsOrRefersTo: oldSelector)! ! + | new | + new _ []. + ^ new'. -!RenameSelectorTest methodsFor: 'assertions' stamp: 'HAW 3/7/2020 18:44:08'! -assertWasRenamedInClass: aClass - - | senderMethod | - - self assert: (aClass includesSelector: newSelector). - self deny: (aClass includesSelector: oldSelector). - senderMethod := aClass compiledMethodAt: senderOfOldSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). -! ! + self assertExtracting: '[]' from: sourceCode toVariableNamed: 'new' updatesTo: sourceCodeAfterRefactoring! ! -!RenameSelectorTest methodsFor: 'assertions' stamp: 'HAW 3/7/2020 18:44:59'! -assertWasRenamedInClassAndMeta: aClass - - self - assertWasRenamedInClass: aClass; - assertWasRenamedInClass: aClass class! ! +!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 4/25/2020 13:24:55'! +test22ItIsPossibleToExtractACascadeExpression -!RenameSelectorTest methodsFor: 'setup' stamp: 'HAW 5/28/2017 21:46:55'! -setUp + | sourceCode sourceCodeAfterRefactoring | + sourceCode _ 'm1 - super setUp. - - oldSelector := 'oldXyz__' asSymbol. - newSelector := 'newXyz__' asSymbol. - senderOfOldSelector := 'm1__' asSymbol.! ! + ^ 3 factorial; yourself'. + sourceCodeAfterRefactoring _ 'm1 -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 12:03:44'! -test01MessageWithNoSendersCreatesNewMethodAndRemovesOldOne - - | rename | - - classToRefactor := self createClassNamed: self classToRefactorName.. - classToRefactor compile: oldSelector asString. - - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: #(). - rename apply. - self deny: (classToRefactor includesSelector: oldSelector). - self assert: (classToRefactor includesSelector: newSelector) -! ! + | new | + new _ 3 factorial; yourself. + ^ new'. -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:30:40'! -test02SendersOfMessageAreRenamed - - | rename senderMethod | - - self createClassToRefactor. - - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>senderOfOldSelector). - rename apply. - - senderMethod := classToRefactor compiledMethodAt: senderOfOldSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector)! ! + self assertExtracting: '3 factorial; yourself' from: sourceCode toVariableNamed: 'new' updatesTo: sourceCodeAfterRefactoring! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:30:51'! -test03OtherMessagesSendsAreNotRenamed +!ExtractToTemporaryTest methodsFor: 'tests - successful' stamp: 'RNG 5/4/2020 19:11:34'! +test24WhenExtractingAnEntireStatementItOnlyGeneratesTheVariableAssignment - | rename senderMethod selectorToKeep | + | sourceCode sourceCodeAfterRefactoring | + sourceCode _ 'm1 - selectorToKeep := #toKeep. - self createClassToRefactor. - classToRefactor compile: senderOfOldSelector asString , ' self ' , oldSelector asString , '. self ' , selectorToKeep asString. - - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>senderOfOldSelector). - rename apply. - - senderMethod := classToRefactor compiledMethodAt: senderOfOldSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). - self assert: (senderMethod sendsOrRefersTo: selectorToKeep) -! ! + self run'. + sourceCodeAfterRefactoring _ 'm1 -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! -test04OldSelectorCanNotBeEmpty + | action | + action _ self run'. - self - assertCreation: [ RenameSelector from: '' asSymbol to: newSelector implementors: #() senders: #() ] - failsWith: [ RenameSelector oldSelectorCanNotBeEmptyErrorMessage ] -! ! + self assertExtracting: 'self run' from: sourceCode toVariableNamed: 'action' updatesTo: sourceCodeAfterRefactoring! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! -test05NewSelectorCanNotBeEmpty +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 2/25/2020 15:13:05'! +test01NewVariableCanNotBeEmpty + | newVariable sourceCodeToExtract sourceCode intervalToExtract | + newVariable _ ''. + sourceCodeToExtract _ '2'. + sourceCode _ 'm1 ^ 2'. + intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. + classToRefactor compile: sourceCode. + self - assertCreation: [ RenameSelector from: oldSelector to: '' asSymbol implementors: #() senders: #() ] - failsWith: [ RenameSelector newSelectorCanNotBeEmptyErrorMessage ] -! ! + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: (classToRefactor >> #m1) ] + failsWith: [ NewTemporaryPrecondition errorMessageForEmptyTemporaryVariable ]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/30/2019 18:01:00'! -test06CanRenameWithoutImplementors +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 2/25/2020 15:13:01'! +test02NewVariableHasToBeValid - self shouldntFail: [ RenameSelector from: oldSelector to: newSelector implementors: #() senders: #() ] - ! ! + | newVariable sourceCodeToExtract sourceCode intervalToExtract | + newVariable _ 'a b'. + sourceCodeToExtract _ '2'. + sourceCode _ 'm1 ^ ', sourceCodeToExtract. + intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. + classToRefactor compile: sourceCode. + + self + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: (classToRefactor >> #m1) ] + failsWith: [ NewTemporaryPrecondition errorMessageForInvalidTemporaryVariable: newVariable ] + ! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 15:48:43'! -test07AllImplementorsMustImplementOldSelector +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 2/25/2020 15:12:58'! +test03NewVariableNameCanNotBeDefinedInMethod - | invalidImplementors | - - invalidImplementors := Array with: Object>>#printString. + | newVariable sourceCodeToExtract sourceCode intervalToExtract methodToRefactor | + newVariable _ 'new'. + sourceCodeToExtract _ '2'. + sourceCode _ 'm1 | ', newVariable, ' | ^ ', sourceCodeToExtract. + intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. + classToRefactor compile: sourceCode. + methodToRefactor _ classToRefactor >> #m1. self - assertCreation: [ RenameSelector from: oldSelector to: newSelector implementors: invalidImplementors senders: #() ] - failsWith: [ RenameSelector errorMessageForInvalidImplementors: invalidImplementors ] -! ! + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] + failsWith: [ NewTemporaryPrecondition errorMessageForNewTemporaryVariable: newVariable isAlreadyDefinedIn: methodToRefactor methodNode ]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! -test08AllSendersShouldSendOldSelector +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 5/24/2020 20:01:16'! +test04FailsIfNewTemporaryIsEqualToInstanceVariableInClass - | implementors invalidSenders | - - oldSelector := #printString. - implementors := Array with: Object>>oldSelector. - invalidSenders := Array with: Object>>#size. + | newVariable sourceCode sourceCodeToExtract methodToRefactor intervalToExtract | + newVariable _ 'new'. + classToRefactor addInstVarName: newVariable. + sourceCodeToExtract _ '78'. + sourceCode _ 'm1 ^ ', sourceCodeToExtract. + intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. + classToRefactor compile: sourceCode. + methodToRefactor _ classToRefactor >> #m1. self - assertCreation: [ RenameSelector from: oldSelector to: newSelector implementors: implementors senders: invalidSenders ] - failsWith: [ RenameSelector errorMessageForInvalidSenders: invalidSenders of: oldSelector ] -! ! + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] + failsWith: [ NewTemporaryPrecondition errorMessageFor: newVariable canNotBeNamedDueToInstanceVariableDefinedIn: classToRefactor ]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! -test09NewSelectorMustBeOfSameTypeAsOldSelector +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 5/24/2020 20:01:16'! +test05FailsIfNewTemporaryIsEqualToInstanceVariableInAnySuperclass - oldSelector := #size. - newSelector := #+. + | newVariable sourceCode sourceCodeToExtract methodToRefactor superclassToRefactor intervalToExtract | + newVariable _ 'new'. + superclassToRefactor _ self createClassNamed: #ClassToRefactorSuperclass instanceVariableNames: newVariable. + classToRefactor superclass: superclassToRefactor. + sourceCodeToExtract _ '78'. + sourceCode _ 'm1 ^ ', sourceCodeToExtract. + intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. + classToRefactor compile: sourceCode. + methodToRefactor _ classToRefactor >> #m1. self - assertCreation: [ RenameSelector from: oldSelector to: newSelector implementors: #() senders: #() ] - failsWith: [ RenameSelector errorMessageForNewSelector: newSelector isNotOfSameTypeAs: oldSelector ] -! ! + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] + failsWith: [ NewTemporaryPrecondition errorMessageFor: newVariable canNotBeNamedDueToInstanceVariableDefinedIn: superclassToRefactor ]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! -test10NewSelectorMustHaveSameNumberOfArgumentsAsOldSelector +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 17:10:14'! +test06SourceCodeToExtractCanNotIncludeReturn - oldSelector := #printOn:. - newSelector := #do:separatedBy:. + | newVariable sourceCode sourceCodeToExtract intervalToExtract methodToRefactor | + newVariable := 'new'. + sourceCodeToExtract := '^ 1'. + sourceCode := 'm1 ', sourceCodeToExtract. + intervalToExtract := self intervalOf: sourceCodeToExtract locatedIn: sourceCode. + classToRefactor compile: sourceCode. + methodToRefactor := classToRefactor >> #m1. self - assertCreation: [ RenameSelector from: oldSelector to: newSelector implementors: #() senders: #() ] - failsWith: [ RenameSelector errorMessageForNewSelector: newSelector doesNotHaveSameNumberOfArgumentsAs: oldSelector ] -! ! + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] + failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForSourceCodeIncludingAReturnStatement ]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! -test11NewImplementorsKeepMethodCategory - - | rename oldSelectorCategory | - - oldSelectorCategory := 'oldSelectorCategory'. - self createClassToRefactor. - classToRefactor organization classify: oldSelector under: oldSelectorCategory. - - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>senderOfOldSelector). - rename apply. +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 2/25/2020 15:12:44'! +test07SourceCodeToExtractCanNotBeEmpty + + | newVariable sourceCode sourceCodeToExtract intervalToExtract methodToRefactor | + newVariable _ 'new'. + sourceCodeToExtract _ ' '. + sourceCode _ 'm1 ^ 1'. + intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. + classToRefactor compile: sourceCode. + methodToRefactor _ classToRefactor >> #m1. - self assert: oldSelectorCategory equals: (classToRefactor organization categoryOfElement: newSelector) -! ! + self + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] + failsWith: [ ExtractToTemporary errorMessageForSourceCodeToExtractCanNotBeEmpty]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:30:58'! -test12RenamesRecursiveMethodsWhenNotInSenders +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 16:53:38'! +test08SourceCodeToExtractCanNotHaveSyntaxErrors - | rename senderMethod | - - self createClassToRefactor. - classToRefactor compile: oldSelector asString , ' self ' , oldSelector asString. - - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: #(). - rename apply. + | newVariable sourceCode sourceCodeToExtract intervalToExtract methodToRefactor expectedSyntaxErrorMessage | + newVariable _ 'new'. + sourceCodeToExtract _ '1 +'. + sourceCode _ 'm1 ^ 1 + 3'. + intervalToExtract _ self intervalOf: sourceCodeToExtract locatedIn: sourceCode. + classToRefactor compile: sourceCode. + methodToRefactor _ classToRefactor >> #m1. + + [ Parser parse: sourceCodeToExtract class: classToRefactor noPattern: true. + self fail. ] + on: SyntaxErrorNotification + do: [ :anError | expectedSyntaxErrorMessage _ anError messageText]. - senderMethod := classToRefactor compiledMethodAt: newSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector) -! ! + self + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] + failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForSourceCodeToExtractHasSyntaxError: expectedSyntaxErrorMessage ]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:31:04'! -test13RenamesRecursiveMethodsWhenInSenders +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 16:18:15'! +test09SourceCodeToExtractHasToBeOneStatement - | rename senderMethod implementorsAndSenders | - - self createClassToRefactor. - classToRefactor compile: oldSelector asString , ' self ' , oldSelector asString. - implementorsAndSenders := Array with: classToRefactor>>oldSelector. - - rename := RenameSelector from: oldSelector to: newSelector implementors: implementorsAndSenders senders: implementorsAndSenders. - rename apply. + | newVariable sourceCode sourceCodeToExtract intervalToExtract methodToRefactor | + newVariable := 'new'. + sourceCodeToExtract := '1+2. 3+4'. + sourceCode := 'm1 ', sourceCodeToExtract. + intervalToExtract := self intervalOf: sourceCodeToExtract locatedIn: sourceCode. + classToRefactor compile: sourceCode. + methodToRefactor := classToRefactor >> #m1. - senderMethod := classToRefactor compiledMethodAt: newSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector) -! ! + self + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] + failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForSourceCodeToExtractHasToBeOneStatement ]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:27:09'! -test14RenamesSymbolsEqualToOldSelector +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 2/25/2020 15:12:27'! +test10FailsIfIntervalToExtractIsBeforeMethodSourceCodeBoundaries - | rename senderMethod referencerToOldSelector | - - referencerToOldSelector := #m1. - self createClassToRefactor. - classToRefactor compile: oldSelector asString. - classToRefactor compile: referencerToOldSelector asString , ' #' , oldSelector asString, ' size'. + | newVariable sourceCode methodToRefactor | + newVariable _ 'new'. + sourceCode _ 'm1 ^ 1'. + classToRefactor compile: sourceCode. + methodToRefactor _ classToRefactor >> #m1. - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). - rename apply. - - senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector) -! ! + self + assertCreation: [ ExtractToTemporary named: newVariable at: (-1 to: 2) from: methodToRefactor ] + failsWith: [ ExtractToTemporary errorMessageForSourceCodeSelectionOutOfBounds ]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:34:01'! -test15ScopeToRenameCanBeClassOnly - - | rename anotherClassSendingMessage | - - classToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. - - anotherClassSendingMessage := self createClassNamed: #ClassToAvoidRenameSelector. - anotherClassSendingMessage compile: senderOfOldSelector asString , ' self ' , oldSelector asString. +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 2/25/2020 15:22:19'! +test11FailsIfIntervalToExtractIsAfterMethodSourceCodeBoundaries - rename := RenameSelector from: oldSelector to: newSelector in: classToRefactor. - rename apply. - - self assertWasRenamedInClassAndMeta: classToRefactor. - self assertWasNotRenamedInClass: anotherClassSendingMessage ! ! + | newVariable sourceCode methodToRefactor | + newVariable _ 'new'. + sourceCode _ 'm1 ^ 1'. + classToRefactor compile: sourceCode. + methodToRefactor _ classToRefactor >> #m1. -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:07:15'! -test16ScopeToRenameCanBeHierarchyOnly - - | rename anotherClassSendingMessage superclassToRefactor subclassToRefactor | - - superclassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #SuperclassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. - classToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName subclassOf: superclassToRefactor categorizedAd: self classCategoryOfTestData. - subclassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #SubclassToRenameSelector subclassOf: classToRefactor categorizedAd: self classCategoryOfTestData. + self + assertCreation: [ ExtractToTemporary named: newVariable at: (sourceCode size - 1 to: sourceCode size + 2) from: methodToRefactor ] + failsWith: [ ExtractToTemporary errorMessageForSourceCodeSelectionOutOfBounds ]! ! - anotherClassSendingMessage := self createClassNamed: #ClassToAvoidRenameSelector. - anotherClassSendingMessage compile: senderOfOldSelector asString , ' self ' , oldSelector asString. +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 18:47:52'! +test17CannotExtractPartOfMethodName - rename := RenameSelector from: oldSelector to: newSelector inHierarchyOf: classToRefactor. - rename apply. - - self assertWasRenamedInClassAndMeta: superclassToRefactor. - self assertWasRenamedInClassAndMeta: classToRefactor. - self assertWasRenamedInClassAndMeta: subclassToRefactor. - self assertWasNotRenamedInClass: anotherClassSendingMessage ! ! + | newVariable sourceCode methodToRefactor intervalToExtract sourceCodeToExtract | + newVariable := 'new'. + sourceCode := 'm1 ^ 1'. + classToRefactor compile: sourceCode. + sourceCodeToExtract := 'm1'. + intervalToExtract := self intervalOf: sourceCodeToExtract locatedIn: sourceCode. + methodToRefactor := classToRefactor >> #m1. -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:07:32'! -test17ScopeToRenameCanBeCategoryOnly - - | rename anotherClassSendingMessage anotherClassToRefactor | - - classToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. - anotherClassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #AnotherclassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. - - anotherClassSendingMessage := self createClassNamed: #ClassToAvoidRenameSelector category: self classCategoryOfTestDataToAvoid. - anotherClassSendingMessage compile: senderOfOldSelector asString , ' self ' , oldSelector asString. + self + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] + failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForExtractingPartOfMethodSignature ]! ! - rename := RenameSelector from: oldSelector to: newSelector inCategoryOf: classToRefactor organizedBy: SystemOrganization. - rename apply. +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 16:20:08'! +test18CannotExtractPartOfMessageSend - self assertWasRenamedInClassAndMeta: classToRefactor. - self assertWasRenamedInClassAndMeta: anotherClassToRefactor. - self assertWasNotRenamedInClass: anotherClassSendingMessage - ! ! + | newVariable sourceCode methodToRefactor intervalToExtract sourceCodeToExtract | + newVariable := 'new'. + sourceCode := 'm1 ^ self m2'. + classToRefactor compile: sourceCode. + sourceCodeToExtract := 'm2'. + intervalToExtract := self intervalOf: sourceCodeToExtract locatedIn: sourceCode. + methodToRefactor := classToRefactor >> #m1. -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:07:49'! -test18ScopeToRenameCanBeCategoriesAndHierarchyOnly - - | rename anotherClassSendingMessage superclassToRefactor subclassToRefactor anotherClassToRefactor classInOtherCategoryToRefactor | - - superclassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #SuperclassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self anotherClassCategoryOfTestData. - classToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName subclassOf: superclassToRefactor categorizedAd: self classCategoryOfTestData. - subclassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #SubclassToRenameSelector subclassOf: classToRefactor categorizedAd: self classCategoryOfTestData. - anotherClassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #AnotheclassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. - classInOtherCategoryToRefactor := self - createClassWithImplementorAndSenderInMetaTooNamed: #OtherCatClassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self anotherClassCategoryOfTestData. - - anotherClassSendingMessage := self createClassNamed: #ClassToAvoidRenameSelector category: self classCategoryOfTestDataToAvoid. - anotherClassSendingMessage compile: senderOfOldSelector asString , ' self ' , oldSelector asString. + self + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] + failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForSourceCodeContainingInvalidExpression ]! ! - rename := RenameSelector from: oldSelector to: newSelector inCategoriesAndHierarchyOf: classToRefactor organizedBy: SystemOrganization. - rename apply. +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 16:20:48'! +test21CannotExtractLeftSideOfAssignment - self assertWasRenamedInClassAndMeta: superclassToRefactor. - self assertWasRenamedInClassAndMeta: classToRefactor. - self assertWasRenamedInClassAndMeta: subclassToRefactor. - self assertWasRenamedInClassAndMeta: anotherClassToRefactor. - self assertWasRenamedInClassAndMeta: classInOtherCategoryToRefactor. - self assertWasNotRenamedInClass: anotherClassSendingMessage ! ! + | newVariable sourceCode methodToRefactor intervalToExtract | + newVariable := 'new'. + sourceCode := 'm1 | existing | existing := 2'. + classToRefactor compile: sourceCode. + intervalToExtract := (17 to: 24) asSourceCodeInterval. "second occurrence of 'existing' variable " + methodToRefactor := classToRefactor >> #m1. -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:08:00'! -test19ScopeToRenameCanBeTheCompleteSystem - - | rename anotherClassToRefactor | - - classToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. - anotherClassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #AnotherclassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. + self + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] + failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForSourceCodeContainingInvalidExpression ]! ! - rename := RenameSelector from: oldSelector to: newSelector inSystem: Smalltalk. - "This is just to be sure that no more than the expected methods will be renamed because I'm using Smalltalk as system. - I could mock Smalltalk but I want to have a real test using Smalltalk, not a mock, that it is why I have these assertions here - Hernan" - self assert: 4 equals: rename implementorsSize. - self assert: 4 equals: rename sendersSize. - - rename apply. +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 4/26/2020 15:23:20'! +test23CannotUseAReservedNameAsTheNewTemporaryVariable - self assertWasRenamedInClassAndMeta: classToRefactor. - self assertWasRenamedInClassAndMeta: anotherClassToRefactor -! ! + | intervalToExtract methodToRefactor newVariable sourceCode | -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! -test20CanNotRenameToItSelf + ClassBuilder reservedNames do: [ :reservedName | + newVariable := reservedName asString. + sourceCode := 'm1 ^ 2'. + classToRefactor compile: sourceCode. + intervalToExtract := self intervalOf: '2' locatedIn: sourceCode. + methodToRefactor := classToRefactor >> #m1. - self - assertCreation: [ RenameSelector from: oldSelector to: oldSelector asSymbol implementors: #() senders: #() ] - failsWith: [ RenameSelector newSelectorEqualToOldSelectorErrorMessage ] -! ! + self + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] + failsWith: [ NewTemporaryPrecondition errorMessageForNewTemporaryVariableCanNotBeAReservedName: newVariable ] ]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! -test21NewSelectorCanNotBeImplementedOnAnyClassImplementingOldSelector +!ExtractToTemporaryTest methodsFor: 'tests - validations' stamp: 'RNG 7/12/2020 18:48:18'! +test25CannotExtractArgumentNamesFromMethodSignature - | implementors | - - oldSelector := #printString. - newSelector := #size. - implementors := Array with: Object>>oldSelector. - - self - assertCreation: [ RenameSelector from: oldSelector to: newSelector implementors: implementors senders: #() ] - failsWith: [ RenameSelector errorMessageForNewSelector: newSelector implementedInAll: (Array with: Object) ] -! ! + | intervalToExtract methodToRefactor newVariable sourceCode | + newVariable := 'new'. + sourceCode := 'm1: arg ^ self'. + classToRefactor compile: sourceCode. + intervalToExtract := self intervalOf: 'arg' locatedIn: sourceCode. + methodToRefactor := classToRefactor >> #m1:. -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! -test22WarnsWhenOverridesSuperclassImplementation + self + assertCreation: [ ExtractToTemporary named: newVariable at: intervalToExtract from: methodToRefactor ] + failsWith: [ SourceCodeOfTemporaryToBeExtractedPrecondition errorMessageForExtractingPartOfMethodSignature ]! ! - | implementors | +!InlineMethodTest methodsFor: 'refactoring helpers' stamp: 'FB 11/3/2021 19:50:39'! +messageNodeReferenceOf: anImplementor inMethod: aMethodName atIndex: aSourceCodeIndex + + | nodeToInline methodNode sourceCodeRange nodeAndRange | + + methodNode := (anImplementor >> aMethodName asSymbol) methodNode. + nodeAndRange := (methodNode + parseNodesPathAt: aSourceCodeIndex ifAbsent: [self fail]) first. + nodeToInline := nodeAndRange key. + (nodeToInline isKindOf: MessageNode ) ifFalse: [self failWith: 'There is no message node at the selected + class, method and index']. + sourceCodeRange := nodeAndRange value. + + ^MessageNodeReference messageNode: nodeToInline selector: methodNode selector + class: anImplementor completeSourceRange: sourceCodeRange .! ! + +!InlineMethodTest methodsFor: 'tests - validations' stamp: 'FB 4/8/2022 23:51:52'! +test12CanNotInlineMethodAccessingPrivateVariablesNotVisibleToSender + + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsageSelector methodWithUsageSource + implementorClass senderClass | + + implementorClass := self createClassNamed: self implementorClass. + implementorClass addInstVarName: 'y'. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' y := 10. ^y.'. + implementorClass compile: methodToInlineSource. + + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' ^', implementorClass name, ' new ', methodToInlineSelector. + senderClass compile: methodWithUsageSource. + + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsageSelector atIndex: 42. + self assertCreation: [ + InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + ] failsWith: [InlineMethod methodAccessPrivateVariablesNotVisibleToSenderErrorMessage ]! ! + +!InlineMethodTest methodsFor: 'tests - validations' stamp: 'FB 11/3/2021 23:50:29'! +test13CanNotInlineMethodWithMultipleReturns + + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsageSelector methodWithUsageSource + implementorClass senderClass | + + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y | y := 10. (y > 9) ifTrue: [^y]. ^20.'. + implementorClass compile: methodToInlineSource. + + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' ^', implementorClass name, ' new ', methodToInlineSelector. + senderClass compile: methodWithUsageSource. + + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsageSelector atIndex: 42. + self assertCreation: [ + InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + ] failsWith: [InlineMethod methodHasMultipleReturnsErrorMessage]! ! + +!InlineMethodTest methodsFor: 'tests - validations' stamp: 'FB 11/3/2021 23:50:36'! +test14CanNotInlineMethodWithExplicitAndImplicitReturns + + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsageSelector methodWithUsageSource + implementorClass senderClass | + + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y | y := 10. (y > 9) ifTrue: [^y]'. "Implicit ^self" + implementorClass compile: methodToInlineSource. + + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' ^', implementorClass name, ' new ', methodToInlineSelector. + senderClass compile: methodWithUsageSource. + + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsageSelector atIndex: 42. + self assertCreation: [ + InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + ] failsWith: [InlineMethod methodHasMultipleReturnsErrorMessage]! ! + +!InlineMethodTest methodsFor: 'tests - validations' stamp: 'FB 4/14/2022 15:23:05'! +test24CanNotInlineCascadingMessageSend + + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsageSelector + methodWithUsagesSource implementorAndSenderClass | + + implementorAndSenderClass := self createClassNamed: self implementorClass. + methodToInlineSelector := 'm2' asSymbol. + methodToInlineSource := methodToInlineSelector, ' ^5'. + implementorAndSenderClass compile: methodToInlineSource. - oldSelector := #negated. - newSelector := #size. - implementors := Array with: Number>>oldSelector. + methodWithUsageSelector := 'm3' asSymbol. + methodWithUsagesSource := methodWithUsageSelector, ' self m1 ; m2.'. - self - assertCreation: [ RenameSelector from: oldSelector to: newSelector implementors: implementors senders: #() ] - warnsWith: [ RenameSelector warningMessageForImplementationOf: newSelector in: Number willOverrideImplementationIn: Object ] -! ! - -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/29/2018 14:14:49'! -test23OldSelectorIsRenamedWhenDefinedInLiteralArray - - | rename senderMethod referencerToOldSelector | + implementorAndSenderClass compile: methodWithUsagesSource. - referencerToOldSelector := #m1. - self createClassToRefactor. - classToRefactor compile: oldSelector asString. - classToRefactor compile: referencerToOldSelector asString , ' ^#(#' , oldSelector asString, ')'. - - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). - rename apply. + nodeToInline := self messageNodeReferenceOf: implementorAndSenderClass inMethod: methodWithUsageSelector atIndex: 15. - senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector) -! ! + self assertCreation: [ + InlineMethod + from: implementorAndSenderClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + ] failsWith: [InlineMethod messageSendCanNotBeCascadeErrorMessage ]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/29/2018 15:20:23'! -test24OldSelectorIsRenamedWhenDefinedInLiteralArrayMoreThanOnce +!InlineMethodTest methodsFor: 'tests - validations' stamp: 'FB 5/21/2022 17:10:00'! +test25CanNotInlineMethodFromAnotherClassReferencingSuper - | rename senderMethod referencerToOldSelector | + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsageSelector methodWithUsageSource + implementorClass senderClass | - referencerToOldSelector := #m1. - self createClassToRefactor. - classToRefactor compile: oldSelector asString. - classToRefactor compile: referencerToOldSelector asString , ' ^#(#' , oldSelector asString, ' #' , oldSelector asString,')'. - - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). - rename apply. + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y z | y := 10. super m3. ^y.'. + implementorClass compile: methodToInlineSource. - senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector) -! ! - -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/29/2018 15:22:15'! -test25OldSelectorIsRenamedWhenDefinedInMoreThanOneLiteralArrayMoreThanOnce - - | rename senderMethod referencerToOldSelector | + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t y | ^', implementorClass name, ' new ', methodToInlineSelector. + senderClass compile: methodWithUsageSource. - referencerToOldSelector := #m1. - self createClassToRefactor. - classToRefactor compile: oldSelector asString. - classToRefactor compile: referencerToOldSelector asString , ' ^#(#' , oldSelector asString, ' #' , oldSelector asString,'), #(#' , oldSelector asString, ' #' , oldSelector asString,')'. - - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). - rename apply. + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsageSelector atIndex: 51. - senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector) -! ! + self assertCreation: [ + InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + ] failsWith: [InlineMethod methodToInlineReferencesSuperErrorMessage ]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/29/2018 15:24:47'! -test26DoesNotRenameLiteralsThatBeginsWithOldSelectorInsideLiteralArray +!InlineMethodTest methodsFor: 'tests - validations' stamp: 'FB 5/21/2022 17:22:49'! +test26CanNotInlineMethodFromAnotherClassReferencingSelfWhenReceiverIsNotAVariable - | rename senderMethod referencerToOldSelector | + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsageSelector methodWithUsageSource + implementorClass senderClass | - referencerToOldSelector := #m1. - self createClassToRefactor. - classToRefactor compile: oldSelector asString. - classToRefactor compile: referencerToOldSelector asString , ' ^#(#' , oldSelector asString, ' #' , oldSelector asString,'1)'. - - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). - rename apply. + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y z | y := 10. self m3. ^y.'. + implementorClass compile: methodToInlineSource. - senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). - self assert: (senderMethod sendsOrRefersTo: (oldSelector,'1') asSymbol) -! ! - -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/30/2018 15:04:14'! -test27DoesNotRenameLiteralsThatBeginsWithOldSelectorAndEndWithColonInsideLiteralArray - - | rename senderMethod referencerToOldSelector | + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t y | ^', implementorClass name, ' new ', methodToInlineSelector. + senderClass compile: methodWithUsageSource. - referencerToOldSelector := #m1. - self createClassToRefactor. - classToRefactor compile: oldSelector asString. - classToRefactor compile: referencerToOldSelector asString , ' ^#(#' , oldSelector asString, ' #' , oldSelector asString,':)'. - - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). - rename apply. + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsageSelector atIndex: 51. - senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). - self assert: (senderMethod sendsOrRefersTo: (oldSelector,':') asSymbol) -! ! + self assertCreation: [ + InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + ] failsWith: [InlineMethod methodToInlineReferencesSelfErrorMessage]! ! -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/13/2018 18:46:23'! -test28CanRenameFromBinaryToKeywordOfOneParameter +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/3/2021 19:40:24'! +test01InlineMethodOfSameClassWithoutReturnValue - | rename senderMethod referencerToOldSelector | + | implementorAndSenderClass methodToInlineSource methodToInlineSelector + nodeToInline methodWithUsageSelector methodWithUsageSource expectedNewSourceCode refactoring | - referencerToOldSelector := #m1. - oldSelector := '&&' asSymbol. - newSelector := 'abc:' asSymbol. - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' aParameter'. - classToRefactor compile: referencerToOldSelector asString , ' ^self ' , oldSelector asString,' 1'. - - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). - rename apply. + implementorAndSenderClass := self createClassNamed: self implementorClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' self doSomething.'. + implementorAndSenderClass compile: methodToInlineSource. - self assert: (classToRefactor includesSelector: newSelector). - self deny: (classToRefactor includesSelector: oldSelector). - senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). -! ! - -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/13/2018 18:53:24'! -test29CanRenameFromKeywordOfOneParameterToBinary - - | rename senderMethod referencerToOldSelector | + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t | self m1. ^t'. + implementorAndSenderClass compile: methodWithUsageSource. - referencerToOldSelector := #m1. - oldSelector := 'abc:' asSymbol. - newSelector := '&&' asSymbol. - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' aParameter'. - classToRefactor compile: referencerToOldSelector asString , ' ^self ' , oldSelector asString,' 1'. - - rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). - rename apply. + nodeToInline := self messageNodeReferenceOf: implementorAndSenderClass inMethod: methodWithUsageSelector atIndex: 15. - self assert: (classToRefactor includesSelector: newSelector). - self deny: (classToRefactor includesSelector: oldSelector). - senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. - self deny: (senderMethod sendsOrRefersTo: oldSelector). - self assert: (senderMethod sendsOrRefersTo: newSelector). -! ! - -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/13/2018 19:00:10'! -test30CanNotRenameFromBinaryToKeywordOfMoreThanOneParameter - - oldSelector := '&&' asSymbol. - newSelector := 'abc:def:' asSymbol. - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: oldSelector asString, ' aParameter'. - - self - should: [ RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: #() ] - raise: Error - withMessageText: (RenameSelector errorMessageForNewSelector: newSelector isNotOfSameTypeAs: oldSelector)! ! - -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/13/2018 18:59:39'! -test31CanNotRenameFromKeywordOfOneParameterToBinary - - oldSelector := 'abc:def:' asSymbol. - newSelector := '&&' asSymbol. - classToRefactor := self createClassNamed: self classToRefactorName. - classToRefactor compile: 'abc: p1 def: p2'. - - self - should: [ RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: #() ] - raise: Error - withMessageText: (RenameSelector errorMessageForNewSelector: newSelector isNotOfSameTypeAs: oldSelector)! ! - -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:08:36'! -test32HierarchyScopeRenamesSelectorsFromSuperclassDefiningSelector + refactoring := InlineMethod + from: implementorAndSenderClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. - | rename superclassToRefactor subclassToRefactor | + refactoring apply. - superclassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #SuperclassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. - classToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName subclassOf: superclassToRefactor categorizedAd: self classCategoryOfTestData. - subclassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #SubclassToRenameSelector subclassOf: superclassToRefactor categorizedAd: self classCategoryOfTestData. + expectedNewSourceCode := methodWithUsageSelector,' | t | self doSomething. ^t'. + self assert: expectedNewSourceCode equals: (implementorAndSenderClass >> methodWithUsageSelector) sourceCode! ! - rename := RenameSelector from: oldSelector to: newSelector inHierarchyOf: classToRefactor. - rename apply. - - self assertWasRenamedInClassAndMeta: superclassToRefactor. - self assertWasRenamedInClassAndMeta: classToRefactor. - self assertWasRenamedInClassAndMeta: subclassToRefactor. - ! ! +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/3/2021 23:47:31'! +test02InlineMethodOfSameClassWithParametersAndWithoutReturnValue -!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 3/7/2020 18:48:46'! -test33DoNotRenameSendersAndImplementorsWhoseCompilerClassIsDifferentToCompiler + | implementorAndSenderClass methodToInlineSource methodToInlineSelector + nodeToInline methodWithUsageSelector methodWithUsageSource expectedNewSourceCode refactoring | - "Requested by Phil B. to avoid refactoring OMeta2 classes - Hernan" + implementorAndSenderClass := self createClassNamed: self implementorClass. + methodToInlineSelector := 'm1:with:' asSymbol. + methodToInlineSource := 'm1: firstParam with: secondParam + self use: firstParam. + self doSomethingWithParam: firstParam andParam: secondParam.'. + implementorAndSenderClass compile: methodToInlineSource. - | rename anotherClassSendingMessage | + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t | self m1: 5 with: ''aString''. + ^t'. + implementorAndSenderClass compile: methodWithUsageSource. - classToRefactor := self - createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName - subclassOf: RefactoringClassTestData - categorizedAd: self classCategoryOfTestData. + nodeToInline := self messageNodeReferenceOf: implementorAndSenderClass inMethod: methodWithUsageSelector atIndex: 15. - anotherClassSendingMessage := self - createClassWithImplementorAndSenderInMetaTooNamed: #ClassToAvoidRenameSelector - subclassOf: RefactoringClassTestData - categorizedAd: self classCategoryOfTestData. + refactoring := InlineMethod + from: implementorAndSenderClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. - anotherClassSendingMessage class compile: 'compilerClass ^nil'. - - rename := RenameSelector - from: oldSelector - to: newSelector - inCategoryOf: classToRefactor - organizedBy: SystemOrganization. - rename apply. - - self assertWasRenamedInClassAndMeta: classToRefactor. - self assertWasNotRenamedInClass: anotherClassSendingMessage. - self assertWasRenamedInClass: anotherClassSendingMessage class. - ! ! - -!RenameTemporaryTest methodsFor: 'class factory' stamp: 'HAW 6/25/2017 21:53:44'! -classToRefactorName - - ^#ClassToRenameTemp! ! - -!RenameTemporaryTest methodsFor: 'class factory' stamp: 'HAW 6/25/2017 21:53:44'! -methodNodeOf: aSourceCode - - ^self methodNodeOf: aSourceCode in: self class! ! - -!RenameTemporaryTest methodsFor: 'class factory' stamp: 'HAW 8/9/2018 23:23:12'! -methodNodeOf: aSourceCode in: aClass - - ^aClass methodNodeFor: aSourceCode ! ! + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector,' | t | self use: 5. +self doSomethingWithParam: 5 andParam: ''aString''. + ^t'. + self assert: expectedNewSourceCode equals: (implementorAndSenderClass >> methodWithUsageSelector) sourceCode! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 10/4/2017 17:04:33'! -test01VariableToRenameHasToBeDefined +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/3/2021 23:47:48'! +test03InlineMethodOfSameClassReturningConstantLiteral - | newVariable oldVariable methodNode | + | implementorAndSenderClass methodToInlineSource methodToInlineSelector + nodeToInline methodWithUsageSelector methodWithUsageSource expectedNewSourceCode refactoring | + + implementorAndSenderClass := self createClassNamed: self implementorClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' ^10.'. + implementorAndSenderClass compile: methodToInlineSource. - oldVariable := 'old'. - newVariable := 'new'. + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t | t := self m1. ^t'. + implementorAndSenderClass compile: methodWithUsageSource. - methodNode := self methodNodeOf: 'm1'. + nodeToInline := self messageNodeReferenceOf: implementorAndSenderClass inMethod: methodWithUsageSelector atIndex: 20. - self - assertCreation: [ RenameTemporary from: oldVariable to: newVariable in: methodNode ] - failsWith: [ RenameTemporary errorMessageForTemporaryVariable: oldVariable notDefinedIn: methodNode ]! ! + refactoring := InlineMethod + from: implementorAndSenderClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector,' | t | t := 10. ^t'. + self assert: expectedNewSourceCode equals: (implementorAndSenderClass >> methodWithUsageSelector) sourceCode! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 2/25/2020 00:02:32'! -test02NewVariableNameCanNotBeEmpty +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/3/2021 23:47:57'! +test04InlineMethodOfSameClassWithMultipleStatementsAndReturn - | methodNode newVariable oldVariable | + | implementorAndSenderClass methodToInlineSource methodToInlineSelector + nodeToInline methodWithUsageSelector methodWithUsageSource expectedNewSourceCode refactoring | - oldVariable := 'old'. - newVariable := ' '. + implementorAndSenderClass := self createClassNamed: self implementorClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' self m3. +self m4: 5. + ^10.'. + implementorAndSenderClass compile: methodToInlineSource. - methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | '. + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t | t := self m1. ^t'. + implementorAndSenderClass compile: methodWithUsageSource. - self - assertCreation: [ RenameTemporary from: oldVariable to: newVariable in: methodNode ] - failsWith: [ NewTemporaryPrecondition errorMessageForEmptyTemporaryVariable ]! ! + nodeToInline := self messageNodeReferenceOf: implementorAndSenderClass inMethod: methodWithUsageSelector atIndex: 20. + + refactoring := InlineMethod + from: implementorAndSenderClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector,' | t | self m3. +self m4: 5. +t := 10. ^t'. + self assert: expectedNewSourceCode equals: (implementorAndSenderClass >> methodWithUsageSelector) sourceCode! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 2/25/2020 00:06:33'! -test03NewVariableHasToBeValid +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/3/2021 23:48:05'! +test05InlineMethodOfSameClassWithUnusedReturn - | methodNode newVariable oldVariable | + | implementorAndSenderClass methodToInlineSource methodToInlineSelector + nodeToInline methodWithUsageSelector methodWithUsageSource expectedNewSourceCode refactoring | - oldVariable := 'old'. - newVariable := 'a b'. + implementorAndSenderClass := self createClassNamed: self implementorClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' self m3. ^10.'. + implementorAndSenderClass compile: methodToInlineSource. - methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | '. + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' self m1. ^20'. + implementorAndSenderClass compile: methodWithUsageSource. - self - assertCreation: [ RenameTemporary from: oldVariable to: newVariable in: methodNode ] - failsWith: [ NewTemporaryPrecondition errorMessageForInvalidTemporaryVariable: newVariable ] - ! ! + nodeToInline := self messageNodeReferenceOf: implementorAndSenderClass inMethod: methodWithUsageSelector atIndex: 9. + + refactoring := InlineMethod + from: implementorAndSenderClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector,' self m3. ^20'. + self assert: expectedNewSourceCode equals: (implementorAndSenderClass >> methodWithUsageSelector) sourceCode! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 2/25/2020 00:07:12'! -test04NewVariableNameCanNotBeDefinedInMethod +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/3/2021 23:48:13'! +test06InlineMethodOfSameClassThatDeclaresTemporaryVariables - | methodNode oldVariable | + | implementorAndSenderClass methodToInlineSource methodToInlineSelector + nodeToInline methodWithUsageSelector methodWithUsageSource expectedNewSourceCode refactoring | - oldVariable := 'old'. + implementorAndSenderClass := self createClassNamed: self implementorClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y z | y := 10. self m3. ^y.'. + implementorAndSenderClass compile: methodToInlineSource. - methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | '. + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t | t := self m1. ^20'. + implementorAndSenderClass compile: methodWithUsageSource. - self - assertCreation: [RenameTemporary from: oldVariable to: oldVariable in: methodNode ] - failsWith: [ NewTemporaryPrecondition errorMessageForNewTemporaryVariable: oldVariable isAlreadyDefinedIn: methodNode ]! ! + nodeToInline := self messageNodeReferenceOf: implementorAndSenderClass inMethod: methodWithUsageSelector atIndex: 20. + + refactoring := InlineMethod + from: implementorAndSenderClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector,' | t y z | y := 10. +self m3. +t := y. ^20'. + self assert: expectedNewSourceCode equals: (implementorAndSenderClass >> methodWithUsageSelector) sourceCode! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 5/24/2020 20:01:16'! -test05FailsIfNewTemporaryIsEqualToInstanceVariableInClass +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/3/2021 23:49:35'! +test07InlineMethodOfSameClassThatDeclaresTemporaryVariablesAlreadyDeclared - | methodNode oldVariable newVariable classToRefactor | + | implementorAndSenderClass methodToInlineSource methodToInlineSelector + nodeToInline methodWithUsageSelector methodWithUsageSource expectedNewSourceCode refactoring | - oldVariable := 'old'. - newVariable := 'new'. + implementorAndSenderClass := self createClassNamed: self implementorClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y z | y := 10. self m3. ^y.'. + implementorAndSenderClass compile: methodToInlineSource. - classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: newVariable. - methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | ' in: classToRefactor. + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t y | t := self m1. ^20'. + implementorAndSenderClass compile: methodWithUsageSource. - self - assertCreation: [ RenameTemporary from: oldVariable to: newVariable in: methodNode ] - failsWith: [ NewTemporaryPrecondition errorMessageFor: newVariable canNotBeNamedDueToInstanceVariableDefinedIn: classToRefactor ]! ! + nodeToInline := self messageNodeReferenceOf: implementorAndSenderClass inMethod: methodWithUsageSelector atIndex: 22. + + refactoring := InlineMethod + from: implementorAndSenderClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector,' | t y y1 z | y1 := 10. +self m3. +t := y1. ^20'. + self assert: expectedNewSourceCode equals: (implementorAndSenderClass >> methodWithUsageSelector) sourceCode! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 5/24/2020 20:01:16'! -test06FailsIfNewTemporaryIsEqualToInstanceVariableInAnySuperclass +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/3/2021 23:49:44'! +test08InlineMethodDeclaresVariablesInClosestScope - | methodNode oldVariable newVariable classToRefactor superclassToRefactor | + | implementorAndSenderClass methodToInlineSource methodToInlineSelector + nodeToInline methodWithUsageSelector methodWithUsageSource expectedNewSourceCode refactoring | - oldVariable := 'old'. - newVariable := 'new'. + implementorAndSenderClass := self createClassNamed: self implementorClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y z | y := 10. self m3. ^y.'. + implementorAndSenderClass compile: methodToInlineSource. - superclassToRefactor := self createClassNamed: #ClassToRefactorSuperclass instanceVariableNames: newVariable. - classToRefactor := self createClassNamed: self classToRefactorName subclassOf: superclassToRefactor. - methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | ' in: classToRefactor. + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t y | t := [self m1]. ^20'. + implementorAndSenderClass compile: methodWithUsageSource. - self - assertCreation: [ RenameTemporary from: oldVariable to: newVariable in: methodNode ] - failsWith: [ NewTemporaryPrecondition errorMessageFor: newVariable canNotBeNamedDueToInstanceVariableDefinedIn: superclassToRefactor ]! ! + nodeToInline := self messageNodeReferenceOf: implementorAndSenderClass inMethod: methodWithUsageSelector atIndex: 22. + + refactoring := InlineMethod + from: implementorAndSenderClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector,' | t y | t := [| y1 z | +y1 := 10. +self m3. +y1.]. ^20'. + self assert: expectedNewSourceCode equals: (implementorAndSenderClass >> methodWithUsageSelector) sourceCode! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! -test07RenameCreatesNewTemporaryVariableAndDeletesOldOne +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 5/21/2022 16:52:43'! +test09InlineMethodReturnedInFullClosureKeepsTheReturnSymbol - | methodNode oldVariable newVariable rename newMethodNode | + | implementorAndSenderClass methodToInlineSource methodToInlineSelector + nodeToInline methodWithUsageSelector methodWithUsageSource expectedNewSourceCode refactoring | - oldVariable := 'old'. - newVariable := 'new'. + implementorAndSenderClass := self createClassNamed: self implementorClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y z | y := 10. ^y.'. + implementorAndSenderClass compile: methodToInlineSource. - methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | '. + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t y | t := [^self m1]. ^20'. + implementorAndSenderClass compile: methodWithUsageSource. - rename := RenameTemporary from: oldVariable to: newVariable in: methodNode. - newMethodNode := rename methodNodeAfterApply. + nodeToInline := self messageNodeReferenceOf: implementorAndSenderClass inMethod: methodWithUsageSelector atIndex: 23. - self deny: (newMethodNode hasArgumentOrTemporaryNamed: oldVariable). - self assert: (newMethodNode hasArgumentOrTemporaryNamed: newVariable)! ! + refactoring := InlineMethod + from: implementorAndSenderClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector,' | t y | t := [| y1 z | +y1 := 10. +^y1.]. ^20'. + self assert: expectedNewSourceCode equals: (implementorAndSenderClass >> methodWithUsageSelector) sourceCode! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 19:28:42'! -test08RenameChangesReferencesFromOldVariableToNewVariable +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 5/21/2022 15:33:15'! +test10InlineMethodOfAnotherClass - | methodNode oldVariable newVariable rename newMethodNode assigmentNode | + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsageSelector methodWithUsageSource + expectedNewSourceCode refactoring implementorClass senderClass | - oldVariable := 'old'. - newVariable := 'new'. + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y z | y := 10. ^y.'. + implementorClass compile: methodToInlineSource. - methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | ', oldVariable, ' := 1 + ', oldVariable. + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t y | ^', implementorClass name, ' new ', methodToInlineSelector. + senderClass compile: methodWithUsageSource. - rename := RenameTemporary from: oldVariable to: newVariable in: methodNode. - newMethodNode := rename methodNodeAfterApply. + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsageSelector atIndex: 51. - assigmentNode := newMethodNode block statements first. - self assert: newVariable equals: assigmentNode variable name. - self assert: newVariable equals: assigmentNode value arguments first name.! ! + refactoring := InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector,' | t y y1 z | y1 := 10. +^y1.'. + self assert: expectedNewSourceCode equals: (senderClass >> methodWithUsageSelector) sourceCode! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! -test09RenamesArguments +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 5/21/2022 18:00:21'! +test11InlineClassMethodOfAnotherClass - | methodNode oldVariable newVariable rename newMethodNode | + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsageSelector methodWithUsageSource + expectedNewSourceCode refactoring implementorClass senderClass | - oldVariable := 'old'. - newVariable := 'new'. + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y z | y := 10. self m3. ^y.'. + implementorClass compile: methodToInlineSource. - methodNode := self methodNodeOf: 'm1: ', oldVariable, ' ^', oldVariable. + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t y | ^', implementorClass name, ' ', methodToInlineSelector. + senderClass compile: methodWithUsageSource. - rename := RenameTemporary from: oldVariable to: newVariable in: methodNode. - newMethodNode := rename methodNodeAfterApply. + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsageSelector atIndex: 46. - self deny: (newMethodNode hasArgumentOrTemporaryNamed: oldVariable). - self assert: (newMethodNode hasArgumentOrTemporaryNamed: newVariable). - self assert: newVariable equals: newMethodNode block statements first expr name.! ! + refactoring := InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector,' | t y y1 z | y1 := 10. +', implementorClass name, ' m3. +^y1.'. + self assert: expectedNewSourceCode equals: (senderClass >> methodWithUsageSelector) sourceCode! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 2/25/2020 00:07:53'! -test10NewVariableNameCanNotBeDefinedAsBlockArgument +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/4/2021 22:06:01'! +test15InlineUsagesOnSameClase - | methodNode oldVariable newVariable | + | methodToInlineSource methodToInlineSelector nodeToInline1 nodeToInline2 methodWithUsagesSelector methodWithUsagesSource + implementorClass senderClass expectedNewSourceCode refactoring | - oldVariable := 'old'. - newVariable := 'new'. + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y z | y := 10. self m3. ^y.'. + implementorClass compile: methodToInlineSource. - methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | [:', newVariable, ' | ^1 ]'. + methodWithUsagesSelector := 'm2' asSymbol. + methodWithUsagesSource := methodWithUsagesSelector, ' | t y | t := self m1. y := self m1. ^20'. + senderClass compile: methodWithUsagesSource. - self - assertCreation: [RenameTemporary from: oldVariable to: newVariable in: methodNode ] - failsWith: [ NewTemporaryPrecondition errorMessageForNewTemporaryVariable: newVariable isAlreadyDefinedIn: methodNode ]! ! + nodeToInline1 := self messageNodeReferenceOf: senderClass inMethod: methodWithUsagesSelector atIndex: 22. + nodeToInline2 := self messageNodeReferenceOf: senderClass inMethod: methodWithUsagesSelector atIndex: 35. + + refactoring := InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline1 with: nodeToInline2) + removeMethod: false. + + refactoring apply. + + expectedNewSourceCode := methodWithUsagesSelector,' | t y y1 z y2 z1 | y1 := 10. +self m3. +t := y1. y2 := 10. +self m3. +y := y2. ^20'. + self assert: expectedNewSourceCode equals: (senderClass >> methodWithUsagesSelector) sourceCode! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! -test11RenamesBlockArguments +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/6/2021 16:27:57'! +test16InlineUsageAndRemoveMethod - | methodNode oldVariable newVariable rename newMethodNode | + | methodToInlineSource methodToInlineSelector nodeToInline1 methodWithUsagesSelector methodWithUsagesSource + implementorClass senderClass expectedNewSourceCode refactoring | - oldVariable := 'old'. - newVariable := 'new'. + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y z | y := 10. self m3. ^y.'. + implementorClass compile: methodToInlineSource. - methodNode := self methodNodeOf: 'm1 [:', oldVariable, '| ^', oldVariable, ']'. + methodWithUsagesSelector := 'm2' asSymbol. + methodWithUsagesSource := methodWithUsagesSelector, ' | t y | t := self m1. ^20'. + senderClass compile: methodWithUsagesSource. - rename := RenameTemporary from: oldVariable to: newVariable in: methodNode. - newMethodNode := rename methodNodeAfterApply. + nodeToInline1 := self messageNodeReferenceOf: senderClass inMethod: methodWithUsagesSelector atIndex: 22. - self deny: (newMethodNode hasArgumentOrTemporaryNamed: oldVariable). - self assert: (newMethodNode hasArgumentOrTemporaryNamed: newVariable). - "asserts it renamed block argument - Hernan" - self assert: newVariable equals: newMethodNode block statements first arguments first name. - "asserts it renamed reference to block argument - Hernan" - self assert: newVariable equals: newMethodNode block statements first block statements first expr name! ! + refactoring := InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline1) + removeMethod: true. + + refactoring apply. + + expectedNewSourceCode := methodWithUsagesSelector,' | t y y1 z | y1 := 10. +self m3. +t := y1. ^20'. + self assert: expectedNewSourceCode equals: (senderClass >> methodWithUsagesSelector) sourceCode. + self deny: (implementorClass canUnderstand: methodToInlineSelector).! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! -test12RenamesBlockTemporaries +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/14/2021 20:52:41'! +test17InlineMethodWithASingleReturnLineWhenResultIsNotAssigned - | methodNode oldVariable newVariable rename newMethodNode | + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsagesSelector methodWithUsagesSource + implementorClass senderClass expectedNewSourceCode refactoring | - oldVariable := 'old'. - newVariable := 'new'. + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' ^1.'. + implementorClass compile: methodToInlineSource. - methodNode := self methodNodeOf: 'm1 [ |', oldVariable, '| ^', oldVariable, ']'. + methodWithUsagesSelector := 'm2' asSymbol. + methodWithUsagesSource := methodWithUsagesSelector, ' self m1. ^20'. + senderClass compile: methodWithUsagesSource. - rename := RenameTemporary from: oldVariable to: newVariable in: methodNode. - newMethodNode := rename methodNodeAfterApply. + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsagesSelector atIndex: 10. - self deny: (newMethodNode hasArgumentOrTemporaryNamed: oldVariable). - self assert: (newMethodNode hasArgumentOrTemporaryNamed: newVariable). - "asserts it renamed block temporary - Hernan" - self assert: newVariable equals: newMethodNode block statements first temporaries first name. - "asserts it renamed reference to block temporary - Hernan" - self assert: newVariable equals: newMethodNode block statements first block statements first expr name! ! + refactoring := InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: true. + + refactoring apply. + + expectedNewSourceCode := methodWithUsagesSelector,' ^20'. + self assert: expectedNewSourceCode equals: (senderClass >> methodWithUsagesSelector) sourceCode.! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:15:28'! -test13OldNodeMustBePartOfMethodNode +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/21/2021 20:54:13'! +test18InlineMethodUsedInLastStatementOfClosure - | methodNode oldVariable newVariable oldVariableNode | + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsagesSelector methodWithUsagesSource + implementorClass senderClass expectedNewSourceCode refactoring | - oldVariable := 'old'. - newVariable := 'new'. + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | x y | x := 1. y := 2. ^x + y.'. + implementorClass compile: methodToInlineSource. - methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | '. - oldVariableNode := methodNode tempNodes anyOne. + methodWithUsagesSelector := 'm2' asSymbol. + methodWithUsagesSource := methodWithUsagesSelector, ' | b | b := [1 + self m1]. ^b value'. + senderClass compile: methodWithUsagesSource. - self - assertCreation: [RenameTemporary fromOldVariableNode: oldVariableNode copy to: newVariable in: methodNode ] - failsWith: [RenameTemporary oldVariableNodeNotPartOfMethodNodeErrorDescription ] ! ! + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsagesSelector atIndex: 26. + + refactoring := InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: true. + + refactoring apply. + + expectedNewSourceCode := methodWithUsagesSelector,' | b | b := [| x y | +x := 1. +y := 2. +1 + (x + y).]. ^b value'. + self assert: expectedNewSourceCode equals: (senderClass >> methodWithUsagesSelector) sourceCode.! ! + +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/21/2021 20:54:28'! +test19InlineMethodIndentation + + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsagesSelector methodWithUsagesSource + implementorClass senderClass expectedNewSourceCode refactoring | + + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | x y | + x := 1. + y := 2. + ^x + y.'. + implementorClass compile: methodToInlineSource. + + methodWithUsagesSelector := 'm2' asSymbol. + methodWithUsagesSource := methodWithUsagesSelector, ' | b | + b := [ + 1 + self m1 + ]. + ^b value'. + senderClass compile: methodWithUsagesSource. + + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsagesSelector atIndex: 32. + + refactoring := InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: true. + + refactoring apply. + + expectedNewSourceCode := methodWithUsagesSelector,' | b | + b := [ + | x y | + x := 1. + y := 2. + 1 + (x + y). + ]. + ^b value'. + self assert: expectedNewSourceCode equals: (senderClass >> methodWithUsagesSelector) sourceCode.! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:15:28'! -test14OldVariableNodeMustBeArgOrTempNode +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/21/2021 19:39:11'! +test20InlineMethodUsedInReturn - | methodNode newVariable oldVariableNode | + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsagesSelector methodWithUsagesSource + implementorClass senderClass expectedNewSourceCode refactoring | - newVariable := 'new'. + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, '^5'. + implementorClass compile: methodToInlineSource. - methodNode := self methodNodeOf: 'm1 self'. - oldVariableNode := methodNode block statements first. + methodWithUsagesSelector := 'm2' asSymbol. + methodWithUsagesSource := methodWithUsagesSelector, ' ^3 * self m1'. + senderClass compile: methodWithUsagesSource. - self - assertCreation: [RenameTemporary fromOldVariableNode: oldVariableNode to: newVariable in: methodNode ] - failsWith: [RenameTemporary oldVariableNodeMustBeArgOrTempNodeErrorDescription ] ! ! + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsagesSelector atIndex: 14. + + refactoring := InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: true. + + refactoring apply. + + expectedNewSourceCode := methodWithUsagesSelector,' ^3 * 5.'. + self assert: expectedNewSourceCode equals: (senderClass >> methodWithUsagesSelector) sourceCode.! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:15:28'! -test15RenameVariablesWithSameNameInDifferentBlocksCorrectly +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 11/21/2021 20:30:17'! +test21InlineMethodAddsParenthesesWhenNeeded - | methodNode oldVariable newVariable oldVariableNode newMethodNode rename | + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsagesSelector methodWithUsagesSource + implementorClass senderClass expectedNewSourceCode refactoring | - oldVariable := 'old'. - newVariable := 'new'. + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, '^5 + 10'. + implementorClass compile: methodToInlineSource. - methodNode := self methodNodeOf: 'm1 [|',oldVariable,'| ^',oldVariable, '].[|',oldVariable,'| ^',oldVariable, '].'. - oldVariableNode := methodNode block statements first temporaries first. + methodWithUsagesSelector := 'm2' asSymbol. + methodWithUsagesSource := methodWithUsagesSelector, ' ^3 * self m1'. + senderClass compile: methodWithUsagesSource. - rename := RenameTemporary fromOldVariableNode: oldVariableNode to: newVariable in: methodNode. - newMethodNode := rename methodNodeAfterApply. + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsagesSelector atIndex: 14. - self - assert: 'm1 [|',newVariable,'| ^',newVariable, '].[|',oldVariable,'| ^',oldVariable, '].' - equals: newMethodNode sourceText! ! + refactoring := InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: true. + + refactoring apply. + + expectedNewSourceCode := methodWithUsagesSelector,' ^3 * (5 + 10).'. + self assert: expectedNewSourceCode equals: (senderClass >> methodWithUsagesSelector) sourceCode.! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 2/25/2020 00:08:04'! -test16CantRenameVariableToANameAlreadyUsedInAnUpperBlock +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 4/8/2022 23:52:48'! +test22InlineMethodOnSeveralSenders - | methodNode oldVariable newVariable oldVariableNode | + | methodToInlineSource methodToInlineSelector nodeToInline1 nodeToInline2 methodWithUsageSelector1 methodWithUsageSelector2 + methodWithUsagesSource methodWithUsagesSource2 implementorClass senderClass expectedNewSourceCode1 expectedNewSourceCode2 refactoring | + + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' ^1.'. + implementorClass compile: methodToInlineSource. + + methodWithUsageSelector1 := 'm2' asSymbol. + methodWithUsagesSource := methodWithUsageSelector1, ' ^self m1.'. + methodWithUsageSelector2 := 'm3' asSymbol. + methodWithUsagesSource2 := methodWithUsageSelector2, ' ^self m1.'. + senderClass compile: methodWithUsagesSource. + senderClass compile: methodWithUsagesSource2. + + nodeToInline1 := self messageNodeReferenceOf: senderClass inMethod: methodWithUsageSelector1 atIndex: 10. + nodeToInline2 := self messageNodeReferenceOf: senderClass inMethod: methodWithUsageSelector2 atIndex: 10. + + refactoring := InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline1 with: nodeToInline2) + removeMethod: true. - oldVariable := 'old'. - newVariable := 'new'. + refactoring apply. - methodNode := self methodNodeOf: 'm1 [|',newVariable,'| [|',oldVariable,'| ^', oldVariable,']. ^',newVariable,' ]'. - oldVariableNode := methodNode block statements first statements first temporaries first. + expectedNewSourceCode1 := methodWithUsageSelector1,' ^1.'. + self assert: expectedNewSourceCode1 equals: (senderClass >> methodWithUsageSelector1) sourceCode. - self - assertCreation: [RenameTemporary fromOldVariableNode: oldVariableNode to: newVariable in: methodNode ] - failsWith: [ - NewTemporaryPrecondition errorMessageForNewTemporaryVariable: newVariable isAlreadyDefinedIn: methodNode ] - ! ! + expectedNewSourceCode2 := methodWithUsageSelector2,' ^1.'. + self assert: expectedNewSourceCode2 equals: (senderClass >> methodWithUsageSelector2) sourceCode.! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 2/29/2020 18:09:43'! -test17RenamesOneCharVariableAfterAReturnWithoutCharsAfterThatCorrectly +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 4/9/2022 00:03:03'! +test23InlineMethodFromSameClassAccessingPrivateVariables - | methodNode oldVariable newVariable rename newSource | + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsageSelector + methodWithUsagesSource implementorAndSenderClass expectedNewSourceCode refactoring | + + implementorAndSenderClass := self createClassNamed: self implementorClass. + implementorAndSenderClass addInstVarName: 'y'. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' y := 1. ^y.'. + implementorAndSenderClass compile: methodToInlineSource. - "This test is due to a fixed error in the parser. - See ParserTest>>#testRangesAreOkWhenReturningAVariableWithoutSpaceAfterThat" + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsagesSource := methodWithUsageSelector, ' ^self m1.'. - oldVariable := 'o'. - newVariable := 'n'. + implementorAndSenderClass compile: methodWithUsagesSource. + + nodeToInline := self messageNodeReferenceOf: implementorAndSenderClass inMethod: methodWithUsageSelector atIndex: 10. + + refactoring := InlineMethod + from: implementorAndSenderClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: true. + + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector,' y := 1. +^y.'. + self assert: expectedNewSourceCode equals: (implementorAndSenderClass >> methodWithUsageSelector) sourceCode.! ! - methodNode := self methodNodeOf: 'm1 |',oldVariable,'| ^',oldVariable. +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 5/21/2022 17:35:15'! +test27InlineMethodFromAnotherClassReferencingSelfWhenReceiverIsAVariable + + | methodToInlineSource methodToInlineSelector nodeToInline methodWithUsageSelector methodWithUsageSource + implementorClass senderClass expectedNewSourceCode refactoring | - rename := RenameTemporary from: oldVariable to: newVariable in: methodNode. - newSource := rename apply. + implementorClass := self createClassNamed: self implementorClass. + senderClass := self createClassNamed: self senderClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' | y | y := 10. self m3. ^y.'. + implementorClass compile: methodToInlineSource. - self - assert: 'm1 |',newVariable,'| ^',newVariable - equals: newSource - ! ! + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' | t | t := ', implementorClass name, ' new . ', + '^ t ', methodToInlineSelector. + senderClass compile: methodWithUsageSource. + + nodeToInline := self messageNodeReferenceOf: senderClass inMethod: methodWithUsageSelector atIndex: 58. + refactoring := InlineMethod + from: implementorClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector, ' | t y | t := ', implementorClass name, ' new . y := 10. +t m3. +^y.'. + self assert: expectedNewSourceCode equals: (senderClass >> methodWithUsageSelector) sourceCode.! ! -!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 4/26/2020 15:19:20'! -test18CantRenameVariableToAReservedName +!InlineMethodTest methodsFor: 'tests - successful' stamp: 'FB 5/25/2022 20:43:16'! +test28InlineMethodWithReturnUsedInSenderReturningImplicitSelf - | methodNode oldVariable newVariable | + | implementorAndSenderClass methodToInlineSource methodToInlineSelector + nodeToInline methodWithUsageSelector methodWithUsageSource expectedNewSourceCode refactoring | - oldVariable := 'old'. + implementorAndSenderClass := self createClassNamed: self implementorClass. + methodToInlineSelector := 'm1' asSymbol. + methodToInlineSource := methodToInlineSelector, ' ^ 2 asString'. + implementorAndSenderClass compile: methodToInlineSource. - ClassBuilder reservedNames do: [ :reservedName | - newVariable := reservedName asString. - methodNode := self methodNodeOf: 'm1 |' , oldVariable , '| ^ ' , oldVariable. + methodWithUsageSelector := 'm2' asSymbol. + methodWithUsageSource := methodWithUsageSelector, ' self ' , methodToInlineSelector. + implementorAndSenderClass compile: methodWithUsageSource. + + nodeToInline := self messageNodeReferenceOf: implementorAndSenderClass inMethod: methodWithUsageSelector atIndex: 9. + + refactoring := InlineMethod + from: implementorAndSenderClass >> methodToInlineSelector + intoSendersAndUsages: (Array with: nodeToInline) + removeMethod: false. + + refactoring apply. + + expectedNewSourceCode := methodWithUsageSelector,' 2 asString.'. + self assert: expectedNewSourceCode equals: (implementorAndSenderClass >> methodWithUsageSelector) sourceCode! ! - self - assertCreation: [ RenameTemporary from: oldVariable to: newVariable in: methodNode ] - failsWith: [ NewTemporaryPrecondition errorMessageForNewTemporaryVariableCanNotBeAReservedName: newVariable ] ]! ! +!InlineMethodTest methodsFor: 'class factory' stamp: 'FB 11/22/2021 17:09:44'! +anotherSenderClass -!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/1/2018 16:43:08'! -test02ClassesWithNoReferencesAndNoSubclassesAreSafetelyRemoved + ^#AnotherSenderOfMethodToInlineClass! ! - | classToRemove safeRemove | +!InlineMethodTest methodsFor: 'class factory' stamp: 'FB 6/26/2021 19:23:34'! +implementorClass + + ^#ImplementorOfMethodToInlineClass! ! + +!InlineMethodTest methodsFor: 'class factory' stamp: 'FB 9/16/2021 23:31:21'! +senderClass + + ^#SenderOfMethodToInlineClass! ! + +!InlineTemporaryVariableTest methodsFor: 'class factory' stamp: 'FB 7/12/2020 14:20:19'! +classToRefactor + + ^#ClassWithMethodToInlineTemporaryVariable! ! + +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 11/21/2020 18:07:04'! +test03RefactoringRemovesUnusedTemporaryVariableDeclaration + + |classToRefactor originalSource methodToRefactorName refactoring tempVarToInline expectedSourceCode | - classToRemove := self createClassNamed: self classToRemoveName. - safeRemove := SafelyRemoveClass of: classToRemove. - safeRemove apply. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName , ' |', tempVarToInline,'| ^nil.'. + classToRefactor compile: originalSource. + expectedSourceCode := methodToRefactorName, ' ^nil.'. - self assert: classToRemove isObsolete ! ! + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (5 to: 6) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + self assert: expectedSourceCode + equals: ((classToRefactor >> methodToRefactorName asSymbol)) sourceCode.! ! -!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/1/2018 16:43:11'! -test03RemovingTheMetaclassRemovesTheClass +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 11/21/2020 18:07:44'! +test04AssignmentToVariableToInlineIsDeleted - | classToRemove safeRemove | + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - classToRemove := self createClassNamed: self classToRemoveName. - safeRemove := SafelyRemoveClass of: classToRemove class. - safeRemove apply. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := 2. ^nil.'. + classToRefactor compile: originalSource. - self assert: classToRemove isObsolete ! ! + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' ^nil.'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! -!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 16:40:06'! -test04CanNotRemoveClassWithReferencesOutsideHierarchy +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 12/4/2020 09:24:05'! +test05RefactoringScopeIsBetweenAssignments - | classToRemove classReferencing methodNameReferencingClass | + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - classToRemove := self createClassNamed: self classToRemoveName. - classReferencing := self createClassNamed: #ClassReferencingClassToRemove. - methodNameReferencingClass := #m1. - classReferencing compile: methodNameReferencingClass asString, ' ^', classToRemove name asString. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := 1. t1 := 2. t1 := 3. ^nil.'. + classToRefactor compile: originalSource. - self - should: [ SafelyRemoveClass of: classToRemove ] - raise: self canNotRefactorDueToReferencesRefactoringError - withExceptionDo: [ :anError | | reference | - self - assert: (SafelyRemoveClass errorMessageForCanNotRemove: classToRemove dueToReferencesToAll: (Array with: classToRemove)) - equals: anError messageText. - self assert: 1 equals: anError numberOfReferences. - reference := anError anyReference. - self assert: classReferencing name equals: reference classSymbol. - self assert: methodNameReferencingClass equals: reference methodSymbol ]! ! + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (20 to: 21) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' | t1 | t1 := 1. t1 := 3. ^nil.'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! -!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/1/2018 16:43:21'! -test05CanRemoveClassWithReferencesFromItself +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 2/15/2021 17:58:26'! +test06InlinedVariableUsagesAreReplacedWithTheVariablesValue - | classToRemove methodNameReferencingClass remove | + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - classToRemove := self createClassNamed: self classToRemoveName. - methodNameReferencingClass := #m1. - classToRemove compile: methodNameReferencingClass asString, ' ^', classToRemove name asString. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := self m1: 1. self m2: t1'. + classToRefactor compile: originalSource. - remove := SafelyRemoveClass of: classToRemove. - remove apply. + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. - self assert: classToRemove isObsolete ! ! + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' self m2: self m1: 1'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! -!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/1/2018 16:43:27'! -test06WarnIfClassToRemoveHasSubclasses +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 2/15/2021 18:05:02'! +test07RefactoringDoesNotAddParenthesesWhenTempIsLiteralAndReferenceIsReceiverOfUnaryMessage - | classToRemove classToRemoveSubclass | + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - classToRemove := self createClassNamed: self classToRemoveName. - classToRemoveSubclass := self createClassNamed: 'ClassToRemoveSubclass' asSymbol subclassOf: classToRemove. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := 1. ^t1 abs'. + classToRefactor compile: originalSource. - self - assertCreation: [ SafelyRemoveClass of: classToRemove ] - warnsWith: [ SafelyRemoveClass warningMessageFor: classToRemove hasSubclasses: (Array with: classToRemoveSubclass) ]! ! + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' ^1 abs'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! -!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 16:38:44'! -test07CanNotRemoveClassWhenSubclassesHaveReferencesOutsideTheHierarchy +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 2/15/2021 18:05:24'! +test08RefactoringDoesNotAddParenthesesWhenTempIsLiteralAndReferenceIsArgumentOfBinaryMessage - | classToRemove classToRemoveSubclass classReferencing methodNameReferencingClass | + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - classToRemove := self createClassNamed: self classToRemoveName. - classToRemoveSubclass := self createClassNamed: 'ClassToRemoveSubclass' asSymbol subclassOf: classToRemove. - classReferencing := self createClassNamed: #ClassReferencingClassToRemoveSubclass. - methodNameReferencingClass := #m1. - classReferencing compile: methodNameReferencingClass asString, ' ^', classToRemoveSubclass name asString. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := 1. ^5 * t1'. + classToRefactor compile: originalSource. - self - should: [ SafelyRemoveClass of: classToRemove ] - raise: self canNotRefactorDueToReferencesRefactoringError - withExceptionDo: [ :anError | | reference | - self - assert: (SafelyRemoveClass errorMessageForCanNotRemove: classToRemove dueToReferencesToAll: (Array with: classToRemoveSubclass)) - equals: anError messageText. - self assert: 1 equals: anError numberOfReferences. - reference := anError anyReference. - self assert: classReferencing name equals: reference classSymbol. - self assert: methodNameReferencingClass equals: reference methodSymbol ] -! ! + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' ^5 * 1'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! -!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/1/2018 16:47:12'! -test08HierarchyIsRemovedIfSubclassesWarningIsResumed +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 2/15/2021 18:06:27'! +test09RefactoringAddsParenthesesWhenTempIsBinaryAndReferenceIsArgumentOfBinaryMessage - | classToRemove classToRemoveSubclass | + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - classToRemove := self createClassNamed: self classToRemoveName. - classToRemoveSubclass := self createClassNamed: 'ClassToRemoveSubclass' asSymbol subclassOf: classToRemove. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := 1 + 2. ^5 * t1'. + classToRefactor compile: originalSource. - self safelyRemoveHierarchyOf: classToRemove. + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. - self assert: classToRemove isObsolete. - self assert: classToRemoveSubclass isObsolete - + refactoring apply. - ! ! + expectedNewSourceCode := methodToRefactorName,' ^5 * (1 + 2)'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! -!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/1/2018 16:47:17'! -test09CanRemoveIfReferencesToSubclassesAreInTheHierarchy +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 2/15/2021 18:06:31'! +test10RefactoringDoesNotAddParenthesesWhenTempIsBinaryAndReferenceIsReceiverOfBinaryMessage - | classToRemove classToRemoveSubclass | + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - classToRemove := self createClassNamed: self classToRemoveName. - classToRemoveSubclass := self createClassNamed: 'ClassToRemoveSubclass' asSymbol subclassOf: classToRemove. - classToRemove compile: 'm1 ^', classToRemoveSubclass name asString. - classToRemoveSubclass compile: 'm2 ^', classToRemove name asString. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := 1 + 2. ^t1 * 5'. + classToRefactor compile: originalSource. - self safelyRemoveHierarchyOf: classToRemove. + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. - self assert: classToRemove isObsolete. - self assert: classToRemoveSubclass isObsolete.! ! + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' ^1 + 2 * 5'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! -!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 16:04:18'! -test10WarnWhenHasReferencesToName +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 2/15/2021 18:10:13'! +test11RefactoringAddsParenthesesWhenTempIsBinaryAndReferenceIsReceiverOfUnaryMessage - | classToRemove classReferencing methodNameReferencingClass | + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - classToRemove := self createClassNamed: self classToRemoveName. - classReferencing := self createClassNamed: #ClassReferencingClassToRemove. - methodNameReferencingClass := #m1. - classReferencing compile: methodNameReferencingClass asString, ' ^#', classToRemove name asString. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := 1 - 2. ^t1 abs'. + classToRefactor compile: originalSource. - self - should: [ SafelyRemoveClass of: classToRemove ] - raise: self referencesRefactoringWarning - withExceptionDo: [ :aWarning | | reference | - self - assert: (SafelyRemoveClass warningMessageForReferencesToNames: (Array with: classToRemove)) - equals: aWarning messageText. - self assert: 1 equals: aWarning numberOfReferences. - reference := aWarning anyReference. - self assert: classReferencing name equals: reference classSymbol. - self assert: methodNameReferencingClass equals: reference methodSymbol ]! ! - -!SafelyRemoveClassTest methodsFor: 'test support' stamp: 'HAW 8/1/2018 15:48:56'! -assertSubclassesReturnsACopy + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' ^(1 - 2) abs'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! - "This is a precondition for the remove to work properly with subclasses of the class to remove. - I do not put it in the refactoring to avoid innecesary checks and because tests verify preconditions. - It is not a seprate test because I do not want senders of this precondition to run if it fails - Hernan" - self deny: self class superclass subclasses == self class superclass subclasses! ! +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 2/20/2021 16:43:27'! +test12RefactoringAddsParenthesesWhenTempIsBinaryAndReferenceIsPartOfMessageWhereReceiverIsAnotherReferenceToTemp -!SafelyRemoveClassTest methodsFor: 'test support' stamp: 'HAW 8/1/2018 16:47:22'! -safelyRemoveHierarchyOf: classToRemove - - | remove | + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - "see comment of #assertSubclassesReturnsACopy - Hernan" - self assertSubclassesReturnsACopy. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := 1 * 5. ^t1 + t1 + t1'. + classToRefactor compile: originalSource. - [ remove := SafelyRemoveClass of: classToRemove ] - on: self refactoringWarning - do: [ :aWarning | - self assert: (SafelyRemoveClass warningMessageFor: classToRemove hasSubclasses: classToRemove allSubclasses) equals: aWarning messageText. - aWarning resume ]. - - remove apply.! ! + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' ^1 * 5 + (1 * 5) + (1 * 5)'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! -!SafelyRemoveClassTest methodsFor: 'class factory' stamp: 'HAW 7/11/2018 16:56:05'! -classToRemoveName +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 2/16/2021 20:30:24'! +test13RefactoringDoesNotAddParenthesesWhenTempIsBinaryAndReferenceIsArgumentOfKeywordMessage - "I can not use the symbol directly because it would be a reference - Hernan" - ^ 'ClassToRemove' asSymbol. - ! ! + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := 1 + 2. ^self m2: t1'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' ^self m2: 1 + 2'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:26:04'! -methodSourceCodeNamed: aSelector withTemporaryVariableDeclaration: aTemporaryVariableName +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 2/16/2021 20:29:05'! +test14RefactoringAddsParenthesesWhenTempIsKeywordMessageAndReferenceIsReceiverOfBinaryMessage - ^aSelector, '| ', aTemporaryVariableName, ' |'.! ! + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := self m2: 5. ^t1 * 2'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' ^(self m2: 5) * 2'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:31:12'! -methodSourceCodeNamed: aSelector withTemporaryVariableDeclarations: temporaryVariableNames - ^String streamContents: [ :stream | - stream nextPutAll: aSelector, '| '. - temporaryVariableNames do: [ :temporaryVariableName | - stream nextPutAll: temporaryVariableName, ' ' ]. - stream nextPut: $|. ].! ! +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 2/16/2021 21:03:38'! +test15RefactoringDoesNotAddParenthesesWhenTempIsKeywordMessageAndReferenceIsArgumentOfBinaryMessage -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:26:04'! -test01ApplyChangesTemporaryVariableToInstanceVariable + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := self m2: 5. ^2 * t1'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' ^2 * self m2: 5'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! - | variableName classToRefactor messageName refactoring sourceText methodNode changedMethodNode | +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 2/20/2021 16:37:35'! +test16RefactoringAddsParenthesesWhenTempIsKeywordAndReferenceIsPartOfMessageWhereArgumentIsAnotherReferenceToTemp - classToRefactor _ self createClassNamed: self classToRefactorName. - messageName _ #m1. - variableName _ 'a'. - sourceText _ self methodSourceCodeNamed: messageName withTemporaryVariableDeclaration: variableName. - methodNode _ self compileMethodNodeIn: classToRefactor named: messageName sourceCode: sourceText. + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - refactoring _ TemporaryToInstanceVariable named: variableName fromMethod: methodNode. - refactoring apply. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := self m2: 5. ^t1 + t1 + 2 + t1 + t1'. + classToRefactor compile: originalSource. - self assert: (classToRefactor definesInstanceVariableNamed: variableName). - self assert: (classToRefactor canUnderstand: messageName). + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. - changedMethodNode _ self methodNodeIn: classToRefactor named: messageName. - self assert: 0 equals: changedMethodNode temporaries size.! ! - -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:26:04'! -test02ApplyDoesntChangeRestOfSourceCode + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' ^(self m2: 5) + (self m2: 5) + 2 + (self m2: 5) + self m2: 5'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! - | variableName classToRefactor messageName refactoring sourceText methodNode changedMethodNode restOfSourceCode | +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 2/20/2021 19:56:15'! +test17RefactoringDoesNotAddParenthesesWhenBothValueAndReferenceAlreadyHaveThem - classToRefactor _ self createClassNamed: self classToRefactorName. - messageName _ #m1. - variableName _ 'a'. - sourceText _ self methodSourceCodeNamed: messageName withTemporaryVariableDeclaration: variableName. - restOfSourceCode _ variableName, ' := 2. - ^', variableName. - sourceText _ sourceText, restOfSourceCode. - methodNode _ self compileMethodNodeIn: classToRefactor named: messageName sourceCode: sourceText. + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := (1 + 2). ^t1 + t1'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. - refactoring _ TemporaryToInstanceVariable named: variableName fromMethod: methodNode. refactoring apply. - changedMethodNode _ self methodNodeIn: classToRefactor named: messageName. - self assert: (changedMethodNode sourceText findString: restOfSourceCode :: > 0).! ! - -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'HAW 5/19/2019 17:35:13'! -test03TemporaryToChangeShouldExist + expectedNewSourceCode := methodToRefactorName,' ^(1 + 2) + (1 + 2)'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode! ! - | classToRefactor messageName methodNode sourceText | +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 3/10/2021 19:03:50'! +test18RefactoringInlinesUsageOnNextAssignment - classToRefactor _ self createClassNamed: self classToRefactorName. - messageName _ #m1. - sourceText _ messageName. - methodNode _ self compileMethodNodeIn: classToRefactor named: messageName sourceCode: sourceText. + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - self - should: [TemporaryToInstanceVariable named: 'a' fromMethod: methodNode] - raise: RefactoringError - withExceptionDo: [ :error | - self - assert: TemporaryToInstanceVariable inexistentTemporaryErrorDescription - equals: error messageText. - - self assertMethodNamed: messageName in: classToRefactor hasSourceEqualTo: sourceText ].! ! - -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:26:04'! -test04TemporaryShouldNotExistInOtherClassMethod + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 t2 | t1 := 2 * 3. t2 := 5 * t1. t1 := 3 + t1'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (14 to: 15) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' | t1 t2 | t2 := 5 * (2 * 3). t1 := 3 + (2 * 3)'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode ! ! - | classToRefactor firstMessageName firstMethodNode firstSourceText variableName secondMessageName secondSourceText | +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 4/24/2021 18:16:08'! +test20RefactoringBlockTemporaryDoesNotChangeFollowingBlocksDeclaringTemporaryWithSameName - classToRefactor _ self createClassNamed: self classToRefactorName. - variableName _ 'a'. - firstMessageName _ #m1. - firstSourceText _ self - methodSourceCodeNamed: firstMessageName - withTemporaryVariableDeclaration: variableName. - firstMethodNode _ self - compileMethodNodeIn: classToRefactor - named: firstMessageName - sourceCode: firstSourceText. + | classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - secondMessageName _ #m2. - secondSourceText _ self - methodSourceCodeNamed: secondMessageName - withTemporaryVariableDeclaration: variableName. - classToRefactor compile: secondSourceText. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | b1 b2| b1 := [ | t | t := 2. ^t * 2]. b2 := [ | t | t := 10. ^t+1]'. + classToRefactor compile: originalSource. - self - should: [TemporaryToInstanceVariable named: variableName fromMethod: firstMethodNode] - raise: RefactoringError - withExceptionDo: [ :error | - self - assert: TemporaryToInstanceVariable temporaryExistsInOtherMethodsErrorDescription - equals: error messageText. - - self assertMethodNamed: firstMessageName in: classToRefactor hasSourceEqualTo: firstSourceText. - self assertMethodNamed: secondMessageName in: classToRefactor hasSourceEqualTo: secondSourceText ].! ! + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (23 to: 24) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' | b1 b2| b1 := [ ^2 * 2]. b2 := [ | t | t := 10. ^t+1]'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:26:04'! -test05InstanceVariableShouldNotExistInSubclass + +! ! - | classToRefactor messageName methodNode sourceText variableName subclassToRefactor | +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 4/24/2021 18:16:29'! +test21RefactoringBlockTemporaryDoesNotChangePreviousBlocksDeclaringTemporaryWithSameName - variableName _ 'a'. + | classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - classToRefactor _ self createClassNamed: self classToRefactorName. - subclassToRefactor _ self - createClassNamed: #SubclassToRefactor - subclassOf: classToRefactor - instanceVariableNames: variableName - classVariableNames: '' - poolDictionaries: '' - category: self classCategoryOfTestData. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | b1 b2| b1 := [ | t | t := 2. ^t * 2]. b2 := [ | t | t := 10. ^t+1]'. + classToRefactor compile: originalSource. - messageName _ #m1. - sourceText _ self - methodSourceCodeNamed: messageName - withTemporaryVariableDeclaration: variableName. - methodNode _ self - compileMethodNodeIn: classToRefactor - named: messageName - sourceCode: sourceText. - - self - should: [TemporaryToInstanceVariable named: variableName fromMethod: methodNode] - raise: RefactoringError - withExceptionDo: [ :error | - self - assert: TemporaryToInstanceVariable temporaryExistsAsInstVarInSubclassesErrorDescription - equals: error messageText. - - self assertMethodNamed: messageName in: classToRefactor hasSourceEqualTo: sourceText. - self assert: (subclassToRefactor instVarNames includes: variableName) ].! ! + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (58 to: 59) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' | b1 b2| b1 := [ | t | t := 2. ^t * 2]. b2 := [ ^10+1]'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:26:04'! -test06TemporaryShouldNotExistInSubclassMethod + +! ! - | classToRefactor firstMessageName firstMethodNode firstSourceText variableName secondMessageName secondSourceText subclassToRefactor | +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 4/29/2021 21:08:23'! +test22RefactoringNestedBlockTemporaryDoesNotChangeFollowingBlocksDeclaringTemporaryWithSameName - classToRefactor _ self createClassNamed: self classToRefactorName. - subclassToRefactor _ self - createClassNamed: #SubclassToRefactor - subclassOf: classToRefactor - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: self classCategoryOfTestData. + | classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - variableName _ 'a'. - firstMessageName _ #m1. - firstSourceText _ self - methodSourceCodeNamed: firstMessageName - withTemporaryVariableDeclaration: variableName. - firstMethodNode _ self - compileMethodNodeIn: classToRefactor - named: firstMessageName - sourceCode: firstSourceText. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | b1 b2| b1 := [ | b3 | b3 := [ | t | t := 2. ^t * 2]. ^b3 ]. b2 := [ | t | t := 10. ^t+1]'. + classToRefactor compile: originalSource. - secondMessageName _ #m2. - secondSourceText _ self - methodSourceCodeNamed: secondMessageName - withTemporaryVariableDeclaration: variableName. - subclassToRefactor compile: secondSourceText. + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (38 to: 39) + inMethod: classToRefactor >> methodToRefactorName asSymbol. - self - should: [TemporaryToInstanceVariable named: variableName fromMethod: firstMethodNode] - raise: RefactoringError - withExceptionDo: [ :error | - self - assert: TemporaryToInstanceVariable temporaryExistsInOtherMethodsErrorDescription - equals: error messageText. - - self assertMethodNamed: firstMessageName in: classToRefactor hasSourceEqualTo: firstSourceText. - self assertMethodNamed: secondMessageName in: subclassToRefactor hasSourceEqualTo: secondSourceText ].! ! + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' | b1 b2| b1 := [ | b3 | b3 := [ ^2 * 2]. ^b3 ]. b2 := [ | t | t := 10. ^t+1]'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/28/2019 19:13:24'! -test07RemovesPipesWhenRemovingLastTemporaryInMethod + +! ! - | variableName classToRefactor messageName refactoring sourceText methodNode | - classToRefactor _ self createClassNamed: self classToRefactorName. - messageName _ #m1. - variableName _ 'a'. - sourceText _ self methodSourceCodeNamed: messageName withTemporaryVariableDeclaration: variableName. - methodNode _ self compileMethodNodeIn: classToRefactor named: messageName sourceCode: sourceText. +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 5/2/2021 19:16:02'! +test23RefactoringBlockTemporaryFromDeclarationDoesNotChangePreviousBlocksDeclaringTemporaryWithSameName + + | classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | b1 b2| b1 := [ | t | t := 2. ^t * 2]. b2 := [ | t | t := 10. ^t+1]'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (54 to: 55) + inMethod: classToRefactor >> methodToRefactorName asSymbol. - refactoring _ TemporaryToInstanceVariable named: variableName fromMethod: methodNode. refactoring apply. - self assertMethodNamed: messageName in: classToRefactor hasSourceEqualTo: 'm1 '.! ! + expectedNewSourceCode := methodToRefactorName,' | b1 b2| b1 := [ | t | t := 2. ^t * 2]. b2 := [ ^10+1]'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:30:25'! -test08DoesntRemoveOtherVariables + +! ! - | variableName classToRefactor messageName refactoring sourceText methodNode otherVariableName | - classToRefactor _ self createClassNamed: self classToRefactorName. - messageName _ #m1. - variableName _ 'a'. - otherVariableName _ 'b'. - sourceText _ self - methodSourceCodeNamed: messageName - withTemporaryVariableDeclarations: {variableName. otherVariableName}. - methodNode _ self compileMethodNodeIn: classToRefactor named: messageName sourceCode: sourceText. +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 5/2/2021 19:25:41'! +test24RefactoringOnlyRemovesDeclarationOfInlinedTemporary + + | classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't2'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | b1 b2| b1 := [ | t | t := 2. ^t * 2]. b2 := [ | t t2 t3 | t := 10. ^t+1]'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (56 to: 57) + inMethod: classToRefactor >> methodToRefactorName asSymbol. - refactoring _ TemporaryToInstanceVariable named: variableName fromMethod: methodNode. refactoring apply. - self assertMethodNamed: messageName in: classToRefactor hasSourceEqualTo: 'm1| b |'.! ! + expectedNewSourceCode := methodToRefactorName,' | b1 b2| b1 := [ | t | t := 2. ^t * 2]. b2 := [ | t t3 | t := 10. ^t+1]'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/28/2019 00:17:27'! -test09TemporaryShouldNotExistInOtherBlockInSameMethod + +! ! - | classToRefactor messageName methodNode sourceText variableName blockWithVariableString | +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 12/21/2021 20:27:55'! +test26RefactoringAddsParenthesesWhenTempIsKeywordMessageAndReferenceIsArgumentOfKeywordMessage - classToRefactor _ self createClassNamed: self classToRefactorName. + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | - variableName _ 'a'. - messageName _ #m1. - blockWithVariableString _ '[ | ', variableName, ' | ].'. - sourceText _ messageName, ' - ', blockWithVariableString, ' - ', blockWithVariableString. - methodNode _ self - compileMethodNodeIn: classToRefactor - named: messageName - sourceCode: sourceText. + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 | t1 := self m2: 5. ^t1 do: 10'. + classToRefactor compile: originalSource. - self - should: [ TemporaryToInstanceVariable named: variableName fromMethod: methodNode ] - raise: RefactoringError - withExceptionDo: [ :error | - self - assert: TemporaryToInstanceVariable temporaryExistsInOtherBlockErrorDescription - equals: error messageText. - - self assertMethodNamed: messageName in: classToRefactor hasSourceEqualTo: sourceText. ].! ! + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (11 to: 12) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' ^(self m2: 5) do: 10'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode + + +! ! -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/28/2019 19:52:12'! -test10RemovesPipesWhenRemovingLastTemporaryInBlock +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 12/28/2021 19:55:21'! +test27RefactoringIsAllowedWhenVariableIsUsedInBlockButThereAreNoMoreAssignments - | classToRefactor messageName methodNode sourceText variableName blockWithVariableString newSourceCode refactoring | + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 b | t1 := 2. b := [5 * t1]. ^b value.'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (13 to: 14) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' | b | b := [5 * 2]. ^b value.'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode + + +! ! - classToRefactor _ self createClassNamed: self classToRefactorName. +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 3/19/2022 13:23:51'! +test29InlineReferenceAtEndOfMethodWithoutStatementEndingCharacter + + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 'a'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | a | a := 1. ^self printOn: a'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (6 to: 6) + inMethod: classToRefactor >> methodToRefactorName asSymbol. - variableName _ 'a'. - messageName _ #m1. - blockWithVariableString _ '[ | ', variableName, ' | ].'. - sourceText _ messageName, ' - ', blockWithVariableString. - methodNode _ self - compileMethodNodeIn: classToRefactor - named: messageName - sourceCode: sourceText. - refactoring _ TemporaryToInstanceVariable named: variableName fromMethod: methodNode. refactoring apply. - newSourceCode _ messageName, ' - [ ].'. + expectedNewSourceCode := methodToRefactorName,' ^self printOn: 1'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode - self assertMethodNamed: messageName in: classToRefactor hasSourceEqualTo: newSourceCode.! ! + +! ! -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 12/22/2019 18:18:26'! -test11TemporaryShouldNotExistAsArgumentInOtherBlocksInSameMethod +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 3/19/2022 13:26:10'! +test30InlineFromReferenceLocatedAfterAssignment - | classToRefactor messageName methodNode sourceText variableName blockWithTempString blockWithArgumentString | + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 'a'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | a | a := 1. self printOn: a. ^a'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (36 to: 36) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' self printOn: 1. ^1'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode + + +! ! - classToRefactor _ self createClassNamed: self classToRefactorName. +!InlineTemporaryVariableTest methodsFor: 'tests - successful' stamp: 'FB 4/3/2022 23:28:22'! +test31InlineTemporaryUsedAfterAssignmentInBlock + + |classToRefactor originalSource methodToRefactorName tempVarToInline refactoring expectedNewSourceCode | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | b t1 | b := [ t1 := 30. ^t1]. ^t1'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (21 to: 22) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + refactoring apply. + + expectedNewSourceCode := methodToRefactorName,' | b t1 | b := [ ^30]. ^t1'. + self assert: expectedNewSourceCode equals: (classToRefactor >> methodToRefactorName asSymbol) sourceCode + - variableName _ 'a'. - messageName _ #m1. - blockWithTempString _ '[ | ', variableName, ' | ].'. - blockWithArgumentString _ '[ :', variableName, ' | ].'. - sourceText _ messageName, ' ', blockWithTempString, ' ', blockWithArgumentString. - methodNode _ self - compileMethodNodeIn: classToRefactor - named: messageName - sourceCode: sourceText. - - self assertCreation: [ TemporaryToInstanceVariable named: variableName fromMethod: methodNode ] - failsWith: [ TemporaryToInstanceVariable temporaryExistsInOtherBlockErrorDescription ]. ! ! -!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 12/22/2019 18:38:40'! -test12CantExtractArgument +!InlineTemporaryVariableTest methodsFor: 'tests - validations' stamp: 'FB 12/28/2021 20:02:39'! +test01VariableToInlineCanNotBeEmpty - | classToRefactor methodNode sourceText | + |classToRefactor originalSource methodToRefactorName tempVarToInline | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := ' '. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName , ' |', tempVarToInline,'| ^nil.'. + classToRefactor compile: originalSource. + + self assertCreation: [InlineTemporaryVariable named: tempVarToInline atUsageInterval: (5 to: 6) + inMethod: classToRefactor >> methodToRefactorName asSymbol.] + failsWith: [InlineTemporaryVariable selectionIsNotATemporaryVariableErrorMessage].! ! - classToRefactor _ self createClassNamed: self classToRefactorName. +!InlineTemporaryVariableTest methodsFor: 'tests - validations' stamp: 'FB 12/28/2021 20:02:39'! +test02VariableToInlineMustExistInSelector + + |classToRefactor originalSource methodToRefactorName tempVarToInline | - sourceText := 'm1: a'. - methodNode _ self - compileMethodNodeIn: classToRefactor - named: #m1: - sourceCode: sourceText. - - self assertCreation: [ TemporaryToInstanceVariable named: 'a' fromMethod: methodNode ] - failsWith: [ TemporaryToInstanceVariable inexistentTemporaryErrorDescription ]. -! ! + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | | ^nil.'. + classToRefactor compile: originalSource. + + self assertCreation: [InlineTemporaryVariable named: tempVarToInline atUsageInterval: (5 to: 6) + inMethod: classToRefactor >> methodToRefactorName asSymbol.] + failsWith: [InlineTemporaryVariable selectionIsNotATemporaryVariableErrorMessage].! ! -!TemporaryToInstanceVariableTest methodsFor: 'assertions' stamp: 'HAW 5/19/2019 17:29:33'! -assertMethodNamed: aMethodName in: aClass hasSourceEqualTo: aSourceCode +!InlineTemporaryVariableTest methodsFor: 'tests - validations' stamp: 'FB 3/25/2021 21:08:20'! +test19CanNotRefactorTemporaryWhenUsedInBlockSurroundedWithAssignments - | changedMethodNode | + | classToRefactor originalSource methodToRefactorName tempVarToInline refactoring | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 b| t1 := 2. b := [5 * t1]. t1 := 3. ^b value.'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (12 to: 13) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + [refactoring apply] on: Error + do: [:error | self assert: InlineTemporaryVariable temporaryUsedInBlockSurroundedWithAssignmentsErrorMessage equals: error messageText ] + + +! ! - changedMethodNode _ self methodNodeIn: aClass named: aMethodName. - self assert: aSourceCode equals: changedMethodNode sourceText. - ! ! +!InlineTemporaryVariableTest methodsFor: 'tests - validations' stamp: 'FB 12/21/2021 19:36:22'! +test25CanNotRefactorTemporaryFromDeclarationWhenThereAreMultipleAssignments -!TemporaryToInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 5/19/2019 17:29:44'! -classToRefactorName + | classToRefactor originalSource methodToRefactorName tempVarToInline refactoring | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 b| t1 := 2. b := 5 * t1. t1 := 3. ^b value.'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (6 to: 7) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + [refactoring apply] on: Error + do: [:error | self assert: InlineTemporaryVariable moreThanOneAssignmentErrorMessage equals: error messageText ] + + +! ! - ^ #ClassToChangeVariable.! ! +!InlineTemporaryVariableTest methodsFor: 'tests - validations' stamp: 'FB 1/8/2022 13:07:57'! +test28CanNotRefactorTemporaryFromDeclarationWhenVariableIsReferencedButNotAssigned -!TemporaryToInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 5/19/2019 17:31:47'! -compileMethodNodeIn: aClass named: aSelector sourceCode: sourceCode + | classToRefactor originalSource methodToRefactorName tempVarToInline refactoring | + + classToRefactor := self createClassNamed: self classToRefactor. + tempVarToInline := 't1'. + methodToRefactorName := 'm1'. + originalSource := methodToRefactorName,' | t1 b | b := 5 * t1. ^b value.'. + classToRefactor compile: originalSource. + + refactoring := InlineTemporaryVariable named: tempVarToInline atUsageInterval: (6 to: 7) + inMethod: classToRefactor >> methodToRefactorName asSymbol. + + [refactoring apply] on: Error + do: [:error | self assert: InlineTemporaryVariable assignmentNotFoundErrorMessage equals: error messageText ] + + +! ! - aClass compile: sourceCode. +!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:01:00'! +test01ChangesTheSuperclassOfTheClassToRefactor - ^self methodNodeIn: aClass named: aSelector.! ! + | classToRefactor refactoring oldSuperclass newSuperclass | + + classToRefactor := self createClassNamed: #ClassToAddSuperclass. + oldSuperclass := classToRefactor superclass. + + refactoring := InsertSuperclass to: classToRefactor named: #AddedSuperclass. + newSuperclass := refactoring apply. + + self assert: newSuperclass equals: classToRefactor superclass. + self assert: (newSuperclass subclasses includes: classToRefactor). + self assert: oldSuperclass equals: newSuperclass superclass.! ! -!TemporaryToInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 5/19/2019 17:31:40'! -methodNodeIn: aClass named: aSelector +!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:02:51'! +test02ClassToRefactorStructureIsMaintained - ^ aClass compiledMethodAt: aSelector :: methodNode.! ! + | classToRefactor refactoring instanceVariables category classVariables poolDictionaries | + + instanceVariables := 'instVar1 instVar2'. + classVariables := 'ClassVar1 ClassVar2'. + poolDictionaries := 'SharedAAA'. + category := self classCategoryOfTestData. + + [ Smalltalk at: poolDictionaries asSymbol put: Dictionary new. + classToRefactor := self + createClassNamed: #ClassToAddSuperclass + subclassOf: RefactoringClassTestData + instanceVariableNames: instanceVariables + classVariableNames: classVariables + poolDictionaries: poolDictionaries + category: category. + + refactoring := InsertSuperclass to: classToRefactor named: #AddedSuperclass. + refactoring apply. + + self assert: instanceVariables equals: classToRefactor instanceVariablesString. + self assert: classVariables equals: classToRefactor classVariablesString. + self assert: poolDictionaries equals: classToRefactor sharedPoolsString. + self assert: category equals: classToRefactor category ] ensure: [ Smalltalk removeKey: poolDictionaries asSymbol ].! ! -!ChangesTest methodsFor: 'assertions' stamp: 'HAW 11/1/2019 17:04:26'! -assertIsLogged: aString times: stringCount and: aBlock +!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:17:48'! +test03NewSuperclassCategoryIsTheSameAsClassToRefactorCategory - | logContent startPosition indexOfSubstring | + | classToRefactor refactoring classToRefactorCategory newSuperclass | - logContent := self userChangesForTestsFile textContents. - - startPosition := 1. - stringCount <= 0 - ifTrue: [ self deny: (logContent includesSubString: aString) ] - ifFalse:[ - stringCount timesRepeat: [ - indexOfSubstring := logContent findString: aString startingAt: startPosition. - self assert: indexOfSubstring > 0. - startPosition := indexOfSubstring + 1 ]. - indexOfSubstring := logContent findString: aString startingAt: startPosition. - self assert: 0 equals: indexOfSubstring]. - - aBlock value: logContent value: startPosition. + classToRefactorCategory := self classCategoryOfTestData. + classToRefactor := self createClassNamed: #ClassToAddSuperclass category: classToRefactorCategory. + + refactoring := InsertSuperclass to: classToRefactor named: #AddedSuperclass. + newSuperclass := refactoring apply. + self assert: classToRefactorCategory equals: newSuperclass category.! ! - ! ! +!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:19:28'! +test04NewSuperclassHasNoVariables -!ChangesTest methodsFor: 'assertions' stamp: 'HAW 11/1/2019 17:03:04'! -assertIsLoggedOnce: aString + | classToRefactor refactoring classToRefactorCategory newSuperclass | - self assertIsLoggedOnce: aString and: [:logContents :nextPosition | ] ! ! + classToRefactorCategory := self classCategoryOfTestData. + classToRefactor := self createClassNamed: #ClassToAddSuperclass category: classToRefactorCategory. + + refactoring := InsertSuperclass to: classToRefactor named: #AddedSuperclass. + newSuperclass := refactoring apply. + + self assert: newSuperclass instVarNames isEmpty. + self assert: newSuperclass classVarNames isEmpty. + self assert: newSuperclass sharedPools isEmpty.! ! -!ChangesTest methodsFor: 'assertions' stamp: 'HAW 11/1/2019 17:02:33'! -assertIsLoggedOnce: aString and: aBlock +!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:21:16'! +test05NewSuperclassShouldNotExist - self assertIsLogged: aString times: 1 and: aBlock! ! + | classToRefactor existingClass existingClassName | + + classToRefactor := self createClassNamed: #ClassToAddSuperclass. + existingClassName := #AlreadyExistingClass. + existingClass := self createClassNamed: existingClassName. + + self + assertCreation: [ InsertSuperclass to: classToRefactor named: existingClassName ] + failsWith: [ NewClassPrecondition errorMessageForAlreadyExistClassNamed: existingClass name ].! ! -!ChangesTest methodsFor: 'assertions' stamp: 'HAW 11/1/2019 17:03:30'! -assertIsLoggedTwice: aString +!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:22:13'! +test06NewSuperclassNameHasToBeASymbol - self assertIsLogged: aString times: 2 and: [:logContents :nextPosition | ] ! ! + self + assertCreation: [ InsertSuperclass to: self class named: 'aString' ] + failsWith: [ NewClassPrecondition newNameMustBeSymbolErrorMessage ].! ! -!ChangesTest methodsFor: 'user changes' stamp: 'jmv 5/16/2022 09:26:36'! -changeUserChangesFileWhile: aBlock +!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 5/24/2019 10:09:41'! +test07NewSuperclassNameHasToStartWithUppercaseLetter + + self + assertCreation: [ InsertSuperclass to: self class named: #_A ] + failsWith: [ NewClassPrecondition newNameMustStartWithRightLetterErrorMessage ].! ! - ^ PreferenceNG - withTemporaryValue: self userChangesForTestsFileExtension - of: #userChangesFileNameExtension - do: aBlock.! ! +!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:22:31'! +test08WhenAppliedToMetaclassWorksAsWithClass -!ChangesTest methodsFor: 'user changes' stamp: 'HAW 11/1/2019 17:07:57'! -scanChangesFromFile + | classToRefactor refactoring newSuperclass | + + classToRefactor := self createClassNamed: #ClassToAddSuperclass. + + refactoring := InsertSuperclass to: classToRefactor class named: #AddedSuperclass. + newSuperclass := refactoring apply. + + self assert: newSuperclass equals: classToRefactor superclass.! ! - | fileStream changeList | +!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:22:56'! +test09NewSuperclassNameCanNotBeEmpty - fileStream := Smalltalk defaultUserChangesName asFileEntry readStream. - changeList := ChangeList new scanFile: fileStream from: 0 to: fileStream size. + self + assertCreation: [ InsertSuperclass to: self class named: '' asSymbol ] + failsWith: [ NewClassPrecondition newClassNameCanNotBeEmptyErrorMessage ].! ! - ^ changeList changeList. -! ! +!InsertSuperclassTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 09:13:27'! +test10NewSuperclassNameCanNotHaveSpaces + + self + assertCreation: [ InsertSuperclass to: self class named: 'With spaces' asSymbol ] + failsWith: [ NewClassPrecondition newClassNameCanNotHaveSeparatorsErrorMessage ].! ! -!ChangesTest methodsFor: 'user changes' stamp: 'HAW 11/1/2019 17:08:00'! -userChangesForTestsFile +!MoveToInstanceOrClassMethodTest methodsFor: 'tests' stamp: 'LMY 12/8/2019 18:08:54'! +test01CannotMoveWhenReferencingInstanceVariables + + | classToRefactor selector referencedVariable | - ^self userChangesForTestsFileName asFileEntry! ! + selector := #newMethod. + referencedVariable := 'a'. -!ChangesTest methodsFor: 'user changes' stamp: 'HAW 11/1/2019 17:08:04'! -userChangesForTestsFileExtension + classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: referencedVariable. + classToRefactor compile: selector asString,' ^', referencedVariable. + + self + assertCreation: [ MoveToInstanceOrClassMethod for: classToRefactor >> selector ] + failsWith: [ MoveToInstanceOrClassMethod referencingInstanceVariablesErrorMessage ] +! ! - ^'.test.changes' ! ! +!MoveToInstanceOrClassMethodTest methodsFor: 'tests' stamp: 'LMY 12/8/2019 18:43:15'! +test02CannotMoveToClassWhenLocalVariableIsTheSameAsClassInstanceVariable + + | classToRefactor selector referencedVariable | -!ChangesTest methodsFor: 'user changes' stamp: 'HAW 11/1/2019 17:08:07'! -userChangesForTestsFileName + selector := #newMethod. + referencedVariable := 'a'. - ^(FileIOAccessor default baseNameFor: Smalltalk imageName), self userChangesForTestsFileExtension! ! + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor class addInstVarName: referencedVariable. + classToRefactor compile: selector asString, '|', referencedVariable, '|'. + + self + assertCreation: [ MoveToInstanceOrClassMethod for: classToRefactor >> selector ] + failsWith: [ MoveToInstanceOrClassMethod localVariableConflictsWithInstanceVariableErrorMessage ] +! ! -!ChangesTest methodsFor: 'setUp/tearDown' stamp: 'HAW 12/17/2019 10:36:27'! -tearDown +!MoveToInstanceOrClassMethodTest methodsFor: 'tests' stamp: 'LMY 12/8/2019 23:35:40'! +test03CannotMoveToInstanceWhenLocalVariableIsTheSameAsClassInstanceVariable + + | classToRefactor selector referencedVariable | - self userChangesForTestsFile delete. - super tearDown ! ! + selector := #newMethod. + referencedVariable := 'a'. -!ChangesTest methodsFor: 'test data' stamp: 'HAW 12/17/2019 10:37:01'! -createTestDataClass + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor addInstVarName: referencedVariable. + classToRefactor class compile: selector asString, '|', referencedVariable, '|'. + + self + assertCreation: [ MoveToInstanceOrClassMethod for: classToRefactor class >> selector ] + failsWith: [ MoveToInstanceOrClassMethod localVariableConflictsWithInstanceVariableErrorMessage ] +! ! - ^ self createClassNamed: self testDataClassName - ! ! +!MoveToInstanceOrClassMethodTest methodsFor: 'tests' stamp: 'LMY 12/8/2019 23:44:00'! +test04InstanceMethodIsMovedToClassMethod + + | classToRefactor selector moveMethod | -!ChangesTest methodsFor: 'test data' stamp: 'HAW 11/1/2019 17:08:21'! -testDataClassName + selector := #newMethod. - ^ #LogChangesTestClass__! ! + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: selector asString. + + moveMethod := MoveToInstanceOrClassMethod for: classToRefactor >> selector. + moveMethod apply. + + self assert: (classToRefactor class includesSelector: selector). + self deny: (classToRefactor includesSelector: selector). +! ! -!ChangesTest methodsFor: 'scan tests' stamp: 'HAW 11/1/2019 17:08:27'! -test01ScanNewClassChange +!MoveToInstanceOrClassMethodTest methodsFor: 'tests' stamp: 'LMY 12/8/2019 23:51:21'! +test05ClassMethodIsMovedToInstanceMethod + + | classToRefactor selector moveMethod | - | newClass newClassChange | + selector := #newMethod. - self changeUserChangesFileWhile: [ - newClass := self createTestDataClass. - newClassChange := self scanChangesFromFile last. + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor class compile: selector asString. + + moveMethod := MoveToInstanceOrClassMethod for: classToRefactor class >> selector. + moveMethod apply. + + self assert: (classToRefactor includesSelector: selector). + self deny: (classToRefactor class includesSelector: selector). +! ! - self assert: newClassChange changeType equals: #classDefinition. - self assert: newClassChange changeClass equals: newClass. - self deny: newClassChange stamp isNil. - self deny: newClassChange isTestClassChange. - ] ! ! +!MoveToInstanceOrClassMethodTest methodsFor: 'class factory' stamp: 'LMY 12/8/2019 17:35:59'! +classToRefactorName -!ChangesTest methodsFor: 'scan tests' stamp: 'HAW 11/1/2019 17:08:31'! -test02ScanNewMethodChange + ^#ClassToMoveMethod! ! - | newMethodChange newClass | +!PushDownInstanceVariableTest methodsFor: 'class factory' stamp: 'MSC 12/21/2019 09:49:48'! +classToRefactorName + ^#ClassToPushInstanceVariableDown.! ! - self changeUserChangesFileWhile: [ - newClass := self createTestDataClass. - newClass compile: 'm1 ^ 1' classified: 'a-category'. +!PushDownInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:13:23'! +test01AnInstanceVariableDoesNotExistOnClassToFactorCannotBePushedDownToSubclasses + + classToRefactor := self createClassNamed: self classToRefactorName. + + self assertPushDownCreationFailsWith: PushDownInstanceVariable instanceVariableDoesNotExistOnClassToRefactor . + + self deny: (classToRefactor definesInstanceVariableNamed: instanceVariableToPushDown). + classToRefactor subclassesDo: [ :subClass | + self deny: (subClass definesInstanceVariableNamed: instanceVariableToPushDown). + ].! ! - newMethodChange := self scanChangesFromFile last. +!PushDownInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:10:51'! +test02AnInstanceVariableThatIsAccessedOnClassToRefactorCannotBePushedDownToAllSubclasses - self assert: newMethodChange changeType equals: #method. - self assert: newMethodChange methodSelector equals: #m1. - self assert: newMethodChange changeClass equals: newClass. - self assert: newMethodChange prior isNil. - self deny: newMethodChange stamp isNil ] ! ! + | selector | + + selector := #newMethod. + + classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: instanceVariableToPushDown. + classToRefactor compile: selector, '^ ', instanceVariableToPushDown. + + self createClassNamed: #SubclassWithoutInstVarOne subclassOf: classToRefactor. + self createClassNamed: #SubclassWithoutInstVarTwo subclassOf: classToRefactor. + + self assertPushDownCreationFailsWith: (PushDownInstanceVariable + errorMessageForInstanceVariable: instanceVariableToPushDown + isAccessedInMethodsOf: classToRefactor). + + self assert: (classToRefactor definesInstanceVariableNamed: instanceVariableToPushDown). + classToRefactor subclassesDo: [ :subClass | + self deny: (subClass definesInstanceVariableNamed: instanceVariableToPushDown)].! ! -!ChangesTest methodsFor: 'scan tests' stamp: 'HAW 11/1/2019 17:08:34'! -test03ScanMethodModifiedChange +!PushDownInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:49:31'! +test03AnInstanceVariableThatIsNotAccessedOnClassToRefactorShouldBePushedDownToAllSubclasses - | methodModifiedChange newClass | + | pushDown | + + classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: instanceVariableToPushDown. + self createClassNamed: #SubclassWithoutInstVarOne subclassOf: classToRefactor. + self createClassNamed: #SubclassWithoutInstVarTwo subclassOf: classToRefactor. + + pushDown := PushDownInstanceVariable named: instanceVariableToPushDown from: classToRefactor. + pushDown apply. + + self deny: (classToRefactor definesInstanceVariableNamed: instanceVariableToPushDown). + classToRefactor subclassesDo: [ :subClass | + self assert: (subClass definesInstanceVariableNamed: instanceVariableToPushDown). + ].! ! - self changeUserChangesFileWhile: [ - newClass := self createTestDataClass. - newClass compile: 'm1 ^ 1' classified: 'a-category'. - newClass compile: 'm1 ^ 2' classified: 'a-category'. +!PushDownInstanceVariableTest methodsFor: 'setup' stamp: 'MSC 12/21/2019 22:01:42'! +setUp - methodModifiedChange := self scanChangesFromFile last. + super setUp. + + instanceVariableToPushDown := 'a'.! ! - self assert: methodModifiedChange changeType equals: #method. - self assert: methodModifiedChange methodSelector equals: #m1. - self assert: methodModifiedChange changeClass equals: newClass. - self deny: methodModifiedChange prior isNil. - self deny: methodModifiedChange stamp isNil ] -! ! +!PushDownInstanceVariableTest methodsFor: 'assertions' stamp: 'HAW 12/26/2019 19:41:11'! +assertPushDownCreationFailsWith: aMessageTextCreator -!ChangesTest methodsFor: 'scan tests' stamp: 'HAW 11/1/2019 17:08:37'! -test04ScanMethodRemovalChange + self + assertCreation: [ PushDownInstanceVariable named: instanceVariableToPushDown from: classToRefactor. ] + failsWith: aMessageTextCreator ! ! - | methodRemovalChange newClass | +!PushDownMethodTest methodsFor: 'tests' stamp: 'fz 12/4/2019 14:09:00'! +test01AnEmptyMethodOnClassToRefactorShouldBePushedDownToSubclasses - self changeUserChangesFileWhile: [ - newClass := self createTestDataClass. - newClass compile: 'm1 ^ 1' classified: 'a-category'. - newClass removeSelector: #m1. + | classToRefactorSubclass1 classToRefactorSubclass2 classToRefactor selector push | - methodRemovalChange := self scanChangesFromFile last. + selector := #newMethod. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactorSubclass1 := self createClassNamed: #Subclass1 subclassOf: classToRefactor. + classToRefactorSubclass2 := self createClassNamed: #Subclass2 subclassOf: classToRefactor. + + classToRefactor compile: selector asString. + + push := PushDownMethod for: classToRefactor >> selector. + push apply. + + self assert: (classToRefactorSubclass1 includesSelector: selector). + self assert: (classToRefactorSubclass2 includesSelector: selector). + self deny: (classToRefactor includesSelector: selector). + + ! ! - self assert: methodRemovalChange isMethodDeletion. - self assert: methodRemovalChange methodSelector equals: #m1. - self deny: methodRemovalChange stamp isNil ] -! ! +!PushDownMethodTest methodsFor: 'tests' stamp: 'HAW 12/14/2019 11:23:35'! +test02AMethodTemporaryVarDeclaredAsInstVarOnASubclassCanNotBePushedDownToSubclasses + | classToRefactorSubclass1 classToRefactorSubclass2 classToRefactor selector newVariable | + + selector := #newMethod. + newVariable := 'a'. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactorSubclass1 := self createClassNamed: #Subclass1 subclassOf: classToRefactor. + classToRefactorSubclass2 := self createClassNamed: #Subclass2 subclassOf: classToRefactor instanceVariableNames: newVariable. + + classToRefactor compile: selector, '|', newVariable, '|'. + + self + assertCreation: [ PushDownMethod for: classToRefactor >> selector ] + failsWith: [ PushDownMethod errorMessageCanNotPushDownWithShadowedInstVarsOf: + {classToRefactorSubclass2 -> {newVariable }} asDictionary ]. + + self deny: (classToRefactorSubclass1 includesSelector: selector). + self deny: (classToRefactorSubclass2 includesSelector: selector). + self assert: (classToRefactor includesSelector: selector).! ! -!ChangesTest methodsFor: 'scan tests' stamp: 'HAW 11/1/2019 17:08:40'! -test05ScanClassRemovalChange +!PushDownMethodTest methodsFor: 'tests' stamp: 'HAW 12/14/2019 11:24:14'! +test03AMethodArgumentDeclaredAsInstVarOnASubclassCanNotBePushedDownToSubclasses + | classToRefactorSubclass1 classToRefactorSubclass2 classToRefactor selector newVariable | + + selector := #newMethod:. + newVariable := 'a'. + + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactorSubclass1 := self createClassNamed: #Subclass1 subclassOf: classToRefactor. + classToRefactorSubclass2 := self createClassNamed: #Subclass2 subclassOf: classToRefactor instanceVariableNames: newVariable. + + classToRefactor compile: selector, newVariable. + + self + assertCreation: [ PushDownMethod for: classToRefactor >> selector ] + failsWith: [ PushDownMethod errorMessageCanNotPushDownWithShadowedInstVarsOf: + {classToRefactorSubclass2 -> {newVariable }} asDictionary]. + + self deny: (classToRefactorSubclass1 includesSelector: selector). + self deny: (classToRefactorSubclass2 includesSelector: selector). + self assert: (classToRefactor includesSelector: selector).! ! - | classRemovalChange newClass | +!PushDownMethodTest methodsFor: 'tests' stamp: 'fz 12/4/2019 14:58:23'! +test04AMethodAccessesClassToRefactorInstVarShouldBePushedDownToSubclasses + | classToRefactorSubclass1 classToRefactorSubclass2 classToRefactor newVariable selector push | - self changeUserChangesFileWhile: [ - newClass := self createTestDataClass. - newClass removeFromSystem. + selector := #newMethod. + newVariable := 'a'. + + classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: newVariable. + classToRefactorSubclass1 := self createClassNamed: #Subclass1 subclassOf: classToRefactor. + classToRefactorSubclass2 := self createClassNamed: #Subclass2 subclassOf: classToRefactor. + + classToRefactor compile: selector, '^ 1 + ', newVariable. + + push := PushDownMethod for: classToRefactor >> selector. + push apply. + + self assert: (classToRefactorSubclass1 includesSelector: selector). + self assert: (classToRefactorSubclass2 includesSelector: selector). + self deny: (classToRefactor includesSelector: selector).! ! - classRemovalChange := self scanChangesFromFile last. +!PushDownMethodTest methodsFor: 'tests' stamp: 'fz 12/4/2019 14:58:27'! +test05AMethodWritesClassToRefactorInstVarShouldBePushedDownToSubclasses + | classToRefactorSubclass1 classToRefactorSubclass2 classToRefactor newVariable selector push | - self assert: classRemovalChange changeType equals: #classRemoval. - self assert: classRemovalChange changeClassName equals: self testDataClassName. - self assert: classRemovalChange isClassDeletion. - self deny: classRemovalChange stamp isNil ] + selector := #newMethod. + newVariable := 'a'. + + classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: newVariable. + classToRefactorSubclass1 := self createClassNamed: #Subclass1 subclassOf: classToRefactor. + classToRefactorSubclass2 := self createClassNamed: #Subclass2 subclassOf: classToRefactor. + + classToRefactor compile: selector, ' a = 1'. + + push := PushDownMethod for: classToRefactor >> selector. + push apply. + + self assert: (classToRefactorSubclass1 includesSelector: selector). + self assert: (classToRefactorSubclass2 includesSelector: selector). + self deny: (classToRefactor includesSelector: selector).! ! -! ! +!PushDownMethodTest methodsFor: 'tests' stamp: 'HAW 12/14/2019 11:24:59'! +test06AMethodInClassToRefactorExistsInSubClassesShouldOverrideTheExistingSubClassesMethod + + | classToRefactor classToRefactorSubclass newVariable selector subclassMethodContent | + + newVariable := 'a'. + selector := #newMethod. + subclassMethodContent := selector, ' + ^ 2 + ', newVariable, '.'. -!ChangesTest methodsFor: 'scan tests' stamp: 'MGD 12/19/2019 19:37:24'! -test06ScanClassRenamedChange + classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: newVariable. + classToRefactor compile: subclassMethodContent. + + classToRefactorSubclass := self createClassNamed: #Subclass subclassOf: classToRefactor. + classToRefactorSubclass compile: selector, '^ 1 + ', newVariable. - | classRenamedChange newClass | + self + assertCreation: [ PushDownMethod for: classToRefactor >> selector ] + warnsWith: [ PushDownMethod warningMesssageForMessageAlreadyImplementedIn: { classToRefactorSubclass } ]. + + self assert: (classToRefactorSubclass includesSelector: selector). + self assert: (classToRefactor includesSelector: selector).! ! - self changeUserChangesFileWhile: [ - newClass := self createTestDataClass. - newClass rename: #NewTestClass__. +!PushDownMethodTest methodsFor: 'class factory' stamp: 'fz 12/4/2019 14:05:35'! +classToRefactorName - classRenamedChange := self scanChangesFromFile last. + ^#ClassToPushMethodDown! ! - self assert: classRenamedChange changeType equals: #classRenamed. - self assert: classRenamedChange changeClassName equals: self testDataClassName. - self assert: classRenamedChange newClassName equals: #NewTestClass__. - self deny: classRenamedChange stamp isNil. ] -! ! +!PushUpInstanceVariableTest methodsFor: 'class factory' stamp: 'MSC 12/15/2019 12:44:48'! +classToRefactorName + ^#ClassToPushInstanceVariableUp.! ! -!ChangesTest methodsFor: 'log tests' stamp: 'HAW 10/5/2020 11:33:10'! -test01AddingAClassShouldBeLogged - " Log format expected: +!PushUpInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:18:51'! +test01AnInstanceVariableThatIsNotUsedOnClassToRefactorShouldBePushedUpToSuperclass - !!classDefinition: #ClassName category: 'Category' stamp: changeStamp!! - Object subclass: #ClassName - instanceVariableNames: '...' - classVariableNames: '...' - poolDictionaries: '....' - category: 'Category'!! - " - | newClass | + | pushUp | - self changeUserChangesFileWhile: [ - newClass := self createTestDataClass. + classToRefactorSuperClass := self createClassNamed: #SuperclassWithoutInstVar. + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperClass instanceVariableNames: instanceVariableToPushUp. - self assertIsLoggedOnce: '!!classDefinition: #', self testDataClassName, ' category: ''', self classCategoryOfTestData,''' stamp:'. - self assertIsLoggedOnce: newClass definition ] ! ! + pushUp := PushUpInstanceVariable named: instanceVariableToPushUp from: classToRefactor. + pushUp apply. + + self assert: (classToRefactorSuperClass definesInstanceVariableNamed: instanceVariableToPushUp). + classToRefactorSuperClass subclassesDo: [ :subClass | + self deny: (subClass definesInstanceVariableNamed: instanceVariableToPushUp) + ].! ! -!ChangesTest methodsFor: 'log tests' stamp: 'HAW 11/1/2019 17:08:48'! -test02AddingANewMethodShouldBeLogged - " Log format expected: +!PushUpInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:18:52'! +test02AnInstanceVariableOnMultipleSubclassesShouldBeRemovedFromAllSubclassesAndPushedUpToSuperClass - !!Class methodsFor: 'category' stamp: 'author stamp'!! - methodSourceCode - " - | aClass | + | pushUp | - self changeUserChangesFileWhile: [ - aClass := self createTestDataClass. - aClass compile: 'm1 ^ 1' classified: 'a-category'. + classToRefactorSuperClass := self createClassNamed: #SuperclassWithoutInstVar. + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperClass instanceVariableNames: instanceVariableToPushUp. + self createClassNamed: #AnoterSubClassWithInstVar subclassOf: classToRefactorSuperClass instanceVariableNames: instanceVariableToPushUp. + + pushUp := PushUpInstanceVariable named: instanceVariableToPushUp from: classToRefactor. + pushUp apply. + + self assert: (classToRefactorSuperClass definesInstanceVariableNamed: instanceVariableToPushUp). + classToRefactorSuperClass subclassesDo: [ :subClass | + self deny: (subClass definesInstanceVariableNamed: instanceVariableToPushUp) + ].! ! - self assertIsLoggedOnce: '!!', self testDataClassName, ' methodsFor: ''a-category'' stamp:'. - self assertIsLoggedOnce: 'm1 ^ 1'] -! ! +!PushUpInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:13:23'! +test03AnInstanceVariableDoesNotExistOnClassToRefactorCannotBePushedUp + + classToRefactor := self createClassNamed: self classToRefactorName. + + self assertPushUpCreationFailsWith: PushUpInstanceVariable instanceVariableDoesNotExistOnClassToRefactor. + + self deny: (classToRefactor definesInstanceVariableNamed: instanceVariableToPushUp).! ! -!ChangesTest methodsFor: 'log tests' stamp: 'HAW 11/1/2019 17:08:50'! -test03ChangingAMethodShouldBeLogged - " Log format expected: +!PushUpInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/26/2019 20:34:42'! +test04AnInstanceVariableThatIsUsedOnSuperClassAsTemporaryVariableCannotBePushedUp - !!Class methodsFor: 'category' stamp: 'author stamp'!! - newMethodSourceCode - " - | aClass | + | selector | - self changeUserChangesFileWhile: [ - aClass := self createTestDataClass. - aClass compile: 'm1 ^ 1' classified: 'a-category'. - aClass compile: 'm1 ^ 2' classified: 'a-category'. - - self assertIsLoggedTwice: '!!', self testDataClassName , ' methodsFor: ''a-category'' stamp:'. - self assertIsLoggedOnce: 'prior: '. - self assertIsLoggedOnce: 'm1 ^ 2' ] ! ! + selector := #newMethod. + + classToRefactorSuperClass := self createClassNamed: #SuperclassWithVariableAsTemporaryVariable. + classToRefactorSuperClass compile: selector, '| ' , instanceVariableToPushUp , ' |'. + + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperClass instanceVariableNames: instanceVariableToPushUp. + + self assertPushUpCreationFailsWith: (PushUpInstanceVariable + errorMessageForInstanceVariable: instanceVariableToPushUp + isDefinedInMethodsOf: classToRefactorSuperClass). + + self deny: (classToRefactorSuperClass definesInstanceVariableNamed: instanceVariableToPushUp). + self assert: (classToRefactor definesInstanceVariableNamed: instanceVariableToPushUp).! ! -!ChangesTest methodsFor: 'log tests' stamp: 'HAW 11/1/2019 17:08:53'! -test04RemovingAMethodShouldBeLogged - " Log format expected: +!PushUpInstanceVariableTest methodsFor: 'setup' stamp: 'MSC 12/21/2019 22:12:16'! +setUp - !!methodRemoval: #ClassName selector stamp: changeStamp!! - methodSourceCode - " - | newClass methodSource readStream | + super setUp. + + instanceVariableToPushUp := 'a'.! ! - self changeUserChangesFileWhile: [ - newClass := self createTestDataClass. - newClass compile: 'm1 ^ 1' classified: 'a-category'. - newClass removeSelector: #m1. +!PushUpInstanceVariableTest methodsFor: 'assertions' stamp: 'HAW 12/26/2019 20:18:51'! +assertPushUpCreationFailsWith: aMessageTextCreator - self - assertIsLoggedOnce: '!!methodRemoval: ',self testDataClassName, ' #m1 stamp:' - and: [ :logContents :nextPosition | - readStream := ReadStream on: logContents. - readStream position: nextPosition. - readStream nextLine. - methodSource := readStream nextLine. - - self assert: 'm1 ^ 1!!' equals: methodSource ]]! ! + self + assertCreation: [ PushUpInstanceVariable named: instanceVariableToPushUp from: classToRefactor. ] + failsWith: aMessageTextCreator.! ! -!ChangesTest methodsFor: 'log tests' stamp: 'HAW 11/1/2019 17:08:56'! -test05RemovingAClassShouldBeLogged - " Log format expected: +!PushUpMethodTest methodsFor: 'tests' stamp: 'MSC 11/12/2019 11:47:47'! +test01AnEmptyMethodOnClassToRefactorShouldBePushedUpToSuperclass - !!classRemoval: #ClassName stamp: changeStamp!! - classDefinitionMessage - " - | newClass definition loggedDefinition readStream | + | classToRefactorSuperclass classToRefactor selector push | - self changeUserChangesFileWhile: [ - newClass := self createTestDataClass. - definition := newClass definition. - newClass removeFromSystem. + selector := #newMethod. + + classToRefactorSuperclass := self createClassNamed: #Superclass. + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass. + classToRefactor compile: selector asString. + + push := PushUpMethod for: classToRefactor >> selector. + push apply. + + self assert: (classToRefactorSuperclass includesSelector: selector). + self deny: (classToRefactor includesSelector: selector). + + ! ! - self - assertIsLoggedOnce: '!!classRemoval: #', self testDataClassName, ' stamp:' - and: [ :logContents :nextPosition | - readStream := ReadStream on: logContents. - readStream position: nextPosition. - readStream nextLine. - loggedDefinition := readStream upToEnd. - - self assert: definition,'!!' equals: loggedDefinition ]]! ! +!PushUpMethodTest methodsFor: 'tests' stamp: 'MSC 11/12/2019 11:47:51'! +test02AMethodAccessesClassToRefactorInstVarCanNotBePushedUpToSuperclass -!ChangesTest methodsFor: 'log tests' stamp: 'MGD 3/30/2020 17:00:58'! -test06RenamingAClassShouldBeLogged - " Log format expected: + | classToRefactorSuperclass classToRefactor selector newVariable | - !!classRenamed: #OldName as: #NewName stamp stamp:!! - Smalltalk renameClassNamed: #OldName as: #NewName - " - | newClass | + newVariable := 'a'. + selector := #newMethod. + + classToRefactorSuperclass := self createClassNamed: #Superclass. - self changeUserChangesFileWhile: [ - newClass := self createTestDataClass. - newClass rename: #NewTestClass__. + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass instanceVariableNames: newVariable. + classToRefactor compile: selector, '^ 1 + ', newVariable. - self assertIsLoggedOnce: '!!classRenamed: #', self testDataClassName, ' as: #NewTestClass__ stamp:'. - self assertIsLoggedOnce: 'Smalltalk renameClassNamed: #', self testDataClassName, ' as: #NewTestClass__'. - ]! ! + self + assertCreation: [ PushUpMethod for: classToRefactor >> selector ] + failsWith: [ PushUpMethod errorMessageForMethodCannotAccessInstanceVariable ]. + + self deny: (classToRefactorSuperclass includesSelector: selector). + self assert: (classToRefactor includesSelector: selector).! ! -!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:21:47'! -testUpTo1ShortRecords - ". this test ensures the upTo: delim method behaves as specified by the ANSI standard: - Delimiter is considered a separator (and therefore not required for the last chunk)." - | stream | - stream _ ReadStream on: 'record-1Xrecord-2Xrecord-incomplete'. - self assert: ((stream upTo: $X) = 'record-1'). - self assert: ((stream upTo: $X) = 'record-2'). - self assert: ((stream upTo: $X) = 'record-incomplete'). - self assert: ((stream upTo: $X) = ''). - ". the stream has been all consumed" - self assert: (stream position = 35). ! ! +!PushUpMethodTest methodsFor: 'tests' stamp: 'MSC 11/12/2019 11:47:54'! +test03AMethodWritesClassToRefactorInstVarCanNotBePushedUpToSuperclass -!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:55:33'! -testUpTo3LongUnterminatedRecord - "Long input, no delimiter found, expected to return all the data chunk up to the end of file. " - | longString stream read | - longString _ (1 to: 100) - inject: '' - into: [ :prev :each | - prev , 'A lot of stuff, needs over 2000 chars!! ' ]. - stream _ ReadStream on: longString. - read _ stream upTo: $X. - self assert: read = longString.! ! + | classToRefactorSuperclass classToRefactor selector newVariable | -!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:54:11'! -testUpTo4LongUnterminatedRecord - "Big chunk, not delimiter found, expected return all the chunk " - | stuff stream read | - stuff _ String streamContents: [ :strm | - 1 - to: 5000 - do: [ :i | - i < 3000 ifTrue: [ strm nextPut: $a ]. - i >= 3000 ifTrue: [ strm nextPut: $b ]]]. - stream _ ReadStream on: stuff. - read _ stream upTo: $X. - self assert: read size = 5000.! ! + newVariable := 'a'. + selector := #newMethod. + + classToRefactorSuperclass := self createClassNamed: #Superclass. -!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:58:48'! -testUpTo5TerminatedAndUnterminatedLongRecords - "Two big chunks, one delimiter in the middle, expected to return - the first time a big chunk, the second time the second block up to EOF. " - | stuff stream read | - stuff _ String streamContents: [ :strm | - 1 - to: 6000 - do: [ :i | - i < 3000 ifTrue: [ strm nextPut: $a ]. - i = 3000 ifTrue: [ strm nextPut: $X ]. - i > 3000 ifTrue: [ strm nextPut: $b ]]]. - stream _ ReadStream on: stuff. - " first scan, the delimiter is found but not printed. " - read _ stream upTo: $X. - self assert: read size = 2999. - self assert: (read at: 1) = $a. - " second scan. the delimiter is not found, all second chunk is returned " - read _ stream upTo: $X. - self assert: read size = 3000. - self assert: (read at: 1) = $b.! ! + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass instanceVariableNames: newVariable. + classToRefactor compile: selector, ' a = 1'. -!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 10:59:51'! -testUpTo6TerminatedLongRecords - "Two big chunks, one delimiter in the middle, one at the end. expected to return - two big chunks in two read, delimiters excluded. " - | stuff stream read | - stuff _ String streamContents: [ :strm | - 1 - to: 6000 - do: [ :i | - i < 3000 ifTrue: [ strm nextPut: $a ]. - i = 3000 ifTrue: [ strm nextPut: $X ]. - ((Interval - from: 3001 - to: 5999) includes: i) ifTrue: [ strm nextPut: $b ]. - i = 6000 ifTrue: [ strm nextPut: $X ]]]. - stream _ ReadStream on: stuff. - " first scan, delimiter is found, return all the block delimiter excluded " - read _ stream upTo: $X. - self assert: read size = 2999. - self assert: (read at: 1) = $a. - " second scan, return chunk, delimiter excluded. " - read _ stream upTo: $X. - self assert: read size = 2999. - self assert: (read at: 1) = $b.! ! + self + assertCreation: [ PushUpMethod for: classToRefactor >> selector ] + failsWith: [ PushUpMethod errorMessageForMethodCannotAccessInstanceVariable ]. + + self deny: (classToRefactorSuperclass includesSelector: selector). + self assert: (classToRefactor includesSelector: selector).! ! -!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:00:52'! -testUpToTerminator1ShortRecords - " - . Read a file stream up to 'delim' in a strict way. - . If delim is found returns everything up to the first occurrence of 'delim' included. - . if delim is not found returns nil and set the FileStream position where it was before - the call was made. This ensures if another process writes into the file another delim - limited token we will fully read it on next upTo call. - This means Delimiter is a Terminator: a chunk is only considered well formed if it ends with it. - " - | stream | - stream _ ReadStream on: 'record-1Xrecord-2Xrecord-incomplete'. - self assert: ((stream upTo: $X delimiterIsTerminator: true) = 'record-1X'). - self assert: ((stream upTo: $X delimiterIsTerminator: true) = 'record-2X'). - self assert: ((stream upTo: $X delimiterIsTerminator: true) = nil). - ". we are not at the end of the stream, but just after the last delim was found. - we are ready to receive other delim limitated tokens. if they get written. - " - self assert: (stream position = 18).! ! +!PushUpMethodTest methodsFor: 'tests' stamp: 'MSC 11/12/2019 11:47:57'! +test04AMethodWritesSuperClassInstVarShouldBePushedUpToSuperclass -!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:01:38'! -testUpToTerminator3LongUnterminatedRecord - "Long input, no delimiter found, expected to return nil. " - | longString stream read | - longString _ (1 to: 100) - inject: '' - into: [ :prev :each | - prev , 'A lot of stuff, needs over 2000 chars!! ' ]. - stream _ ReadStream on: longString. - read _ stream - upTo: $X - delimiterIsTerminator: true. - self assert: read = nil.! ! + | classToRefactorSuperclass classToRefactor selector newVariable push | -!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:02:04'! -testUpToTerminator4LongUnterminatedRecord - "Big chunk, not delimiter found, expected return nil " - | stuff stream read | - stuff _ String streamContents: [ :strm | - 1 - to: 5000 - do: [ :i | - i < 3000 ifTrue: [ strm nextPut: $a ]. - i >= 3000 ifTrue: [ strm nextPut: $b ]]]. - stream _ ReadStream on: stuff. - read _ stream - upTo: $X - delimiterIsTerminator: true. - self assert: read = nil.! ! + newVariable := 'a'. + selector := #newMethod. + + classToRefactorSuperclass := self createClassNamed: #Superclass instanceVariableNames: newVariable. -!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:02:36'! -testUpToTerminator5TerminatedAndUnterminatedLongRecords - "Two big chunks, one delimiter in the middle, expected to return - the first time a big chunk, the second time nil. " - | stuff stream read | - stuff _ String streamContents: [ :strm | - 1 - to: 6000 - do: [ :i | - i < 3000 ifTrue: [ strm nextPut: $a ]. - i = 3000 ifTrue: [ strm nextPut: $X ]. - i > 3000 ifTrue: [ strm nextPut: $b ]]]. - stream _ ReadStream on: stuff. - " first scan, delimiter is found, return all the block delimiter included " - read _ stream - upTo: $X - delimiterIsTerminator: true. - self assert: read size = 3000. - self assert: (read at: 1) = $a. - " second scan, delimiter not found, returns nil " - read _ stream - upTo: $X - delimiterIsTerminator: true. - self assert: read = nil.! ! + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass. + classToRefactor compile: selector, ' a = 1'. -!ReadStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:03:06'! -testUpToTerminator6TerminatedLongRecords - "Two big chunks, one delimiter in the middle, one at the end expected to return - two big chunks in two read, delimiters included. " - | stuff stream read | - stuff _ String streamContents: [ :strm | - 1 - to: 6000 - do: [ :i | - i < 3000 ifTrue: [ strm nextPut: $a ]. - i = 3000 ifTrue: [ strm nextPut: $X ]. - ((Interval - from: 3001 - to: 5999) includes: i) ifTrue: [ strm nextPut: $b ]. - i = 6000 ifTrue: [ strm nextPut: $X ]]]. - stream _ ReadStream on: stuff. - " first scan, delimiter is found, return all the block delimiter included " - read _ stream - upTo: $X - delimiterIsTerminator: true. - self assert: read size = 3000. - self assert: (read at: 1) = $a. - " second scan, delimiter found, return chunk, delimiter included " - read _ stream - upTo: $X - delimiterIsTerminator: true. - self assert: read size = 3000. - self assert: (read at: 1) = $b.! ! + push := PushUpMethod for: classToRefactor >> selector. + push apply. + + self assert: (classToRefactorSuperclass includesSelector: selector). + self deny: (classToRefactor includesSelector: selector).! ! -!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:06:39'! -testUpTo1ShortRecords - ". this test ensures the upTo: delim method behaves as specified by the ANSI standard: - Delimiter is considered a separator (and therefore not required for the last chunk)." - | stream | - stream _ ReadWriteStream on: ''. - stream nextPutAll: 'record-1Xrecord-2Xrecord-incomplete'. - stream position: 0. - self assert: ((stream upTo: $X) = 'record-1'). - self assert: ((stream upTo: $X) = 'record-2'). - self assert: ((stream upTo: $X) = 'record-incomplete'). - self assert: ((stream upTo: $X) = ''). - ". the stream has been all consumed" - self assert: (stream position = 35). ! ! +!PushUpMethodTest methodsFor: 'tests' stamp: 'MSC 11/12/2019 11:48:00'! +test05AMethodAccessesSuperClassClassToRefactorInstVarShouldBePushedUpToSuperclass -!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:07:32'! -testUpTo3LongUnterminatedRecord - "Long input, no delimiter found, expected to return all the data chunk up to the end of file. " - | longString stream read | - longString _ (1 to: 100) - inject: '' - into: [ :prev :each | - prev , 'A lot of stuff, needs over 2000 chars!! ' ]. - stream _ ReadWriteStream on: ''. - stream nextPutAll: longString. - stream position: 0. - read _ stream upTo: $X. - self assert: read = longString.! ! + | classToRefactorSuperclass classToRefactor selector newVariable push | -!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:08:12'! -testUpTo4LongUnterminatedRecord - "Big chunk, not delimiter found, expected return all the chunk " - | stuff stream read | - stuff _ String streamContents: [ :strm | - 1 - to: 5000 - do: [ :i | - i < 3000 ifTrue: [ strm nextPut: $a ]. - i >= 3000 ifTrue: [ strm nextPut: $b ]]]. - stream _ ReadWriteStream on: ''. - stream nextPutAll: stuff. - stream position: 0. - read _ stream upTo: $X. - self assert: read size = 5000.! ! + newVariable := 'a'. + selector := #newMethod. + + classToRefactorSuperclass := self createClassNamed: #Superclass instanceVariableNames: newVariable. -!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:08:41'! -testUpTo5TerminatedAndUnterminatedLongRecords - "Two big chunks, one delimiter in the middle, expected to return - the first time a big chunk, the second time the second block up to EOF. " - | stuff stream read | - stuff _ String streamContents: [ :strm | - 1 - to: 6000 - do: [ :i | - i < 3000 ifTrue: [ strm nextPut: $a ]. - i = 3000 ifTrue: [ strm nextPut: $X ]. - i > 3000 ifTrue: [ strm nextPut: $b ]]]. - stream _ ReadWriteStream on: ''. - stream nextPutAll: stuff. - stream position: 0. - " first scan, the delimiter is found but not printed. " - read _ stream upTo: $X. - self assert: read size = 2999. - self assert: (read at: 1) = $a. - " second scan. the delimiter is not found, all second chunk is returned " - read _ stream upTo: $X. - self assert: read size = 3000. - self assert: (read at: 1) = $b.! ! + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass. + classToRefactor compile: selector, '^ 1 + ', newVariable. -!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:08:54'! -testUpTo6TerminatedLongRecords - "Two big chunks, one delimiter in the middle, one at the end. expected to return - two big chunks in two read, delimiters excluded. " - | stuff stream read | - stuff _ String streamContents: [ :strm | - 1 - to: 6000 - do: [ :i | - i < 3000 ifTrue: [ strm nextPut: $a ]. - i = 3000 ifTrue: [ strm nextPut: $X ]. - ((Interval - from: 3001 - to: 5999) includes: i) ifTrue: [ strm nextPut: $b ]. - i = 6000 ifTrue: [ strm nextPut: $X ]]]. - stream _ ReadWriteStream on: ''. - stream nextPutAll: stuff. - stream position: 0. - " first scan, delimiter is found, return all the block delimiter excluded " - read _ stream upTo: $X. - self assert: read size = 2999. - self assert: (read at: 1) = $a. - " second scan, return chunk, delimiter excluded. " - read _ stream upTo: $X. - self assert: read size = 2999. - self assert: (read at: 1) = $b.! ! + push := PushUpMethod for: classToRefactor >> selector. + push apply. + + self assert: (classToRefactorSuperclass includesSelector: selector). + self deny: (classToRefactor includesSelector: selector).! ! + +!PushUpMethodTest methodsFor: 'tests' stamp: 'MSC 11/12/2019 11:48:03'! +test06AMethodAccessesSuperClassClassToRefactorInstVarShouldBePushedUpToSuperclass + + | classToRefactorSuperclass classToRefactor selector newVariable push | + + newVariable := 'a'. + selector := #newMethod. + + classToRefactorSuperclass := self createClassNamed: #Superclass instanceVariableNames: newVariable. -!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:12:06'! -testUpToTerminator1ShortRecords - " - . Read a file stream up to 'delim' in a strict way. - . If delim is found returns everything up to the first occurrence of 'delim' included. - . if delim is not found returns nil and set the FileStream position where it was before - the call was made. This ensures if another process writes into the file another delim - limited token we will fully read it on next upTo call. - This means Delimiter is a Terminator: a chunk is only considered well formed if it ends with it. - " - | stream | - stream _ ReadWriteStream on: ''. - stream nextPutAll: 'record-1Xrecord-2Xrecord-incomplete'. - stream position: 0. - self assert: ((stream upTo: $X delimiterIsTerminator: true) = 'record-1X'). - self assert: ((stream upTo: $X delimiterIsTerminator: true) = 'record-2X'). - self assert: ((stream upTo: $X delimiterIsTerminator: true) = nil). - ". we are not at the end of the stream, but just after the last delim was found. - we are ready to receive other delim limitated tokens. if they get written. - " - self assert: (stream position = 18).! ! + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass. + classToRefactor compile: selector, '^ 1 + ', newVariable. -!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:12:49'! -testUpToTerminator3LongUnterminatedRecord - "Long input, no delimiter found, expected to return nil. " - | longString stream read | - longString _ (1 to: 100) - inject: '' - into: [ :prev :each | - prev , 'A lot of stuff, needs over 2000 chars!! ' ]. - stream _ ReadWriteStream on: ''. - stream nextPutAll: longString. - stream position: 0. - read _ stream - upTo: $X - delimiterIsTerminator: true. - self assert: read = nil.! ! + push := PushUpMethod for: classToRefactor >> selector. + push apply. + + self assert: (classToRefactorSuperclass includesSelector: selector). + self deny: (classToRefactor includesSelector: selector).! ! -!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:13:03'! -testUpToTerminator4LongUnterminatedRecord - "Big chunk, not delimiter found, expected return nil " - | stuff stream read | - stuff _ String streamContents: [ :strm | - 1 - to: 5000 - do: [ :i | - i < 3000 ifTrue: [ strm nextPut: $a ]. - i >= 3000 ifTrue: [ strm nextPut: $b ]]]. - stream _ ReadWriteStream on: ''. - stream nextPutAll: stuff. - stream position: 0. - read _ stream - upTo: $X - delimiterIsTerminator: true. - self assert: read = nil.! ! +!PushUpMethodTest methodsFor: 'tests' stamp: 'HAW 12/14/2019 11:25:39'! +test07AMethodInClassToRefactorExistsInSuperClassShouldOverrideTheExistingSuperClassMethod + + | classToRefactor classToRefactorSuperclass newVariable selector superclassMethodContent | + + newVariable := 'a'. + selector := #newMethod. + superclassMethodContent := selector, ' + ^ 2 + ', newVariable, '.'. + + classToRefactorSuperclass := self createClassNamed: #Superclass instanceVariableNames: newVariable. + classToRefactorSuperclass compile: selector, '^ 1 + ', newVariable. -!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:13:18'! -testUpToTerminator5TerminatedAndUnterminatedLongRecords - "Two big chunks, one delimiter in the middle, expected to return - the first time a big chunk, the second time nil. " - | stuff stream read | - stuff _ String streamContents: [ :strm | - 1 - to: 6000 - do: [ :i | - i < 3000 ifTrue: [ strm nextPut: $a ]. - i = 3000 ifTrue: [ strm nextPut: $X ]. - i > 3000 ifTrue: [ strm nextPut: $b ]]]. - stream _ ReadWriteStream on: ''. - stream nextPutAll: stuff. - stream position: 0. - " first scan, delimiter is found, return all the block delimiter included " - read _ stream - upTo: $X - delimiterIsTerminator: true. - self assert: read size = 3000. - self assert: (read at: 1) = $a. - " second scan, delimiter not found, returns nil " - read _ stream - upTo: $X - delimiterIsTerminator: true. - self assert: read = nil.! ! + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass. + classToRefactor compile: superclassMethodContent. -!ReadWriteStreamTest methodsFor: 'tests' stamp: 'NM 10/25/2021 11:13:33'! -testUpToTerminator6TerminatedLongRecords - "Two big chunks, one delimiter in the middle, one at the end expected to return - two big chunks in two read, delimiters included. " - | stuff stream read | - stuff _ String streamContents: [ :strm | - 1 - to: 6000 - do: [ :i | - i < 3000 ifTrue: [ strm nextPut: $a ]. - i = 3000 ifTrue: [ strm nextPut: $X ]. - ((Interval - from: 3001 - to: 5999) includes: i) ifTrue: [ strm nextPut: $b ]. - i = 6000 ifTrue: [ strm nextPut: $X ]]]. - stream _ ReadWriteStream on: ''. - stream nextPutAll: stuff. - stream position: 0. - " first scan, delimiter is found, return all the block delimiter included " - read _ stream - upTo: $X - delimiterIsTerminator: true. - self assert: read size = 3000. - self assert: (read at: 1) = $a. - " second scan, delimiter found, return chunk, delimiter included " - read _ stream - upTo: $X - delimiterIsTerminator: true. - self assert: read size = 3000. - self assert: (read at: 1) = $b.! ! + self + assertCreation: [ PushUpMethod for: classToRefactor >> selector ] + warnsWith: [ PushUpMethod methodToPushUpExistOnSuperclassWarningMessage ]. + + self assert: (classToRefactorSuperclass includesSelector: selector). + self assert: (classToRefactor includesSelector: selector).! ! -!WriteStreamTest methodsFor: 'tests' stamp: 'jpb 8/2/2019 23:49:13'! -testIsStream - self assert: ((WriteStream on: '') is: #Stream).! ! +!PushUpMethodTest methodsFor: 'class factory' stamp: 'MSC 11/12/2019 11:48:09'! +classToRefactorName -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:27:06'! -testNewLineTabWhenConditionIsFalseDoesNotPutANewLineTabInStream + ^#ClassToPushMethodUp! ! - | stream | +!RemoveAllUnreferencedInstanceVariablesTest methodsFor: 'tests' stamp: 'HAW 8/2/2018 16:15:11'! +test01NoVariableIsRemovedWhenClassHasNoInstanceVariable - stream := WriteStream on: ''. - stream newLineTab: 2 when: false. + | classToRefactor refactoring removedInstanceVariables | - self assert: stream contents isEmpty + classToRefactor := self createClassNamed: #ClassWithoutInstVar. + + refactoring := RemoveAllUnreferencedInstanceVariables from: classToRefactor. + removedInstanceVariables := refactoring apply. + + self assert: removedInstanceVariables isEmpty! ! + +!RemoveAllUnreferencedInstanceVariablesTest methodsFor: 'tests' stamp: 'HAW 8/2/2018 16:15:14'! +test02UnreferencedVariablesAreRemoved + + | classToRefactor refactoring removedInstanceVariables unreferencedVariable | + + unreferencedVariable := 'a'. + classToRefactor := self createClassNamed: #ClassWithInstVar instanceVariableNames: unreferencedVariable. + + refactoring := RemoveAllUnreferencedInstanceVariables from: classToRefactor. + removedInstanceVariables := refactoring apply. + + self assert: 1 equals: removedInstanceVariables size. + self assert: (removedInstanceVariables includes: unreferencedVariable) ! ! -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:28:04'! -testNewLineTabWhenConditionIsTruePutsANewLineTabInStream +!RemoveAllUnreferencedInstanceVariablesTest methodsFor: 'tests' stamp: 'HAW 8/2/2018 16:15:18'! +test03VariablesWithReferencesAreNotRemoved - | stream | + | classToRefactor refactoring removedInstanceVariables unreferencedVariableName referencedVariableName | + + referencedVariableName := 'a'. + unreferencedVariableName := 'b'. + classToRefactor := self createClassNamed: #ClassWithInstVar instanceVariableNames: referencedVariableName, ' ', unreferencedVariableName. + classToRefactor compile: 'm1 ^', referencedVariableName. + + refactoring := RemoveAllUnreferencedInstanceVariables from: classToRefactor. + removedInstanceVariables := refactoring apply. + + self assert: 1 equals: removedInstanceVariables size. + self assert: (removedInstanceVariables includes: unreferencedVariableName). + + +! ! - stream := WriteStream on: ''. - stream newLineTab: 2 when: true. +!RemoveAllUnreferencedInstanceVariablesTest methodsFor: 'tests' stamp: 'HAW 8/2/2018 16:22:44'! +test04VariablesWithReferencesInSubclassesAreNotRemoved + + | classToRefactor refactoring removedInstanceVariables unreferencedVariableName referencedVariableName classToRefactorSubclass | + + referencedVariableName := 'a'. + unreferencedVariableName := 'b'. + classToRefactor := self createClassNamed: #ClassWithInstVar instanceVariableNames: referencedVariableName, ' ', unreferencedVariableName. + classToRefactorSubclass := self createClassNamed: #ClassWithReferenceInstVar subclassOf: classToRefactor. + classToRefactorSubclass compile: 'm1 ^', referencedVariableName. + + refactoring := RemoveAllUnreferencedInstanceVariables from: classToRefactor. + removedInstanceVariables := refactoring apply. + + self assert: 1 equals: removedInstanceVariables size. + self assert: (removedInstanceVariables includes: unreferencedVariableName). + +! ! + +!RemoveInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 6/12/2017 19:10:08'! +test01CanNotRemoveAnInstanceVariableNotDefinedInClass + + | variableToRemove classToRefactor | + + variableToRemove := 'a'. + classToRefactor := self createClassNamed: #ClassWithoutInstVar. + + self + assertCreation: [ RemoveInstanceVariable named: variableToRemove from: classToRefactor ] + failsWith: [ RemoveInstanceVariable errorMessageForInstanceVariable: variableToRemove notDefinedIn: classToRefactor ]. + - self assert: (String streamContents: [ :s | s newLineTab: 2 ]) equals: stream contents ! ! -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:20:47'! -testNewLineWhenConditionIsFalseDoesNotPutANewLineInStream +!RemoveInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 8/2/2018 15:24:17'! +test02CanNotRemoveInstanceVariableWithReferences - | stream | + | variableToRemove classToRefactor selector | + + variableToRemove := 'a'. + classToRefactor := self createClassNamed: #ClassWithInstVar instanceVariableNames: variableToRemove. + selector := #m1. + classToRefactor compile: selector,' ^', variableToRemove. + + self + assertCreation: [ RemoveInstanceVariable named: variableToRemove from: classToRefactor ] + failsWith: [ RemoveInstanceVariable errorMessageForInstanceVariable: variableToRemove isReferencedInAll: (Array with: classToRefactor>>selector) ]. + + + ! ! - stream := WriteStream on: ''. - stream newLineWhen: false. +!RemoveInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 8/2/2018 15:24:28'! +test03WhenAppliedRemovesInstanceVariable + + | variableToRemove classToRefactor remove | + + variableToRemove := 'a'. + classToRefactor := self createClassNamed: #ClassWithInstVar instanceVariableNames: variableToRemove. + + remove := RemoveInstanceVariable named: variableToRemove from: classToRefactor. + remove apply. + + self deny: (classToRefactor definesInstanceVariableNamed: variableToRemove) - self assert: stream contents isEmpty ! ! -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:22:05'! -testNewLineWhenConditionIsTruePutsANewLineInStream +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 1/2/2020 06:58:49'! +test01CanNotRemoveParameterFromUnaryMessages - | stream | + self + assertCreation: [ RemoveParameter + atIndex: 1 + named: 'aParameter' + from: #m1 + implementors: {} + senders: {} ] + failsWith: [ RemoveParameter canNotRemoveParameterFromUnaryMessagesErrorMessage ] +! ! - stream := WriteStream on: ''. - stream newLineWhen: true. +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 1/2/2020 06:59:13'! +test02CanNotRemoveParameterFromBinaryMessages + + self + assertCreation: [ RemoveParameter + atIndex: 1 + named: '+' asSymbol + from: #+ + implementors: {} + senders: {} ] + failsWith: [ RemoveParameter canNotRemoveParameterFromBinaryMessagesErrorMessage ] +! ! + +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/2/2018 19:46:52'! +test03CanNotRemoveParameterNotInMessage + + | classToRefactor selectorToRemoveParameterFrom parameterNotInMessage | - self assert: Character newLineCharacter asString equals: stream contents - ! ! + classToRefactor := self createClassNamed: self classToRefactorName. + selectorToRemoveParameterFrom := 'm1:' asSymbol. + classToRefactor compile: selectorToRemoveParameterFrom asString, ' parameter'. + parameterNotInMessage := 'otherParameter'. -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:06:13'! -testNextPutAllWhenConditionIsFalseDoesNotPutCollectionInStream + self + assertCreation: [ RemoveParameter + named: parameterNotInMessage + from: classToRefactor>>selectorToRemoveParameterFrom + implementors: {classToRefactor >> selectorToRemoveParameterFrom } + senders: {} ] + failsWith: [ RemoveParameter errorMessageForParameterNotInMessage: parameterNotInMessage ] +! ! - | stream | +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/2/2018 19:46:03'! +test04AllImplementorsMustImplementSelector - stream := WriteStream on: ''. - stream nextPutAll: 'other' when: false. + | classToRefactor selectorToRemoveParameterFrom parameterToRemove implementors | - self assert: stream contents isEmpty - ! ! + classToRefactor := self createClassNamed: self classToRefactorName. + selectorToRemoveParameterFrom := 'm1:' asSymbol. + parameterToRemove := 'parameter'. + classToRefactor compile: selectorToRemoveParameterFrom asString, ' parameter'. + implementors := {thisContext method}. + + self + assertCreation: [ RemoveParameter + named: parameterToRemove + from: classToRefactor>>selectorToRemoveParameterFrom + implementors: implementors + senders: {} ] + failsWith: [ RemoveParameter errorMessageForInvalidImplementors: implementors ] +! ! -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:06:19'! -testNextPutAllWhenConditionIsTruePutsCollectionInStream +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/2/2018 19:49:28'! +test05AllSendersShouldSendSelector - | stream | + | classToRefactor selectorToRemoveParameterFrom parameterToRemove invalidSenders | - stream := WriteStream on: ''. - stream nextPutAll: 'other' when: true. + classToRefactor := self createClassNamed: self classToRefactorName. + selectorToRemoveParameterFrom := 'm1:' asSymbol. + parameterToRemove := 'parameter'. + classToRefactor compile: selectorToRemoveParameterFrom asString, ' parameter'. + invalidSenders := {thisContext method}. - self assert: 'other' equals: stream contents + self + assertCreation: [ RemoveParameter + named: parameterToRemove + from: classToRefactor>>selectorToRemoveParameterFrom + implementors: {} + senders: invalidSenders ] + failsWith: [ RemoveParameter errorMessageForInvalidSenders: invalidSenders of: selectorToRemoveParameterFrom ] - ! ! +! ! -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:06:24'! -testNextPutWhenConditionIsFalseDoesNotPutObjectInStream +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/2/2018 19:57:35'! +test06NoImplementorReferencesParameterToRemove - | stream | - - stream := WriteStream on: ''. - stream nextPut: $t when: false. + | classToRefactor selectorToRemoveParameterFrom parameterToRemove implementorsReferencingParameter | - self assert: stream contents isEmpty + classToRefactor := self createClassNamed: self classToRefactorName. + selectorToRemoveParameterFrom := 'm1:' asSymbol. + parameterToRemove := 'parameter'. + classToRefactor compile: selectorToRemoveParameterFrom asString, ' parameter ^parameter'. + implementorsReferencingParameter := {classToRefactor>>selectorToRemoveParameterFrom }. - ! ! + self + assertCreation: [ RemoveParameter + named: parameterToRemove + from: classToRefactor>>selectorToRemoveParameterFrom + implementors: implementorsReferencingParameter + senders: {} ] + failsWith: [ RemoveParameter errorMessageForParameterToRemoveIsReferenced: parameterToRemove ]! ! -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:06:28'! -testNextPutWhenConditionIsTruePutsObjectInStream +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/3/2018 17:58:11'! +test07FirstParameterIsRemovedCorrectly - | stream | + | classToRefactor selectorToRemoveParameterFrom parameterToRemove keywordToRemove keywordToKeep parameterToKeep refactoring | - stream := WriteStream on: ''. - stream nextPut: $t when: true. + classToRefactor := self createClassNamed: self classToRefactorName. + keywordToRemove := 'm1:'. + keywordToKeep := 'm2:'. + selectorToRemoveParameterFrom := (keywordToRemove, keywordToKeep) asSymbol. + parameterToRemove := 'parameter1'. + parameterToKeep := 'parameter2'. + classToRefactor compile: keywordToRemove,parameterToRemove, ' + ', keywordToKeep, parameterToKeep. - self assert: 't' equals: stream contents + refactoring := RemoveParameter + named: parameterToRemove + from: classToRefactor>>selectorToRemoveParameterFrom + implementors: { classToRefactor>>selectorToRemoveParameterFrom } + senders: {}. + refactoring apply. - ! ! + self assert: (classToRefactor canUnderstand: keywordToKeep asSymbol). + self assert: (classToRefactor sourceCodeAt: keywordToKeep asSymbol) equals: (keywordToKeep, parameterToKeep) ! ! -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:13:06'! -testPrintWhenConditionIsFalseDoesNotPrintObjectInStream +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/3/2018 18:45:48'! +test08LastParameterIsRemovedCorrectly - | stream | + | classToRefactor selectorToRemoveParameterFrom parameterToRemove keywordToRemove keywordToKeep parameterToKeep refactoring | - stream := WriteStream on: ''. - stream print: Object when: false. + classToRefactor := self createClassNamed: self classToRefactorName. + keywordToKeep := 'm1:'. + keywordToRemove := 'm2:'. + selectorToRemoveParameterFrom := (keywordToKeep, keywordToRemove) asSymbol. + parameterToKeep := 'parameter1'. + parameterToRemove := 'parameter2'. + classToRefactor compile: keywordToKeep,parameterToKeep, ' ', keywordToRemove, parameterToRemove,' + | t1 |'. - self assert: stream contents isEmpty + refactoring := RemoveParameter + named: parameterToRemove + from: classToRefactor>>selectorToRemoveParameterFrom + implementors: { classToRefactor>>selectorToRemoveParameterFrom } + senders: {}. + refactoring apply. - ! ! + self assert: (classToRefactor canUnderstand: keywordToKeep asSymbol). + self assert: (classToRefactor sourceCodeAt: keywordToKeep asSymbol) equals: (keywordToKeep, parameterToKeep,' + | t1 |') ! ! -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:06:44'! -testPrintWhenConditionIsTruePrintsObjectInStream +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/4/2018 14:34:22'! +test09MiddleParameterIsRemovedCorrectly - | stream | + | classToRefactor selectorToRemoveParameterFrom parameterToRemove keywordToRemove keywordToKeep parameterToKeep refactoring newSelector | - stream := WriteStream on: ''. - stream print: Object when: true. + classToRefactor := self createClassNamed: self classToRefactorName. + keywordToRemove := 'm1:'. + keywordToKeep := 'm2:'. + selectorToRemoveParameterFrom := ('m0:',keywordToRemove, keywordToKeep) asSymbol. + newSelector := ('m0:', keywordToKeep) asSymbol. + parameterToRemove := 'parameter1'. + parameterToKeep := 'parameter2'. + classToRefactor compile: 'm0: parameter0 + ',keywordToRemove,parameterToRemove, ' + ', keywordToKeep, parameterToKeep. - self assert: Object printString equals: stream contents! ! - -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:42:20'! -testSpaceManyTimesWhenConditionIsFalseDoesNotPutASpaceInStream + refactoring := RemoveParameter + named: parameterToRemove + from: classToRefactor>>selectorToRemoveParameterFrom + implementors: { classToRefactor>>selectorToRemoveParameterFrom } + senders: {}. + refactoring apply. + + self assert: (classToRefactor canUnderstand: newSelector). + self assert: (classToRefactor sourceCodeAt: newSelector) equals: ('m0: parameter0 + ',keywordToKeep, parameterToKeep) ! ! - | stream | +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 9/3/2018 17:34:00'! +test10ParameterFromOneKeywordSelectorIsRemovedCorrectly - stream := WriteStream on: ''. - stream space: 2 when: false. + | classToRefactor selectorToRemoveParameterFrom parameterToRemove refactoring | - self assert: stream contents isEmpty - ! ! - -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:43:01'! -testSpaceManyTimesWhenConditionIsTruePutSpacesInStream + classToRefactor := self createClassNamed: self classToRefactorName. + selectorToRemoveParameterFrom := 'm1:' asSymbol. + parameterToRemove := 'parameter1'. + classToRefactor compile: selectorToRemoveParameterFrom asString,parameterToRemove. + + refactoring := RemoveParameter + named: parameterToRemove + from: classToRefactor>>selectorToRemoveParameterFrom + implementors: { classToRefactor>>selectorToRemoveParameterFrom } + senders: {}. + refactoring apply. + + self assert: (classToRefactor canUnderstand: 'm1' asSymbol).! ! - | stream | +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:29:53'! +test11ParameterOfSendersOfMoreThanOneKeywordSelectorsIsRemovedCorrectly - stream := WriteStream on: ''. - stream space: 2 when: true. + | classToRefactor selectorToRemoveParameterFrom parameterToRemove keywordToRemove keywordToKeep parameterToKeep refactoring senderSelector senderMethod | + + classToRefactor := self createClassNamed: self classToRefactorName. + keywordToRemove := 'm1:'. + keywordToKeep := 'm2:'. + selectorToRemoveParameterFrom := (keywordToRemove, keywordToKeep) asSymbol. + parameterToRemove := 'parameter1'. + parameterToKeep := 'parameter2'. + senderSelector := 'sender' asSymbol. + classToRefactor compile: keywordToRemove,parameterToRemove, ' ', keywordToKeep, parameterToKeep. + classToRefactor compile: senderSelector asString,' + self + ', keywordToRemove, ' 1 + ', keywordToKeep, ' 2 '. + + refactoring := RemoveParameter + named: parameterToRemove + from: classToRefactor>>selectorToRemoveParameterFrom + implementors: { classToRefactor>>selectorToRemoveParameterFrom } + senders: {classToRefactor>>senderSelector}. + refactoring apply. - self assert: ' ' equals: stream contents - ! ! - -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:19:06'! -testSpaceWhenConditionIsFalseDoesNotPutASpaceInStream - - | stream | - - stream := WriteStream on: ''. - stream spaceWhen: false. + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: (senderMethod sendsOrRefersTo: keywordToKeep asSymbol). + self assert: senderMethod sourceCode equals: (senderSelector asString,' + self + ', keywordToKeep, ' 2 ') - self assert: stream contents isEmpty ! ! -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:19:50'! -testSpaceWhenConditionIsTruePutsASpaceInStream - - | stream | +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:30:01'! +test12ParameterOfSendersOfOneKeywordSelectorsIsRemovedCorrectly - stream := WriteStream on: ''. - stream spaceWhen: true. + | classToRefactor selectorToRemoveParameterFrom parameterToRemove refactoring senderSelector senderMethod | - self assert: ' ' equals: stream contents - ! ! - -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:24:34'! -testTabManyTimesWhenConditionIsFalseDoesNotPutATabInStream - - | stream | - - stream := WriteStream on: ''. - stream tab: 2 when: false. + classToRefactor := self createClassNamed: self classToRefactorName. + selectorToRemoveParameterFrom := 'm1:' asSymbol. + parameterToRemove := 'parameter1'. + senderSelector := 'sender' asSymbol. + classToRefactor compile: selectorToRemoveParameterFrom,parameterToRemove. + classToRefactor compile: senderSelector asString,' + self + ', selectorToRemoveParameterFrom, ' + (1+2).'. - self assert: stream contents isEmpty - ! ! - -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:25:46'! -testTabManyTimesWhenConditionIsTruePutsTabsInStream - - | stream | - - stream := WriteStream on: ''. - stream tab: 2 when: true. + refactoring := RemoveParameter + named: parameterToRemove + from: classToRefactor>>selectorToRemoveParameterFrom + implementors: { classToRefactor>>selectorToRemoveParameterFrom } + senders: {classToRefactor>>senderSelector}. + refactoring apply. - self assert: (String streamContents: [ :s | s tab: 2 ]) equals: stream contents - ! ! - -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:22:50'! -testTabWhenConditionIsFalseDoesNotPutATabInStream - - | stream | - - stream := WriteStream on: ''. - stream tabWhen: false. + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: (senderMethod sendsOrRefersTo: 'm1' asSymbol). + self assert: senderMethod sourceCode equals: (senderSelector asString,' + self + m1.') - self assert: stream contents isEmpty ! ! -!WriteStreamTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:23:28'! -testTabWhenConditionIsTruePutsATabInStream - - | stream | +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 3/4/2019 09:22:15'! +test13ParameterIsRemovedCorrecltyFromSendersWithMoreThanOneSend - stream := WriteStream on: ''. - stream tabWhen: true. + | classToRefactor selectorToRemoveParameterFrom parameterToRemove keywordToRemove keywordToKeep parameterToKeep refactoring senderSelector senderMethod | + + classToRefactor := self createClassNamed: self classToRefactorName. + keywordToRemove := 'm1:'. + keywordToKeep := 'm2:'. + selectorToRemoveParameterFrom := (keywordToRemove, keywordToKeep) asSymbol. + parameterToRemove := 'parameter1'. + parameterToKeep := 'parameter2'. + senderSelector := 'sender' asSymbol. + classToRefactor compile: keywordToRemove,parameterToRemove, ' ', keywordToKeep, parameterToKeep. + classToRefactor compile: senderSelector asString,' + self ', keywordToRemove, ' (1+1) ', keywordToKeep, ' 2. + self ', keywordToRemove, ' 3 ', keywordToKeep, ' 4.'. + + refactoring := RemoveParameter + named: parameterToRemove + from: classToRefactor>>selectorToRemoveParameterFrom + implementors: { classToRefactor>>selectorToRemoveParameterFrom } + senders: {classToRefactor>>senderSelector}. + refactoring apply. + + senderMethod := classToRefactor compiledMethodAt: senderSelector. + self assert: (senderMethod sendsOrRefersTo: keywordToKeep asSymbol). + self assert: senderMethod sourceCode equals: (senderSelector asString,' + self ', keywordToKeep, ' 2. + self ', keywordToKeep, ' 4.') - self assert: Character tab asString equals: stream contents - ! ! - -!SystemConsistencyTest methodsFor: 'testing' stamp: 'jmv 5/7/2012 09:35'! -testMethodsWithUnboundGlobals - " - SystemConsistencyTest new testMethodsWithUnboundGlobals - " - self assert: Smalltalk methodsWithUnboundGlobals isEmpty! ! - -!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:29:18'! -testNewLineWhenConditionIsFalseDoesNotPutANewLineInStream - - self assertTranscriptContentsDoesNotChangeAfter: [ Transcript newLineWhen: false ] - ! ! - -!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:38:57'! -testNewLineWhenConditionIsTruePutsANewLineInStream - - self assertTranscriptContentsAdded: '.' after: [ Transcript newLineWhen: true; nextPut: $. ]! ! - -!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:09:29'! -testNextPutAllWhenConditionIsFalseDoesNotPutCollectionInStream - - self assertTranscriptContentsDoesNotChangeAfter: [ Transcript nextPutAll: 'other' when: false ] ! ! -!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:13:47'! -testNextPutAllWhenConditionIsTruePutsCollectionInStream +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 1/1/2020 23:33:19'! +test14CanNotRemoveParameterIndexLessThanOne - self assertTranscriptContentsAdded: 'other' after: [ Transcript nextPutAll: 'other' when: true ] + | parameterNotInMessage | - ! ! - -!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:11:58'! -testNextPutWhenConditionIsFalseDoesNotPutObjectInStream + parameterNotInMessage := 'otherParameter'. - self assertTranscriptContentsDoesNotChangeAfter: [ Transcript nextPut: $t when: false ] + self + assertCreation: [ RemoveParameter + atIndex: 0 + named: parameterNotInMessage + from: #m1: + implementors: {} + senders: {} ] + failsWith: [ RemoveParameter invalidParameterIndexErrorMessage ] ! ! -!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:15:05'! -testNextPutWhenConditionIsTruePutsObjectInStream +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 1/1/2020 23:36:16'! +test15CanNotRemoveParameterIndexBiggerThanOldSelectorNumberOfKeywords - self assertTranscriptContentsAdded: 't' after: [ Transcript nextPut: $t when: true ] + | parameterNotInMessage | - ! ! - -!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:12:44'! -testPrintWhenConditionIsFalseDoesNotPrintObjectInStream + parameterNotInMessage := 'otherParameter'. - self assertTranscriptContentsDoesNotChangeAfter: [ Transcript print: Object when: false ] + self + assertCreation: [ RemoveParameter + atIndex: 2 + named: parameterNotInMessage + from: #m1: + implementors: {} + senders: {} ] + failsWith: [ RemoveParameter invalidParameterIndexErrorMessage ] ! ! -!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:15:34'! -testPrintWhenConditionIsTruePrintsObjectInStream - - self assertTranscriptContentsAdded: Object printString after: [ Transcript print: Object when: true ] - ! ! - -!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:39:29'! -testSpaceWhenConditionIsFalseDoesNotPutASpaceInStream - - self assertTranscriptContentsDoesNotChangeAfter: [ Transcript spaceWhen: false ] - ! ! - -!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:40:09'! -testSpaceWhenConditionIsTruePutsASpaceInStream - - self assertTranscriptContentsAdded: ' ' after: [ Transcript spaceWhen: true ] - ! ! - -!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:40:49'! -testTabWhenConditionIsFalseDoesNotPutATabInStream - - self assertTranscriptContentsDoesNotChangeAfter: [ Transcript tabWhen: false ]! ! - -!TranscriptTest methodsFor: 'tests' stamp: 'HAW 3/20/2019 07:41:35'! -testTabWhenConditionIsTruePutsATabInStream - - self assertTranscriptContentsAdded: Character tab asString after: [ Transcript tabWhen: true ]! ! - -!TranscriptTest methodsFor: 'assertions' stamp: 'HAW 3/20/2019 07:14:26'! -assertTranscriptContentsAdded: expectedAddedString after: aBlock - - | transcriptContentsBeforeBlockEvaluation | - - transcriptContentsBeforeBlockEvaluation := Transcript contents. - aBlock value. - - self assert: transcriptContentsBeforeBlockEvaluation, expectedAddedString equals: Transcript contents! ! +!RemoveParameterTest methodsFor: 'tests' stamp: 'HAW 1/1/2020 23:38:57'! +test16ParameterIndexMustBeInteger -!TranscriptTest methodsFor: 'assertions' stamp: 'HAW 3/20/2019 07:15:48'! -assertTranscriptContentsDoesNotChangeAfter: aBlock + | parameterNotInMessage | - self assertTranscriptContentsAdded: '' after: aBlock! ! - -!RectangleTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:52:04'! -testIsRectangle - self assert: (Rectangle new is: #Rectangle)! ! - -!ColorFormTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:30:35'! -testIsColorForm - self assert: (ColorForm new is: #ColorForm).! ! - -!GrayFormTest methodsFor: 'as yet unclassified' stamp: 'jpb 8/2/2019 23:36:06'! -testIsGrayForm - self assert: (GrayForm new is: #GrayForm)! ! + parameterNotInMessage := 'otherParameter'. -!BecomeTest methodsFor: 'testing' stamp: 'jmv 1/29/2019 12:03:40'! -testBecome - | e | - BecomeTestExperiment twoVars. - e _ BecomeTestExperiment new. - self should: [ e messStuffUpWBecome ] raise: MethodInCallStackToBecomeInvalid! ! + self + assertCreation: [ RemoveParameter + atIndex: 1.5 + named: parameterNotInMessage + from: #m1:m2: + implementors: {} + senders: {} ] + failsWith: [ RemoveParameter invalidParameterIndexErrorMessage ] +! ! -!BecomeTest methodsFor: 'testing' stamp: 'jmv 1/29/2019 12:03:42'! -testShapeMutation - | e | - BecomeTestExperiment twoVars. - e _ BecomeTestExperiment new. - self should: [ e messStuffUp ] raise: MethodInCallStackToBecomeInvalid! ! +!RemoveParameterTest methodsFor: 'class factory' stamp: 'HAW 9/1/2018 12:24:23'! +classToRefactorName + + ^#ClassToRemoveParameter! ! -!BooleanTest methodsFor: 'and tests' stamp: 'HAW 7/8/2018 20:03:35'! -testAndAndAndAndTrueTable +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 6/1/2017 19:44:41'! +test01NewClassNameHasToBeDifferentToOldOne self - evaluate: [ :first :second :third :fourth :fifth | - self - assert: (first and: [second] and: [third] and: [fourth] and: [fifth]) - equals: ((((first and: [second]) and: [third]) and: [ fourth ]) and: [ fifth ]) ] - forCombinationOf: 5 - - - - ! ! + assertCreation: [ RenameClass from: self class to: self class name ] + failsWith: [ RenameClass newNameEqualsOldNameErrorMessage]! ! -!BooleanTest methodsFor: 'and tests' stamp: 'HAW 7/8/2018 20:03:46'! -testAndAndAndTrueTable +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:36:20'! +test02NewClassNameHasToBeASymbol self - evaluate: [ :first :second :third :fourth | - self - assert: (first and: [second] and: [third] and: [fourth]) - equals: (((first and: [second]) and: [third]) and: [ fourth ]) ] - forCombinationOf: 4 - - - - ! ! + assertCreation: [ RenameClass from: self class to: 'aString' ] + failsWith: [ NewClassPrecondition newNameMustBeSymbolErrorMessage]! ! -!BooleanTest methodsFor: 'and tests' stamp: 'HAW 7/8/2018 20:04:00'! -testAndAndTrueTable +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 5/24/2019 10:09:47'! +test03NewClassNameHasToStartWithUppercaseLetter self - evaluate: [ :first :second :third | - self - assert: (first and: [second] and: [third]) - equals: ((first and: [second]) and: [third]) ] - forCombinationOf: 3 - - - - ! ! + assertCreation: [ RenameClass from: self class to: #_A ] + failsWith: [ NewClassPrecondition newNameMustStartWithRightLetterErrorMessage]! ! -!BooleanTest methodsFor: 'or tests' stamp: 'HAW 7/8/2018 20:04:10'! -testOrOrOrOrTrueTable +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:33:08'! +test04NewClassShouldNotExist - self - evaluate: [ :first :second :third :fourth :fifth | - self - assert: (first or: [second] or: [third] or: [fourth] or: [fifth]) - equals: ((((first or: [second]) or: [third]) or: [ fourth ]) or: [ fifth ]) ] - forCombinationOf: 5 - + | newClassName | + newClassName := #Object. - ! ! + self + assertCreation: [ RenameClass from: self class to: newClassName in: Smalltalk ] + failsWith: [ NewClassPrecondition errorMessageForAlreadyExistClassNamed: newClassName ]! ! -!BooleanTest methodsFor: 'or tests' stamp: 'HAW 7/8/2018 20:04:18'! -testOrOrOrTrueTable +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 12/13/2018 17:59:19'! +test04_01NewClassNameShouldNotBeAGlobalVariable - self - evaluate: [ :first :second :third :fourth | - self - assert: (first or: [second] or: [third] or: [fourth]) - equals: (((first or: [second]) or: [third]) or: [ fourth ]) ] - forCombinationOf: 4 - + | newClassName | + newClassName := #Smalltalk. - ! ! + self + assertCreation: [ RenameClass from: self class to: newClassName in: Smalltalk ] + failsWith: [ NewClassPrecondition errorMessageForAlreadyExistGlobalNamed: newClassName ]! ! -!BooleanTest methodsFor: 'or tests' stamp: 'HAW 7/8/2018 20:04:25'! -testOrOrTrueTable +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:33:35'! +test05NewClassShouldNotBeUndeclare - self - evaluate: [ :first :second :third | - self - assert: (first or: [second] or: [third]) - equals: ((first or: [second]) or: [third]) ] - forCombinationOf: 3 - - + | newClassName undeclared | - ! ! - -!BooleanTest methodsFor: 'combination generation' stamp: 'HAW 7/8/2018 19:51:52'! -evaluate: aBlock collectingValuesInto: values at: aPosition + newClassName := #UndeclareClass. + undeclared := Dictionary new. + undeclared at: newClassName put: nil. - aPosition = 0 - ifTrue: [ aBlock valueWithArguments: values ] - ifFalse: [ - #(true false) do: [ :value | - values at: aPosition put: value. - self evaluate: aBlock collectingValuesInto: values at: aPosition - 1 ]]! ! - -!BooleanTest methodsFor: 'combination generation' stamp: 'HAW 7/8/2018 19:50:53'! -evaluate: aBlock forCombinationOf: aNumberOfValues - - self evaluate: aBlock collectingValuesInto: (Array new: aNumberOfValues) at: aNumberOfValues - ! ! - -!BooleanTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:13:00'! -testIsBoolean - self assert: (true is: #Boolean). - self assert: (false is: #Boolean).! ! - -!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! -testIfNilIfNotNil0Arg - - self assert: (5@4 ifNil: [#foo] ifNotNil: [#bar]) = #bar. - self assert: (nil ifNil: [#foo] ifNotNil: [#bar]) = #foo! ! + self + assertCreation: [ RenameClass from: self class to: newClassName in: Smalltalk undeclared: undeclared ] + failsWith: [ NewClassPrecondition errorMessageForNewClassIsUndeclared: newClassName ]! ! -!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! -testIfNilIfNotNil0ArgAsVar +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 6/4/2017 19:12:10'! +test06OldClassIsRenamedToNewClass - | block1 block2 | - block1 := [#foo]. - block2 := [#bar]. - self assert: (5@4 ifNil: block1 ifNotNil: block2) = #bar. - self assert: (nil ifNil: block1 ifNotNil: block2) = #foo! ! + | oldClassName newClassName classToRefactor rename | -!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! -testIfNilIfNotNil1Arg + oldClassName := 'OldClassTest07' asSymbol. + newClassName := 'NewClassTest07' asSymbol. + classToRefactor := self createClassNamed: oldClassName. + + rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. + rename apply. + + self assert: (Smalltalk classNamed: oldClassName) isNil. + self deny: (Smalltalk classNamed: newClassName) isNil.! ! - self assert: (5@4 ifNil: [#foo] ifNotNil: [:a | a printString]) = '5@4'. - self assert: (nil ifNil: [#foo] ifNotNil: [:a | a printString]) = #foo! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 6/4/2017 18:18:12'! +test07OldClassDirectReferencesAreRenamed -!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! -testIfNilIfNotNil1ArgAsVar + | oldClassName newClassName classToRefactor selector rename referencingMethod | + + oldClassName := 'OldClassTest07' asSymbol. + newClassName := 'NewClassTest07' asSymbol. + classToRefactor := self createClassNamed: oldClassName. + selector := #m1. + classToRefactor compile: selector, ' ', oldClassName asString, ' new'. + + rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. + rename apply. + + referencingMethod := (Smalltalk classNamed: newClassName) compiledMethodAt: selector. + self assert: (referencingMethod hasLiteralThorough: newClassName). + self deny: (referencingMethod hasLiteralThorough: oldClassName)! ! - | block1 block2 | - block1 := [#foo]. - block2 := [:a | a printString]. - self assert: (5@4 ifNil: block1 ifNotNil: block2) = '5@4'. - self assert: (nil ifNil: block1 ifNotNil: block2) = #foo! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 6/4/2017 18:19:04'! +test08OldClassLiteralReferencesAreRenamed -!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! -testIfNotNil0Arg + | oldClassName newClassName classToRefactor selector rename referencingMethod | + + oldClassName := 'OldClassTest08' asSymbol. + newClassName := 'NewClassTest8' asSymbol. + classToRefactor := self createClassNamed: oldClassName. + selector := #m1. + classToRefactor compile: selector, ' #', oldClassName asString, ' size'. + + rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. + rename apply. + + referencingMethod := (Smalltalk classNamed: newClassName) compiledMethodAt: selector. + self assert: (referencingMethod hasLiteralThorough: newClassName). + self deny: (referencingMethod hasLiteralThorough: oldClassName)! ! - self assert: (5@4 ifNotNil: [#foo]) = #foo. - self assert: (nil ifNotNil: [#foo]) = nil! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 6/4/2017 18:36:22'! +test09OtherClassDirectReferencesAreNotRenamed -!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! -testIfNotNil0ArgAsVar + | oldClassName newClassName classToRefactor selector rename referencingMethod | + + oldClassName := 'OldClassTest09' asSymbol. + newClassName := 'NewClassTest09' asSymbol. + classToRefactor := self createClassNamed: oldClassName. + selector := #m1. + classToRefactor compile: selector, ' ', oldClassName asString, ' new. Object new'. + + rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. + rename apply. + + referencingMethod := (Smalltalk classNamed: newClassName) compiledMethodAt: selector. + self assert: (referencingMethod hasLiteralThorough: newClassName). + self deny: (referencingMethod hasLiteralThorough: oldClassName). + self assert: (referencingMethod hasLiteralThorough: #Object). +! ! - | block | - block := [#foo]. - self assert: (5@4 ifNotNil: block) = #foo. - self assert: (nil ifNotNil: block) = nil! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 6/4/2017 19:07:19'! +test10OtherLiteralReferencesAreNotRenamed -!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! -testIfNotNil1Arg + | oldClassName newClassName classToRefactor selector rename referencingMethod | + + oldClassName := 'OldClassTest10' asSymbol. + newClassName := 'NewClassTest10' asSymbol. + classToRefactor := self createClassNamed: oldClassName. + selector := #m1. + classToRefactor compile: selector, ' #', oldClassName asString, ' size. #Object size'. + + rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. + rename apply. + + referencingMethod := (Smalltalk classNamed: newClassName) compiledMethodAt: selector. + self assert: (referencingMethod hasLiteralThorough: newClassName). + self deny: (referencingMethod hasLiteralThorough: oldClassName). + self assert: (referencingMethod hasLiteralThorough: #Object). +! ! - self assert: (5@4 ifNotNil: [:a | a printString]) = '5@4'. - self assert: (nil ifNotNil: [:a | a printString]) = nil! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 16:30:56'! +test11OldClassDirectAndLiteralReferencesAreRenameAtOnce -!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! -testIfNotNil1ArgAsVar + | oldClassName newClassName classToRefactor selector rename renamedReferences | + + oldClassName := 'OldClassTest11' asSymbol. + newClassName := 'NewClassTest11' asSymbol. + classToRefactor := self createClassNamed: oldClassName. + selector := #m1. + classToRefactor compile: selector, ' ', oldClassName asString, ' new. #', oldClassName asString, ' size'. + + rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. + renamedReferences := rename apply. + + self assert: 1 equals: renamedReferences size. + self assert: selector equals: renamedReferences anyOne selector. + self assert: newClassName equals: renamedReferences anyOne classSymbol. + self assert: ((classToRefactor sourceCodeAt: selector) includesSubString: '#', newClassName)! ! - | block | - block := [:a | a printString]. - self assert: (5@4 ifNotNil: block) = '5@4'. - self assert: (nil ifNotNil: block) = nil! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 4/4/2018 19:56:09'! +test12CanNotRenameAMetaclass -!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! -testIfNotNilIfNil0Arg + self + assertCreation: [ RenameClass from: self class class to: #Object ] + failsWith: [ RenameClass classToRenameCanNotBeMetaclassErrorMessage]! ! - self assert: (5@4 ifNotNil: [#foo] ifNil: [#bar]) = #foo. - self assert: (nil ifNotNil: [#foo] ifNil: [#bar]) = #bar! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/13/2018 18:35:38'! +test13NewClassNameHasToBeASymbol -!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! -testIfNotNilIfNil0ArgAsVar + self + assertCreation: [ RenameClass from: self class to: '' asSymbol ] + failsWith: [ NewClassPrecondition newClassNameCanNotBeEmptyErrorMessage]! ! - | block1 block2 | - block1 := [#foo]. - block2 := [#bar]. - self assert: (5@4 ifNotNil: block2 ifNil: block1) = #bar. - self assert: (nil ifNotNil: block2 ifNil: block1) = #foo! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 09:20:07'! +test14NewClassNameCanNotHaveSpaces -!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:46'! -testIfNotNilIfNil1Arg + | oldClassName classToRefactor | - self assert: (5@4 ifNotNil: [:a | a printString] ifNil: [#foo]) = '5@4'. - self assert: (nil ifNotNil: [:a | a printString] ifNil: [#foo]) = #foo! ! + oldClassName := 'OldClassTest14' asSymbol. + classToRefactor := self createClassNamed: oldClassName. -!IfNotNilTests methodsFor: 'tests' stamp: 'jmv 11/16/2010 08:47'! -testIfNotNilIfNil1ArgAsVar + self + assertCreation: [ RenameClass from: classToRefactor to: 'With spaces' asSymbol ] + failsWith: [ NewClassPrecondition newClassNameCanNotHaveSeparatorsErrorMessage]! ! - | block1 block2 | - block1 := [#foo]. - block2 := [:a | a printString]. - self assert: (5@4 ifNotNil: block2 ifNil: block1) = '5@4'. - self assert: (nil ifNotNil: block2 ifNil: block1) = #foo! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 14:44:13'! +test15ItDoesNotRenameReferencesToClassVariableWithSameName -!ObjectTest methodsFor: 'error tests' stamp: 'HAW 10/23/2019 09:23:56'! -testErrorSignalsTheRightException + | classWithClassVariable oldClassName classToRefactor newClassName rename renamedReferences | - | reason | - - reason := 'something went wrong'. - self - should: [ self error: reason ] - raise: Error - withMessageText: reason ! ! + oldClassName := 'OldClassTest15' asSymbol. + newClassName := 'NewClassTest15' asSymbol. + "First I create a class var with the same name as the class to rename and a reference to it - Hernan" + classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol. + classWithClassVariable addClassVarName: oldClassName. + classWithClassVariable compile: 'm1 ^', oldClassName. -!ObjectTest methodsFor: 'error tests' stamp: 'HAW 10/23/2019 09:24:03'! -testShouldNotHappenBecauseSignalsTheRightError + classToRefactor := self createClassNamed: oldClassName. - | reason | + rename := RenameClass from: classToRefactor to: newClassName. + renamedReferences := rename apply. - reason := 'something went wrong'. - self - should: [ self shouldNotHappenBecause: reason ] - raise: Error - withMessageText: self shouldNotHappenBecauseErrorMessage, reason ! ! - -!ObjectTest methodsFor: 'error tests' stamp: 'HAW 10/23/2019 09:24:11'! -testShouldNotHappenSignalsTheRightError - - self - should: [ self shouldNotHappen ] - raise: Error - withMessageText: self shouldNotHappenErrorMessage ! ! + self assert: renamedReferences isEmpty. + + + ! ! -!SpecialSelectorsTest methodsFor: 'testing' stamp: 'jmv 6/5/2017 12:17:20'! -testCollectionAtSymbol - self assert: (#(1 2 3) @ #(10 20 30)) class == Array! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 14:45:20'! +test16ItDoesNotRenameReferencesToClassVariableWithSameNameDefinedInAnySuperclass -!SpecialSelectorsTest methodsFor: 'testing' stamp: 'jmv 6/5/2017 12:16:49'! -testNumberAtSymbol - self assert: (1@2) class == Point! ! + | classWithClassVariable oldClassName classToRefactor newClassName rename renamedReferences superClassOfClassWithClassVarReference | -!WeakMessageSendTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:44:58'! -testIsMessageSend - self assert: (WeakMessageSend new is: #MessageSend).! ! + oldClassName := 'OldClassTest16' asSymbol. + newClassName := 'NewClassTest16' asSymbol. -!MethodReferenceTest methodsFor: 'test actual class' stamp: 'HAW 10/23/2019 21:08:24'! -testActualClassIfAbsentEvaluatesBlockIfClassDoesNotExist + superClassOfClassWithClassVarReference := self createClassNamed: 'ClassReferencingClassVarSuperclass' asSymbol. + superClassOfClassWithClassVarReference addClassVarName: oldClassName. + + classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol subclassOf: superClassOfClassWithClassVarReference. + classWithClassVariable compile: 'm1 ^', oldClassName. - self - assert: 1 - equals: ((MethodReference - classSymbol: #X_Y_Z - classIsMeta: false - methodSymbol: #xx) actualClassIfAbsent: [ 1])! ! + classToRefactor := self createClassNamed: oldClassName. -!MethodReferenceTest methodsFor: 'test actual class' stamp: 'HAW 10/23/2019 21:09:29'! -testActualClassIfAbsentReturnsClassIfClassExists + rename := RenameClass from: classToRefactor to: newClassName. + renamedReferences := rename apply. + + self assert: renamedReferences isEmpty. + + + ! ! - self - assert: self class - equals: ((MethodReference - class: self class - selector: thisContext selector) actualClassIfAbsent: [ self fail])! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 14:46:34'! +test17ItDoesNotRenameReferencesToClassVariableWithSameNameAsNewClassDefinedInAnySuperclass -!MethodReferenceTest methodsFor: 'test actual class' stamp: 'HAW 10/23/2019 21:05:22'! -testActualClassReturnNilWhenClassDoesNotExist + | classWithClassVariable oldClassName classToRefactor newClassName rename renamedReferences superClassOfClassWithClassVarReference | - self assert: (MethodReference classSymbol: #X_Y_Z classIsMeta: false methodSymbol: #xx) actualClass isNil! ! + oldClassName := 'OldClassTest17' asSymbol. + newClassName := 'NewClassTest17' asSymbol. -!MethodReferenceTest methodsFor: 'test actual class' stamp: 'HAW 10/23/2019 21:09:58'! -testActualClassReturnsClassIfExists + superClassOfClassWithClassVarReference := self createClassNamed: 'ClassReferencingClassVarSuperclass' asSymbol. + superClassOfClassWithClassVarReference addClassVarName: newClassName. + + classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol subclassOf: superClassOfClassWithClassVarReference. + classWithClassVariable compile: 'm1 ^', newClassName. - self - assert: self class - equals: (MethodReference - class: self class - selector: thisContext selector) actualClass ! ! + classToRefactor := self createClassNamed: oldClassName. -!MethodReferenceTest methodsFor: 'test source code' stamp: 'HAW 10/23/2019 21:42:10'! -testSourceCodeIfAbsentEvaluatesBlockIfClassDoesNotExist + rename := RenameClass from: classToRefactor to: newClassName. + renamedReferences := rename apply. + + self assert: renamedReferences isEmpty. + + + ! ! - self - assert: 1 - equals: ((MethodReference classSymbol: #X_Y_Z classIsMeta: false methodSymbol:#xx) sourceCodeIfAbsent: [ 1 ])! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 16:21:35'! +test18WorksCorrectlyWhenSourceCodeEndsWithClassToRename -!MethodReferenceTest methodsFor: 'test source code' stamp: 'HAW 10/23/2019 21:42:34'! -testSourceCodeIfAbsentEvaluatesBlockIfMethodDoesNotExist + | oldClassName newClassName classToRefactor selector rename referencingMethod | + + oldClassName := 'OldClassTest18' asSymbol. + newClassName := 'NewClassTest18' asSymbol. + classToRefactor := self createClassNamed: oldClassName. + selector := #m1. + classToRefactor compile: selector, ' ^', oldClassName asString. + + rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. + rename apply. + + referencingMethod := (Smalltalk classNamed: newClassName) compiledMethodAt: selector. + self assert: (referencingMethod hasLiteralThorough: newClassName). + self deny: (referencingMethod hasLiteralThorough: oldClassName)! ! - self - assert: 1 - equals: ((MethodReference class: self class selector:#xx) sourceCodeIfAbsent: [ 1 ])! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 16:24:09'! +test19RenamesClassWhenMethodReferencesClassAndDoesNothing -!MethodReferenceTest methodsFor: 'test source code' stamp: 'HAW 10/23/2019 21:43:23'! -testSourceCodeIfAbsentReturnsSourceCodeIfExists + | oldClassName newClassName classToRefactor selector rename referencingMethod | + + "Currently the rename class is not handling this case becuase message #allCallsOn: does not return a method + that references a class but does nothing becuase it is optimize to return self... it is a really wierd case so I decided + no to solve it by now - Hernan" + self shouldFail: [ + oldClassName := 'OldClassTest18' asSymbol. + newClassName := 'NewClassTest18' asSymbol. + classToRefactor := self createClassNamed: oldClassName. + selector := #m1. + classToRefactor compile: selector, ' ', oldClassName asString. + + rename := RenameClass from: classToRefactor to: newClassName in: Smalltalk undeclared: Undeclared. + rename apply. + + referencingMethod := (Smalltalk classNamed: newClassName) compiledMethodAt: selector. + self assert: (referencingMethod hasLiteralThorough: newClassName). + self deny: (referencingMethod hasLiteralThorough: oldClassName)] ! ! - self - assert: (self class>>thisContext selector) sourceCode - equals: ((MethodReference class: self class selector: thisContext selector) sourceCodeIfAbsent: [ self fail ])! ! +!RenameClassTest methodsFor: 'tests' stamp: 'HAW 12/30/2021 16:31:36'! +test20ItDoesNotRenameReferencesToClassVariableWithSameNameAndReferencedInClassMethod -!MethodReferenceTest methodsFor: 'test source code' stamp: 'HAW 10/23/2019 21:11:15'! -testSourceCodeReturnsSourceCodeIfMethodExist + | classWithClassVariable oldClassName classToRefactor newClassName rename renamedReferences | - self - assert: (self class compiledMethodAt: thisContext selector) sourceCode - equals: (MethodReference - class: self class - selector: thisContext selector) sourceCode ! ! + oldClassName := 'OldClassTest15' asSymbol. + newClassName := 'NewClassTest15' asSymbol. + "First I create a class var with the same name as the class to rename and a reference to it - Hernan" + classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol. + classWithClassVariable addClassVarName: oldClassName. + classWithClassVariable class compile: 'm1 ^', oldClassName. -!MethodReferenceTest methodsFor: 'test source code' stamp: 'HAW 10/23/2019 21:39:16'! -testSourceCodeSignalExceptionIfClassDoesNotExist + classToRefactor := self createClassNamed: oldClassName. - self - should: [ (MethodReference classSymbol: #X_Y_Z classIsMeta: false methodSymbol:#xx) sourceCode ] - raise: Error - withMessageText: MethodReference classDoesNotExistErrorMessage ! ! + rename := RenameClass from: classToRefactor to: newClassName. + renamedReferences := rename apply. + + self assert: renamedReferences isEmpty. + self assert: (classWithClassVariable definesClassVariableNamedInHierarchy: oldClassName) + + + ! ! -!MethodReferenceTest methodsFor: 'test source code' stamp: 'HAW 10/23/2019 21:13:28'! -testSourceCodeSignalExceptionIfMethodDoesNotExist +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 17:53:53'! +define: anOldName with: aGlobalValue toBeRenamedAs: aNewName while: aBlock - self - should: [ (MethodReference class: self class selector: #xx) sourceCode ] - raise: Error - withMessageText: Dictionary keyNotFoundErrorDescription ! ! + | oldNameAsSymbol newNameAsSymbol | + + oldNameAsSymbol := anOldName asSymbol. + newNameAsSymbol := aNewName asSymbol. + + self assert: (Smalltalk at: oldNameAsSymbol ifAbsent: [ nil ]) isNil. + self assert: (Smalltalk at: newNameAsSymbol ifAbsent: [ nil ]) isNil. + + [ + Smalltalk at: oldNameAsSymbol put: aGlobalValue. + aBlock value: oldNameAsSymbol value: newNameAsSymbol value: aGlobalValue ] ensure: [ + Smalltalk removeKey: oldNameAsSymbol ifAbsent: []. + Smalltalk removeKey: newNameAsSymbol ifAbsent: []]. + ! ! -!MethodReferenceTest methodsFor: 'test compiled method' stamp: 'HAW 1/1/2020 19:46:58'! -testCompiledMethodIfAbsentEvaluatesAbsentBlockWhenActualClassIsNil +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:20:03'! +test00GlobalCanNotBeClass self - assert: 1 - equals: ((MethodReference - classSymbol: #X_Y_Z - classIsMeta: false - methodSymbol: #xx) compiledMethodIfAbsent: [ 1])! ! + assertCreation: [ RenameGlobal from: #Object to: 'NewObject__' asSymbol ] + failsWith: [ RenameGlobal globalCanNotBeClassErrorMessage]! ! -!MethodReferenceTest methodsFor: 'test compiled method' stamp: 'HAW 1/1/2020 19:47:05'! -testCompiledMethodIfAbsentEvaluatesAbsentBlockWhenSelectorIsNotImplemented +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:20:37'! +test01NewNameHasToBeDifferentToOldOne self - assert: 1 - equals: ((MethodReference - classSymbol: self class name - classIsMeta: false - methodSymbol: #xx) compiledMethodIfAbsent: [ 1])! ! + define: 'OldNameToRename__' + with: Object new + toBeRenamedAs: 'OldNameToRename__' + while: [ :oldName :newName :globalValue | + self + assertCreation: [ RenameGlobal from: oldName to: newName ] + failsWith: [ RenameGlobal newNameEqualsOldNameErrorMessage]]! ! -!MethodReferenceTest methodsFor: 'test compiled method' stamp: 'HAW 1/1/2020 19:47:13'! -testCompiledMethodIfAbsentReturnsImplementedMethodWhenItExists +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:26:40'! +test02NewNameHasToBeASymbol - self - assert: thisContext method - equals: ((MethodReference - classSymbol: self class name - classIsMeta: false - methodSymbol: thisContext selector) compiledMethodIfAbsent: [ self fail ])! ! + self withDefaultsDo: [ :oldName :newName :globalValue | + self + assertCreation: [ RenameGlobal from: oldName to: newName asString ] + failsWith: [ NewGlobalPrecondition newNameMustBeSymbolErrorMessage]]! ! -!MethodReferenceTest methodsFor: 'test string version' stamp: 'HAW 4/9/2020 15:51:56'! -test01DefaultStringVersionIsClassAndSelector +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:27:23'! +test03NewNameShouldNotBeAClass - | stringVersion | + | className | - stringVersion := (MethodReference method: thisContext method) stringVersion. + className := #Object. - self assert: self class name, ' ', thisContext selector equals: stringVersion! ! + self withDefaultsDo: [ :oldName :newName :globalValue | + self + assertCreation: [ RenameGlobal from: oldName to: className in: Smalltalk ] + failsWith: [ NewGlobalPrecondition errorMessageForAlreadyExistClassNamed: className ]]! ! -!MethodReferenceTest methodsFor: 'test string version' stamp: 'HAW 8/19/2021 15:05:13'! -test02CanPrefixStringVersion +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:27:33'! +test04NewNameShouldNotBeAGlobalVariable - | methodReference prefix | + | globalName | - prefix := 'a prefix'. - methodReference := MethodReference method: thisContext method. - methodReference prefixStringVersionWith: prefix. + globalName := #Smalltalk. - self assert: '[',prefix,'] - ',self class name, ' ', thisContext selector equals: methodReference stringVersion! ! + self withDefaultsDo: [ :oldName :newName :globalValue | + self + assertCreation: [ RenameGlobal from: oldName to: globalName in: Smalltalk ] + failsWith: [ NewGlobalPrecondition errorMessageForAlreadyExistGlobalNamed: globalName ]]! ! -!MethodReferenceTest methodsFor: 'test testing' stamp: 'HAW 1/2/2020 06:49:00'! -testReferencesParameterAtReturnsFalseWhenInvalid +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:27:45'! +test06OldNameIsRenamedToNewName - self deny: ((MethodReference - classSymbol: #X_Y_Z - classIsMeta: false - methodSymbol: #xx) referencesParameterAt: 1)! ! + | rename | -!MethodReferenceTest methodsFor: 'test testing' stamp: 'HAW 1/2/2020 06:49:03'! -testReferencesParameterAtReturnsTrueWhenTheParameterIsReferenced + self withDefaultsDo: [ :oldName :newName :globalValue | + rename := RenameGlobal from: oldName to: newName in: Smalltalk. + rename apply. - self assert: ((MethodReference - classSymbol: #MethodReference - classIsMeta: false - methodSymbol: #referencesParameterAt:) referencesParameterAt: 1)! ! + self assert: (Smalltalk at: oldName ifAbsent: [nil]) isNil. + self assert: (Smalltalk at: newName) equals: globalValue ].! ! -!CharacterSetTest methodsFor: 'testing includes' stamp: 'HAW 6/12/2019 17:32:08'! -testIncludesReturnsFalseForCharacterNotIncluded +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:27:58'! +test07OldDirectReferencesAreRenamed - self deny: ((CharacterSet with: $a) includes: $b)! ! + | rename classToRefactor referencingMethod selector | -!CharacterSetTest methodsFor: 'testing includes' stamp: 'HAW 6/12/2019 17:31:45'! -testIncludesReturnsFalseForObjectsThatAreNotCharacters + self withDefaultsDo: [ :oldName :newName :globalValue | + classToRefactor := self createClassNamed: #AClassToRefactor. + selector := 'm1' asSymbol. + classToRefactor compile: selector, ' ^', oldName asString. - self deny: ((CharacterSet with: $a) includes: 1)! ! + rename := RenameGlobal from: oldName to: newName in: Smalltalk. + rename apply. -!CharacterSetTest methodsFor: 'testing includes' stamp: 'HAW 6/12/2019 17:32:24'! -testIncludesReturnsTrueForCharacterIncluded + referencingMethod := classToRefactor compiledMethodAt: selector. + self assert: (referencingMethod hasLiteralThorough: newName). + self deny: (referencingMethod hasLiteralThorough: oldName). + self assert: (classToRefactor new perform: selector) equals: globalValue ]. + + + +! ! - self assert: ((CharacterSet with: $a) includes: $a)! ! +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:28:09'! +test08OldNameLiteralReferencesAreRenamed -!CharacterTest methodsFor: 'testing' stamp: 'jmv 10/6/2010 22:08'! -testCaseConversion - " - self new testCaseConversion - " - self assert: ('año Comé tomá Camión' collect: [ :c | c asLowercase ]) = 'año comé tomá camión'. - self assert:('año Comé tomá Camión' collect: [ :c | c asUppercase ]) = 'AÑO COMÉ TOMÁ CAMIÓN'! ! + | rename classToRefactor referencingMethod selector | -!CharacterTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:10:55'! -testIsCharacter - self assert: ($a is: #Character). - self assert: ($X is: #Character). - self assert: (Character cr is: #Character).! ! + self withDefaultsDo: [ :oldName :newName :globalValue | + classToRefactor := self createClassNamed: #AClassToRefactor. + selector := 'm1' asSymbol. + classToRefactor compile: selector, ' ^#', oldName asString. -!CharacterTest methodsFor: 'testing' stamp: 'jmv 10/6/2010 22:05'! -testSorting - " - self new testSorting - " - self assert: $a < $á. - self deny: $a < $Á. - self assert: $A < $á. - self assert: $A < $Á. - self assert: $á < $b. - self deny: $á < $B. - self assert: $Á < $b. - self assert: $Á < $B.! ! + rename := RenameGlobal from: oldName to: newName in: Smalltalk. + rename apply. -!CharacterTest methodsFor: 'testing' stamp: 'jmv 10/6/2010 22:10'! -testTestingMethods - " - self new testTestingMethods - " - self assert: - ('año Comé tomá Camión' allSatisfy: [ :c | - c = $ or: [ c isLetter ]]). - self assert: - ('año comé tomá camión' allSatisfy: [ :c | - c = $ or: [ c isLowercase ]]). - self assert: - ('AÑO COMÉ TOMÁ CAMIÓN' allSatisfy: [ :c | - c = $ or: [ c isUppercase ]]). - self assert: - ('AaÀàÁáÂâÃãÄäÅåEeÈèÉéÊêËëIiÌìÍíÎîÏïOoÒòÓóÔôÕõÖöUuÙùÚúÛûÜü' allSatisfy: [ :c | - c isVowel ]).! ! + referencingMethod := classToRefactor compiledMethodAt: selector. + self assert: (referencingMethod hasLiteralThorough: newName). + self deny: (referencingMethod hasLiteralThorough: oldName). + self assert: (classToRefactor new perform: selector) equals: newName ]. + + ! ! -!CharacterTest methodsFor: 'UTF-8 conversion' stamp: 'jmv 5/26/2022 12:31:12'! -testFromUtf8 - " - CharacterTest new testFromUtf8 - " - Character utf8BytesAndCodePointAt: 1 in: (ByteArray readHexFrom: '24') into: nil into: [ :codePoint | self assert: codePoint hex = '16r24' ]. - Character utf8BytesAndCodePointAt: 1 in: (ByteArray readHexFrom: 'C2A2') into: nil into: [ :codePoint | self assert: codePoint hex = '16rA2' ]. - Character utf8BytesAndCodePointAt: 1 in: (ByteArray readHexFrom: 'E282AC') into: nil into: [ :codePoint | self assert: codePoint hex = '16r20AC' ]. - Character utf8BytesAndCodePointAt: 1 in: (ByteArray readHexFrom: 'F0A4ADA2') into: nil into: [ :codePoint | self assert: codePoint hex = '16r24B62' ].! ! +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:28:21'! +test09NewNameHasToBeASymbol -!CharacterTest methodsFor: 'UTF-8 conversion' stamp: 'jmv 5/5/2022 09:34:34'! -testSomeLatinCharsFromUtf8 - " - CharacterTest new testSomeLatinCharsFromUtf8 - " - | bytes string | - bytes _ ByteArray readHexFrom: 'C3A1C3A5C3A6C3B1C386C2A5C3BC'. - string _ String streamContents: [ :strm | | s byteIndex n | - s _ bytes size. - byteIndex _ 1. - [ byteIndex <= s ] whileTrue: [ - n _ Character utf8BytesAndCodePointAt: byteIndex in: bytes - into: nil - into: [ :codePoint | - strm nextPut: (Character codePoint: codePoint) ]. - byteIndex _ byteIndex + n - ]]. - self assert: string = 'áåæñÆ¥ü'! ! + self withDefaultsDo: [ :oldName :newName :globalValue | + self + assertCreation: [ RenameGlobal from: oldName to: '' asSymbol ] + failsWith: [ NewGlobalPrecondition newNameCanNotBeEmptyErrorMessage]]! ! -!CharacterTest methodsFor: 'UTF-8 conversion' stamp: 'jmv 9/4/2016 13:11:55'! -testSomeLatinCharsToUtf8 - " - CharacterTest new testSomeLatinCharsToUtf8 - " - | characters bytes | - characters _ 'áåæñÆ¥ü' readStream. - bytes _ ByteArray streamContents: [ :strm | - [ characters atEnd ] whileFalse: [ - Character - evaluate: [ :byte | strm nextPut: byte ] - withUtf8BytesOfUnicodeCodePoint: characters next codePoint ]]. - self assert: bytes hex = 'C3A1C3A5C3A6C3B1C386C2A5C3BC'! ! +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:28:30'! +test10NewNameCanNotHaveSpaces -!CharacterTest methodsFor: 'UTF-8 conversion' stamp: 'jmv 2/20/2013 20:09'! -testToUtf8 - " - CharacterTest new testToUtf8 - " - self assert: (Character utf8BytesOfUnicodeCodePoint: 16r0024) hex = '24'. - self assert: (Character utf8BytesOfUnicodeCodePoint: 16r00A2) hex = 'C2A2'. - self assert: (Character utf8BytesOfUnicodeCodePoint: 16r20AC) hex = 'E282AC'. - self assert: (Character utf8BytesOfUnicodeCodePoint: 16r024B62) hex = 'F0A4ADA2'! ! + self withDefaultsDo: [ :oldName :newName :globalValue | + self + assertCreation: [ RenameGlobal from: oldName to: 'With spaces' asSymbol ] + failsWith: [ NewGlobalPrecondition newNameCanNotHaveSeparatorsErrorMessage]]! ! + +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 18:33:27'! +test11ItDoesNotRenameReferencesToClassVariableWithSameName + + | rename classWithClassVariable renamedReferences oldNameAsString | + + oldNameAsString := 'OldNameToRename__'. + classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol. + classWithClassVariable addClassVarName: oldNameAsString asSymbol. + classWithClassVariable compile: 'm1 ^', oldNameAsString. + + self + define: oldNameAsString + with: Object new + toBeRenamedAs: 'NewNameRenamed__' + while: [ :oldName :newName :globalValue | + + rename := RenameGlobal from: oldName to: newName. + renamedReferences := rename apply. + + self assert: renamedReferences isEmpty ] + + ! ! -!StringTest methodsFor: 'UTF-8 conversion' stamp: 'jmv 5/26/2022 12:00:49'! -testAsUtf8 - " - StringTest new testAsUtf8 - " - self assert: 'A¢¤' asUtf8Bytes hex = '41C2A2E282AC'! ! +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 18:33:34'! +test12ItDoesNotRenameReferencesToClassVariableWithSameNameDefinedInAnySuperclass -!StringTest methodsFor: 'UTF-8 conversion' stamp: 'jmv 5/26/2022 11:59:35'! -testAsUtf8WithNCRs - " - StringTest new testAsUtf8WithNCRs - " - | stringWithDecimalNCRs stringWithHexNCRs utf8 | - utf8 _ ByteArray readHexFrom: ('CE BC 20 CE A8 20 CF 89 20 54 68 65 20 64 65 63 6F 6D 70 6F 73 69 74 69 6F 6E 20 6D 61 70 70 69 6E 67 20 69 73 20 3C EC B8 A0 2C 20 E1 86 B8 3E 2C 20 61 6E 64 20 6E 6F 74 20 3C E1 84 8E 2C 20 E1 85 B3 2C 20 31 31 42 38 3E 2E 0A 3C 70 3E 54 68 65 20 74 69 74 6C 65 20 73 61 79 73 20 E2 80 AB D7 A4 D7 A2 D7 99 D7 9C D7 95 D7 AA 20 D7 94 D7 91 D7 99 D7 A0 D7 90 D7 95 D7 9D 2C 20 57 33 43 E2 80 AC 20 69 6E 20 48 65 62 72 65 77 3C 2F 70 3E 0A 61 62 63 E0 A4 95 E0 A4 96 E0 A5 80 E5 9C 8B E9 9A 9B F0 90 8E 84 F0 90 8E 94 F0 90 8E 98' reject: [ :char | char isSeparator ]). + | classWithClassVariable rename renamedReferences superClassOfClassWithClassVarReference oldNameAsString | - stringWithDecimalNCRs _ String fromUtf8Bytes: utf8 hex: false trimLastNull: false. - stringWithHexNCRs _ String fromUtf8Bytes: utf8 hex: true trimLastNull: false. + oldNameAsString := 'OldNameRenamed__'. - self assert: stringWithDecimalNCRs = 'μ Ψ ˜ The decomposition mapping is <츠, ᆸ>, and not <ᄎ, ᅳ, 11B8>. -

The title says ‫פעילות הבינאום, W3C‬ in Hebrew

-abcकखी國際𐎄𐎔𐎘'. + superClassOfClassWithClassVarReference := self createClassNamed: 'ClassReferencingClassVarSuperclass' asSymbol. + superClassOfClassWithClassVarReference addClassVarName: oldNameAsString asSymbol. + + classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol subclassOf: superClassOfClassWithClassVarReference. + classWithClassVariable compile: 'm1 ^', oldNameAsString. - self assert: (stringWithDecimalNCRs asUtf8Bytes: true) = utf8. + self + define: oldNameAsString + with: Object new + toBeRenamedAs: 'NewNameRenamed__' + while: [ :oldName :newName :globalValue | - self assert: stringWithHexNCRs = 'μ Ψ ˜ The decomposition mapping is <츠, ᆸ>, and not <ᄎ, ᅳ, 11B8>. -

The title says ‫פעילות הבינאום, W3C‬ in Hebrew

-abcकखी國際𐎄𐎔𐎘'. + rename := RenameGlobal from: oldName to: newName. + renamedReferences := rename apply. + + self assert: renamedReferences isEmpty ] + + + ! ! - self assert: (stringWithHexNCRs asUtf8Bytes: true) = utf8! ! +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:29:03'! +test13OldNameMustBeDefined + + self + assertCreation: [ RenameGlobal from: 'AGlobal__' asSymbol to: 'AGlobal' asSymbol in: Smalltalk ] + failsWith: [ RenameGlobal errorMessageForGlobalNotDefined: 'AGlobal__' asSymbol ]! ! -!StringTest methodsFor: 'tests - converting' stamp: 'jmv 9/19/2016 09:55:39'! -testBase64 +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:34:06'! +test14ItDoesNotRenameReferencesToClassVariableFromClassSideWithSameName + + | rename classWithClassVariable renamedReferences oldNameAsString | + + oldNameAsString := 'OldNameToRename__'. + classWithClassVariable := self createClassNamed: 'ClassReferencingClassVar' asSymbol. + classWithClassVariable addClassVarName: oldNameAsString asSymbol. + classWithClassVariable class compile: 'm1 ^', oldNameAsString. self - assert: 'SGVsbG8gV29ybGQ=' base64Decoded = 'Hello World' asByteArray; - assert: 'Hello World' asByteArray base64Encoded = 'SGVsbG8gV29ybGQ='; - assert: (String new: 100 withAll: $x) asByteArray base64Encoded = -'eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4 -eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eA==' ! ! + define: oldNameAsString + with: Object new + toBeRenamedAs: 'NewNameRenamed__' + while: [ :oldName :newName :globalValue | -!StringTest methodsFor: 'testing' stamp: 'HAW 8/3/2018 10:42:26'! -testAfterBlanksEndsWith + rename := RenameGlobal from: oldName to: newName. + renamedReferences := rename apply. + + self assert: renamedReferences isEmpty ] + + ! ! - self assert: (' abc' afterBlanksEndsWith: 'abc'). - self assert: ('abc' afterBlanksEndsWith: 'abc'). +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:49:43'! +test15OldNameCanNotBeEmpty - self deny: (' ab' afterBlanksEndsWith: 'abc'). - self deny: (' ab' afterBlanksEndsWith: 'a'). - self deny: ('' afterBlanksEndsWith: 'abc'). - self deny: (' a a bc' afterBlanksEndsWith: 'a bc').! ! + self + assertCreation: [ RenameGlobal from: '' asSymbol to: 'AGlobal' asSymbol in: Smalltalk ] + failsWith: [ RenameGlobal oldNameCanNotBeEmptyErrorMessage ]! ! -!StringTest methodsFor: 'testing' stamp: 'jmv 10/6/2010 22:08'! -testCaseConversion - " - self new testCaseConversion - " - self assert: ('año Comé tomá Camión' asLowercase) = 'año comé tomá camión'. - self assert: ('año Comé tomá Camión' asUppercase) = 'AÑO COMÉ TOMÁ CAMIÓN'! ! +!RenameGlobalTest methodsFor: 'tests' stamp: 'HAW 3/26/2019 19:26:58'! +withDefaultsDo: aBlock -!StringTest methodsFor: 'testing' stamp: 'jmv 9/1/2009 14:12'! -testEncompassParagraph1 + self + define: 'OldNameToRename__' + with: Object new + toBeRenamedAs: 'NewNameToRename__' + while: aBlock! ! - self assert: ('a' encompassParagraph: (1 to: 0)) = (1 to: 1). - self assert: ('a' encompassParagraph: (1 to: 1)) = (1 to: 1). - self assert: ('a' encompassParagraph: (2 to: 1)) = (1 to: 1).! ! +!RenameInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 6/11/2017 18:13:05'! +classToRefactorName -!StringTest methodsFor: 'testing' stamp: 'jmv 9/1/2009 14:13'! -testEncompassParagraph2 + ^#ClassToRenameInstVar! ! - self assert: ('ab' encompassParagraph: (1 to: 0)) = (1 to: 2). - self assert: ('ab' encompassParagraph: (1 to: 1)) = (1 to: 2). - self assert: ('ab' encompassParagraph: (1 to: 2)) = (1 to: 2). - self assert: ('ab' encompassParagraph: (2 to: 1)) = (1 to: 2). - self assert: ('ab' encompassParagraph: (2 to: 2)) = (1 to: 2). - self assert: ('ab' encompassParagraph: (3 to: 2)) = (1 to: 2).! ! +!RenameInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 6/1/2017 14:28:02'! +createClassToRefactor + + classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: oldVariable ! ! -!StringTest methodsFor: 'testing' stamp: 'jmv 9/1/2009 14:14'! -testEncompassParagraph3 +!RenameInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 5/28/2017 21:36:47'! +createClassToRefactorAndAssertRenameCreationFailsWith: aMessageTextCreator -self assert: ('a -' encompassParagraph: (1 to: 0)) = (1 to: 2). -self assert: ('a -' encompassParagraph: (1 to: 1)) = (1 to: 2). -self assert: ('a -' encompassParagraph: (1 to: 2)) = (1 to: 2). -self assert: ('a -' encompassParagraph: (2 to: 1)) = (1 to: 2). -self assert: ('a -' encompassParagraph: (2 to: 2)) = (1 to: 2). -self assert: ('a -' encompassParagraph: (3 to: 2)) = (3 to: 2). + self createClassToRefactor. + self assertRenameCreationFailsWith: aMessageTextCreator ! ! -self assert: ('a -zcxv' encompassParagraph: (1 to: 0)) = (1 to: 2). -self assert: ('a -zcxv' encompassParagraph: (1 to: 1)) = (1 to: 2). -self assert: ('a -zxcv' encompassParagraph: (1 to: 2)) = (1 to: 2). -self assert: ('a -zxcv' encompassParagraph: (2 to: 1)) = (1 to: 2). -self assert: ('a -zxcv' encompassParagraph: (2 to: 2)) = (1 to: 2). -self assert: ('a -zxcv' encompassParagraph: (3 to: 2)) = (3 to: 6).! ! +!RenameInstanceVariableTest methodsFor: 'assertions' stamp: 'HAW 6/1/2017 19:00:37'! +assertRenameCreationFailsWith: aMessageTextCreator -!StringTest methodsFor: 'testing' stamp: 'jmv 9/1/2009 14:17'! -testEncompassParagraph4 + self + assertCreation: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] + failsWith: aMessageTextCreator ! ! -self assert: (' -b' encompassParagraph: (1 to: 0)) = (1 to: 1). -self assert: (' -b' encompassParagraph: (1 to: 1)) = (1 to: 1). -self assert: (' -b' encompassParagraph: (1 to: 2)) = (1 to: 2). -self assert: (' -b' encompassParagraph: (2 to: 1)) = (2 to: 2). -self assert: (' -b' encompassParagraph: (2 to: 2)) = (2 to: 2). -self assert: (' -b' encompassParagraph: (3 to: 2)) = (2 to: 2).! ! +!RenameInstanceVariableTest methodsFor: 'setup' stamp: 'HAW 5/28/2017 21:33:44'! +setUp -!StringTest methodsFor: 'testing' stamp: 'jmv 9/1/2009 14:22'! -testEncompassParagraph5 + super setUp. + + oldVariable := 'old'. + newVariable := 'new'.! ! -self assert: ('a -b' encompassParagraph: (1 to: 0)) = (1 to: 2). -self assert: ('a -b' encompassParagraph: (1 to: 1)) = (1 to: 2). -self assert: ('a -b' encompassParagraph: (1 to: 2)) = (1 to: 2). -self assert: ('a -b' encompassParagraph: (1 to: 3)) = (1 to: 3). -self assert: ('a -b' encompassParagraph: (2 to: 1)) = (1 to: 2). -self assert: ('a -b' encompassParagraph: (2 to: 2)) = (1 to: 2). -self assert: ('a -b' encompassParagraph: (2 to: 3)) = (1 to: 3). -self assert: ('a -b' encompassParagraph: (3 to: 2)) = (3 to: 3). -self assert: ('a -b' encompassParagraph: (3 to: 3)) = (3 to: 3). -self assert: ('a -b' encompassParagraph: (4 to: 3)) = (3 to: 3).! ! +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/27/2017 11:21:06'! +test01CanNotRenameAnInstanceVariableNotDefinedInClass -!StringTest methodsFor: 'testing' stamp: 'HAW 12/29/2020 13:29:16'! -testFindSelector + classToRefactor := self createClassNamed: #ClassWithoutInstVar instanceVariableNames: ''. + + self assertRenameCreationFailsWith: [ RenameInstanceVariable errorMessageForInstanceVariable: oldVariable notDefinedIn: classToRefactor ] + ! ! - self assert: #printOn: equals: '"self printOn:' findSelector. - self assert: #printOn: equals: 'self printOn:"' findSelector. - self assert: #printOn: equals: '"self printOn:"' findSelector. - self assert: #printOn: equals: 'self printOn:' findSelector. +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:45:01'! +test02NewVariableNameCanNotBeEmpty + + newVariable := ' '. + self createClassToRefactorAndAssertRenameCreationFailsWith: [NewInstanceVariablePrecondition newVariableCanNotBeEmptyErrorMessage ] ! ! -!StringTest methodsFor: 'testing' stamp: 'jmv 6/6/2022 16:47:18'! -testFirstNonSeparator +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:45:05'! +test03NewVariableNameCanNotContainBlanks + + newVariable := 'a b'. + self createClassToRefactorAndAssertRenameCreationFailsWith: [NewInstanceVariablePrecondition errorMessageForInvalidInstanceVariable: newVariable] +! ! - self assert: 1 equals: 'abc' firstNonSeparator. - self assert: 2 equals: ' abc' firstNonSeparator. - self assert: 0 equals: '' firstNonSeparator ! ! +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:45:10'! +test04NewVariableNameCanNotContainInvalidCharacters + + newVariable := '2a'. + self createClassToRefactorAndAssertRenameCreationFailsWith: [NewInstanceVariablePrecondition errorMessageForInvalidInstanceVariable: newVariable] +! ! + +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/28/2017 21:33:30'! +test05ValidNewVariableNameGetBlanksTrimmed + + newVariable := ' a '. + self createClassToRefactor. + + self + shouldnt: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] + raise: self refactoringError ! ! + +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:45:17'! +test06NewVariableNameCanNotBeDefinedInClass + + newVariable := oldVariable. + self createClassToRefactorAndAssertRenameCreationFailsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariable: newVariable alreadyDefinedInAll: (Array with: classToRefactor )] + ! ! + +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:45:22'! +test07NewVariableNameCanNotBeDefinedInSuperclasses -!StringTest methodsFor: 'testing' stamp: 'jpb 8/2/2019 23:11:49'! -testIsString - self assert: ('Hello World' is: #String). - self assert: ('' is: #String).! ! + | classToRefactorSuperclass | -!StringTest methodsFor: 'testing' stamp: 'jmv 6/6/2022 16:46:49'! -testLastNonSeparator + classToRefactorSuperclass := self createClassNamed: #SuperclassWithInstVar instanceVariableNames: newVariable. + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: classToRefactorSuperclass instanceVariableNames: oldVariable. + + self assertRenameCreationFailsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariable: newVariable alreadyDefinedInAll: (Array with: classToRefactorSuperclass)] + + +! ! - self assert: 3 equals: 'abc' lastNonSeparator. - self assert: 3 equals: 'abc ' lastNonSeparator. - self assert: 4 equals: ' abc ' lastNonSeparator. - self assert: 0 equals: '' lastNonSeparator ! ! +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/3/2019 08:45:39'! +test08NewVariableNameCanNotBeDefinedInAnySubclass -!StringTest methodsFor: 'testing' stamp: 'jmv 12/17/2012 10:51'! -testLineSeparators - " - Test that #newLineCharacter is considered a line separator and not a line terminator. - This means that the last line never ends with a #newLineCharacter (although it might be empty!!) - StringTest new testLineSeparators - " - | justAnLf linesBounds | - linesBounds _ OrderedCollection new. - justAnLf _ ' -'. - justAnLf lineIndicesDo: [ :start :endWithoutDelimiters :end | - linesBounds add: { start . endWithoutDelimiters. end }. - ]. + | classToRefactorSubclass | - self assert: linesBounds size = 2 description: 'There should be two lines.'. + self createClassToRefactor. + classToRefactorSubclass := self createClassNamed: #SubclassWithInstVar subclassOf: classToRefactor instanceVariableNames: newVariable. + + self assertRenameCreationFailsWith: [NewInstanceVariablePrecondition errorMessageForNewInstanceVariable: newVariable alreadyDefinedInAll: (Array with: classToRefactorSubclass)] + + ! ! - self assert: linesBounds first first = 1 description: 'First line starts at position 1'. - self assert: linesBounds first second = (linesBounds first first-1) description: 'First line is empty'. - self assert: linesBounds first third = (linesBounds first second+1) description: 'First line is terminated by ab Lf'. +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/27/2017 11:36:03'! +test09RenameCreatesNewInstanceVariableAndDeletesOldOne - self assert: linesBounds second first = ( linesBounds first third+1) description: 'Second line starts after end of first line'. - self assert: linesBounds second second = (linesBounds second first-1) description: 'Second line is empty'. - self assert: linesBounds second third = (linesBounds second second+0) description: 'Second line is not terminated by ab Lf'.! ! + | rename | -!StringTest methodsFor: 'testing' stamp: 'jmv 10/6/2010 22:03'! -testSorting -" -self new testSorting -" + self createClassToRefactor. + + rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor . + rename apply. + + self assert: (classToRefactor definesInstanceVariableNamed: newVariable). + self deny: (classToRefactor definesInstanceVariableNamed: oldVariable) +! ! - self assert: 'a' < 'á'. - self assert: ('a' < 'Á') not. - self assert: 'A' < 'á'. - self assert: 'A' < 'Á'. - self assert: 'á' < 'b'. - self assert: ('á' < 'B') not. - self assert: 'Á' < 'b'. - self assert: 'Á' < 'B'. +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/28/2017 21:05:15'! +test10ReadReferencesToOldVariableAreRenamed - self assert: ('a' caseSensitiveLessOrEqual: 'á'). - self deny: ('a' caseSensitiveLessOrEqual: 'Á'). - self assert: ('A' caseSensitiveLessOrEqual: 'á'). - self assert: ('A' caseSensitiveLessOrEqual: 'Á'). - self assert: ('á' caseSensitiveLessOrEqual: 'b'). - self deny: ('á' caseSensitiveLessOrEqual: 'B'). - self assert: ('Á' caseSensitiveLessOrEqual: 'b'). - self assert: ('Á' caseSensitiveLessOrEqual: 'B'). + | selector method rename | - self assert: ('a' caseInsensitiveLessOrEqual: 'á'). - self assert: ('a' caseInsensitiveLessOrEqual: 'Á'). - self assert: ('A' caseInsensitiveLessOrEqual: 'á'). - self assert: ('A' caseInsensitiveLessOrEqual: 'Á'). - self assert: ('á' caseInsensitiveLessOrEqual: 'b'). - self assert: ('á' caseInsensitiveLessOrEqual: 'B'). - self assert: ('Á' caseInsensitiveLessOrEqual: 'b'). - self assert: ('Á' caseInsensitiveLessOrEqual: 'B').! ! + selector := #m1. + self createClassToRefactor. + classToRefactor compile: selector , ' ^' , oldVariable. + + rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor. + rename apply. -!StringTest methodsFor: 'testing' stamp: 'HAW 8/3/2018 11:00:28'! -testWithBlanksTrimmed + method := classToRefactor >> selector. + self assert: (method readsInstanceVariable: newVariable). + self deny: (method readsInstanceVariable: oldVariable) +! ! - self assert: 'abc' equals: ' abc' withBlanksTrimmed. - self assert: 'abc' equals: 'abc ' withBlanksTrimmed. - self assert: 'abc' equals: ' abc ' withBlanksTrimmed. - self assert: 'a b c' equals: ' a b c ' withBlanksTrimmed. - self assert: '' equals: '' withBlanksTrimmed. - ! ! +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/28/2017 21:07:27'! +test11WriteReferencesToOldVariableAreRenamed -!StringTest methodsFor: 'testing' stamp: 'HAW 8/2/2018 20:35:28'! -testWithoutLeadingBlanks + | selector method rename | - self assert: 'abc' equals: ' abc' withoutLeadingBlanks. - self assert: 'abc' equals: 'abc' withoutLeadingBlanks. - self assert: '' withoutLeadingBlanks isEmpty + selector := #m1. + self createClassToRefactor. + classToRefactor compile: selector , ' ' , oldVariable, ' := 10'. + + rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor. + rename apply. + + method := classToRefactor >> selector. + self assert: (method writesInstanceVariable: newVariable). + self deny: (method writesInstanceVariable: oldVariable) ! ! -!StringTest methodsFor: 'testing' stamp: 'HAW 6/8/2019 18:18:47'! -testWithoutSeparators +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/28/2017 21:10:59'! +test12ReferencesInSubclassesAreRenamed - self assert: 'abc' equals: 'abc' withoutSeparators. - self assert: 'abc' equals: ' a b c ' withoutSeparators! ! + | selector method classToRefactorSubclass rename | -!StringTest methodsFor: 'testing' stamp: 'HAW 8/2/2018 20:35:32'! -testWithoutTrailingBlanks + selector := #m1. + self createClassToRefactor. + classToRefactorSubclass _ self createClassNamed: #SubclassWithInstVar subclassOf: classToRefactor instanceVariableNames: ''. + classToRefactorSubclass compile: selector , ' ' , oldVariable, ' := 10. ^' , oldVariable. - self assert: 'abc' equals: 'abc ' withoutTrailingBlanks. - self assert: 'abc' equals: 'abc' withoutTrailingBlanks. - self assert: '' withoutTrailingBlanks isEmpty -! ! + rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor. + rename apply. -!StringTest methodsFor: 'tests - grammar' stamp: 'LC 7/5/2020 16:47:10'! -testArticle - self - assert: 'euphemism' withArticle equals: 'a euphemism'; - assert: 'European' withArticle equals: 'a European'; - assert: 'Euclidean space' withArticle equals: 'a Euclidean space'; - assert: 'university' withArticle equals: 'a university'; - assert: 'anagram' withArticle equals: 'an anagram'; - assert: 'apple' withArticle equals: 'an apple'; - assert: 'Ukranian' withArticle equals: 'a Ukranian'; - assert: 'Argentine' withArticle equals: 'an Argentine'; - assert: 'user' withArticle equals: 'a user'! ! + method := classToRefactorSubclass >> selector. + self assert: (method readsInstanceVariable: newVariable). + self assert: (method writesInstanceVariable: newVariable). + self deny: (method readsInstanceVariable: oldVariable). + self deny: (method writesInstanceVariable: oldVariable) ! ! -!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 19:59:47'! -testIsNotValidBinarySelectorIfItContainsACharacterNotAllowed +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/28/2017 21:46:36'! +test13ReferencesToOtherVariablesAreNotRenamed - self deny: #'(' isValidSelector! ! + | variableToKeep selector method rename | -!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 20:01:07'! -testIsNotValidKeywordSelectorIfItContainsSeparators + variableToKeep := 'keep'. + selector := #m1. + classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: oldVariable, ' ', variableToKeep. + classToRefactor compile: selector , ' ' , variableToKeep, ' := ' , oldVariable, '. ^' , variableToKeep. - self deny: #'between: and:' isValidSelector! ! + rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor. + rename apply. -!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 19:52:35'! -testIsNotValidUnarySelectorIfItContainsCharactersUsedInBinarySelectors + method := classToRefactor >> selector. + self assert: (method readsInstanceVariable: variableToKeep). + self assert: (method writesInstanceVariable: variableToKeep) +! ! - self deny: #'a+b' isValidSelector! ! +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 5/28/2017 21:15:59'! +test14NewVariableOfExistingInstancesReferToOldVariableValue -!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 19:51:29'! -testIsNotValidUnarySelectorIfItStartsWithALetterAndContainsSeparators + | rename instance | - self deny: #'with spaces' isValidSelector! ! + self createClassToRefactor. + instance := classToRefactor new. + instance instVarNamed: oldVariable put: 1. + + rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor . + rename apply. + + self assert: 1 equals: (instance instVarNamed: newVariable). + ! ! -!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 19:53:43'! -testIsValidBinarySelectorIfItContainsAnAllowedCharacterOrSequenceOfCharacters +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:45:27'! +test15FailsWhenNewVariableEqualsTemporaryVariableOfAMethodInClass - self - assert: #+ isValidSelector; - assert: #+-+ isValidSelector! ! + | selector | -!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 20:00:35'! -testIsValidKeywordSelectorIfItContainsKeywordsWithColons + self createClassToRefactor. + selector := #m1. + classToRefactor compile: selector, ' | ', newVariable, ' | ', newVariable, ' := 10.'. + + self + assertCreation: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] + failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. + ! ! - self - assert: #includes: isValidSelector; - assert: #between:and: isValidSelector! ! +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:45:44'! +test16FailsWhenNewVariableEqualsArgumentOfAMethodInClass -!SymbolTest methodsFor: 'tests - selector validation' stamp: 'RNG 3/29/2020 19:50:31'! -testIsValidUnarySelectorIfItStartsWithALetterAndDoesNotContainSeparators + | selector | - self assert: #t234 isValidSelector! ! + self createClassToRefactor. + selector := #m1:. + classToRefactor compile: selector, newVariable. + + self + assertCreation: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] + failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. + ! ! -!UnicodeStringsTest methodsFor: 'testing' stamp: 'jmv 6/2/2022 15:14:24'! -test01 +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:45:59'! +test17FailsWhenNewVariableEqualsArgumentOfABlockInAMethodInClass - | asciiString asciiUtf32String asciiUtf8String latinString latinUtf32String latinUtf8String | - asciiString _ 'Hello world'. - latinString _ '¡Tomá agüita, Ñandú!!'. - asciiUtf8String _ asciiString asUtf8String. - latinUtf8String _ latinString asUtf8String. - asciiUtf32String _ asciiString asUtf32String. - latinUtf32String _ latinString asUtf32String. + | selector | + + self createClassToRefactor. + selector := #m1. + classToRefactor compile: selector, ' [ :', newVariable, ' | ] value: 1'. + + self + assertCreation: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] + failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. + ! ! - self assert: asciiString hash = asciiUtf8String hash. - self assert: asciiString hash = asciiUtf32String hash. - self assert: asciiString = asciiUtf8String. - self assert: asciiString = asciiUtf32String. - self assert: asciiUtf8String = asciiString. - self assert: asciiUtf8String = asciiUtf32String. - self assert: asciiUtf32String = asciiString. - self assert: asciiUtf32String = asciiUtf8String. +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:46:25'! +test18FailsWhenNewVariableEqualsTemporaryOfABlockInAMethodInClass - self assert: latinString hash = latinUtf8String hash. - self assert: latinString hash = latinUtf32String hash. - self assert: latinString = latinUtf8String. - self assert: latinString = latinUtf32String. - self assert: latinUtf8String = latinString. - self assert: latinUtf8String = latinUtf32String. - self assert: latinUtf32String = latinString. - self assert: latinUtf32String = latinUtf8String.! ! + | selector | -!UnicodeSymbolsTest methodsFor: 'testing' stamp: 'jmv 6/3/2022 11:37:33'! -test01AsciiSymbolFirst - "Try a few things with pure ASCII. - Do #asSymbol before doing #asUtf8Symbol. The symbol created will be instance of Symbol." + self createClassToRefactor. + selector := #m1. + classToRefactor compile: selector, ' [ | ', newVariable, ' | ] value'. - | str symbol utf8 utf8Symbol | - str _ 'Stuff', Random next mantissaPart printString. - symbol _ str asSymbol. - utf8 _ str asUtf8String. - utf8Symbol _ utf8 asSymbol. + self + assertCreation: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] + failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (classToRefactor>>selector)) ]. + ! ! - self assert: str = str. - self assert: str == str. - self assert: symbol = symbol. - self assert: symbol == symbol. - self assert: utf8 = utf8. - self assert: utf8 == utf8. - self assert: utf8Symbol = utf8Symbol. - self assert: utf8Symbol == utf8Symbol. +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 3/7/2019 22:46:39'! +test19FailsWhenNewVariableIsHiddenInAnyMethodOfAnySubclass - self assert: str = symbol. - self assert: symbol = str. - self assert: utf8 = utf8Symbol. - self assert: utf8Symbol = utf8. + | selector subclass | - self assert: str = utf8. - self assert: utf8 = str. - self assert: symbol = utf8Symbol. - self assert: utf8Symbol = symbol. + self createClassToRefactor. + subclass := self createClassNamed: #SubclassOfClassToRefactor subclassOf: classToRefactor. + selector := #m1. + subclass compile: selector, ' | ', newVariable, ' | '. + + self + assertCreation: [ RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor ] + failsWith: [ NewInstanceVariablePrecondition errorMessageForNewVariable: newVariable willBeHiddenAtAll: (Array with: (subclass>>selector)) ]. + ! ! - self assert: str = utf8Symbol. - self assert: utf8Symbol = str. - self assert: symbol = utf8. - self assert: utf8 = symbol. +!RenameInstanceVariableTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:55:59'! +test20ClassChangeIsAddedWhenRenamingAnInstanceVariable - self assert: utf8Symbol == symbol. - self assert: symbol == utf8Symbol.! ! + | rename classChanges refactorClassChangeSet refactorClassChangeSets | -!UnicodeSymbolsTest methodsFor: 'testing' stamp: 'jmv 6/3/2022 11:37:42'! -test02LatinSymbolFirst - "Try a few things with pure ASCII. - Do #asSymbol before doing #asUtf8Symbol. The symbol created will be instance of Symbol." + "I have to do this because on this case I want to keep track of the changes - Hernan" + [ classToRefactor := self + createClassNamed: self classToRefactorName + subclassOf: Object + instanceVariableNames: oldVariable + classVariableNames: '' + poolDictionaries: '' + category: self classCategoryOfTestData. + + refactorClassChangeSets := ChangeSet allChangeSetsWithClass: classToRefactor. + self assert: 1 = refactorClassChangeSets size description: 'Can not run the test because the class is in more than one changeset (or in none)'. + refactorClassChangeSet := refactorClassChangeSets anyOne. + refactorClassChangeSet removeClassChanges: classToRefactor. - | str symbol utf8 utf8Symbol | - str _ '¡Tomá agüita, Ñandú!!', Random next mantissaPart printString. - symbol _ str asSymbol. - utf8 _ str asUtf8String. - utf8Symbol _ utf8 asSymbol. + rename := RenameInstanceVariable from: oldVariable to: newVariable in: classToRefactor . + rename apply. + + classChanges := refactorClassChangeSet classChangeAt: classToRefactor name. + self assert: (classChanges includes: #change). ] + ensure: [ | package | + classToRefactor class compile: 'wantsChangeSetLogging ^false'. + ChangeSet allChangeSets remove: refactorClassChangeSet. + package := CodePackage packageOfClass: classToRefactor ifNone: nil. + self assert: package notNil. + package hasUnsavedChanges: false ]. + ! ! - self assert: str = str. - self assert: str == str. - self assert: symbol = symbol. - self assert: symbol == symbol. - self assert: utf8 = utf8. - self assert: utf8 == utf8. - self assert: utf8Symbol = utf8Symbol. - self assert: utf8Symbol == utf8Symbol. +!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 5/28/2017 23:26:45'! +allClassCategoriesOfTestData - self assert: str = symbol. - self assert: symbol = str. - self assert: utf8 = utf8Symbol. - self assert: utf8Symbol = utf8. + ^Array + with: self classCategoryOfTestData + with: self anotherClassCategoryOfTestData + with: self classCategoryOfTestDataToAvoid ! ! - self assert: str = utf8. - self assert: utf8 = str. - self assert: symbol = utf8Symbol. - self assert: utf8Symbol = symbol. +!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 3/4/2019 14:59:42'! +anotherClassCategoryOfTestData - self assert: str = utf8Symbol. - self assert: utf8Symbol = str. - self assert: symbol = utf8. - self assert: utf8 = symbol. + ^self classCategoryOfTestData,'-Another'! ! - self assert: utf8Symbol == symbol. - self assert: symbol == utf8Symbol.! ! +!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 3/4/2019 14:59:50'! +classCategoryOfTestDataToAvoid -!UnicodeSymbolsTest methodsFor: 'testing' stamp: 'jmv 6/3/2022 11:38:22'! -test03AsciiUtf8SymbolFirst - "Try a few things with pure ASCII. - Do #asSymbol before doing #asUtf8Symbol. The symbol created will be instance of Symbol." - - | str symbol utf8 utf8Symbol | - str _ 'Stuff', Random next mantissaPart printString. - utf8 _ str asUtf8String. - utf8Symbol _ utf8 asSymbol. - symbol _ str asSymbol. + ^self classCategoryOfTestData,'-toAvoid'! ! - self assert: str = str. - self assert: str == str. - self assert: symbol = symbol. - self assert: symbol == symbol. - self assert: utf8 = utf8. - self assert: utf8 == utf8. - self assert: utf8Symbol = utf8Symbol. - self assert: utf8Symbol == utf8Symbol. +!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 8/15/2018 12:03:16'! +classToRefactorName - self assert: str = symbol. - self assert: symbol = str. - self assert: utf8 = utf8Symbol. - self assert: utf8Symbol = utf8. + ^#ClassToRenameSelector! ! - self assert: str = utf8. - self assert: utf8 = str. - self assert: symbol = utf8Symbol. - self assert: utf8Symbol = symbol. +!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 12/18/2019 20:32:41'! +createClassToRefactor - self assert: str = utf8Symbol. - self assert: utf8Symbol = str. - self assert: symbol = utf8. - self assert: utf8 = symbol. + classToRefactor := self createClassWithImplementorAndSenderNamed: self classToRefactorName subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. +! ! - self assert: utf8Symbol == symbol. - self assert: symbol == utf8Symbol.! ! +!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 5/25/2017 23:14:02'! +createClassWithImplementorAndSenderInMetaTooNamed: aName subclassOf: aSuperclass categorizedAd: aCategory -!UnicodeSymbolsTest methodsFor: 'testing' stamp: 'jmv 6/3/2022 11:38:36'! -test04LatinUtf8SymbolFirst - "Try a few things with pure ASCII. - Do #asSymbol before doing #asUtf8Symbol. The symbol created will be instance of Symbol." + | newClass | - | str symbol utf8 utf8Symbol | - str _ '¡Tomá agüita, Ñandú!!', Random next mantissaPart printString. - utf8 _ str asUtf8String. - utf8Symbol _ utf8 asSymbol. - symbol _ str asSymbol. + newClass := self createClassWithImplementorAndSenderNamed: aName subclassOf: aSuperclass categorizedAd: aCategory. + newClass class compile: oldSelector asString. + newClass class compile: senderOfOldSelector asString , ' self ' , oldSelector asString. - self assert: str = str. - self assert: str == str. - self assert: symbol = symbol. - self assert: symbol == symbol. - self assert: utf8 = utf8. - self assert: utf8 == utf8. - self assert: utf8Symbol = utf8Symbol. - self assert: utf8Symbol == utf8Symbol. + ^newClass +! ! - self assert: str = symbol. - self assert: symbol = str. - self assert: utf8 = utf8Symbol. - self assert: utf8Symbol = utf8. +!RenameSelectorTest methodsFor: 'class factory' stamp: 'HAW 5/28/2017 21:49:40'! +createClassWithImplementorAndSenderNamed: aName subclassOf: aSuperclass categorizedAd: aCategory - self assert: str = utf8. - self assert: utf8 = str. - self assert: symbol = utf8Symbol. - self assert: utf8Symbol = symbol. + | newClass | + + newClass := self createClassNamed: aName subclassOf: aSuperclass category: aCategory. + newClass compile: oldSelector asString. + newClass compile: senderOfOldSelector asString , ' self ' , oldSelector asString. - self assert: str = utf8Symbol. - self assert: utf8Symbol = str. - self assert: symbol = utf8. - self assert: utf8 = symbol. + ^newClass +! ! - self assert: utf8Symbol == symbol. - self assert: symbol == utf8Symbol.! ! +!RenameSelectorTest methodsFor: 'assertions' stamp: 'HAW 11/8/2018 15:30:15'! +assertWasNotRenamedInClass: aClass -!UnicodeTest methodsFor: 'set up' stamp: 'jmv 5/31/2016 11:24'! -setUp - " - self new setUp - " + | senderMethod | + + senderMethod := aClass compiledMethodAt: senderOfOldSelector. + self deny: (senderMethod sendsOrRefersTo: newSelector). + self assert: (senderMethod sendsOrRefersTo: oldSelector)! ! - bytesOfExample1 := #[16r61 16r62 16r63 16r20 16rC3 16rA0 16rC3 16rA8 16rE2 - 16r82 16rAC 16r20 16rCE 16rB1 16rCE 16rB2 16rCE 16rB3]. +!RenameSelectorTest methodsFor: 'assertions' stamp: 'HAW 3/7/2020 18:44:08'! +assertWasRenamedInClass: aClass - "see UnicodeNotes.md" + | senderMethod | - "write the bytes of an UFT8 encoded string in binary mode to a file" - self class fileName asFileEntry forceWriteStreamDo: [ :stream | - stream binary. - stream nextPutAll: bytesOfExample1 ]! ! + self assert: (aClass includesSelector: newSelector). + self deny: (aClass includesSelector: oldSelector). + senderMethod := aClass compiledMethodAt: senderOfOldSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). +! ! -!UnicodeTest methodsFor: 'testing' stamp: 'jmv 10/3/2015 20:03'! -test1ReadBinary +!RenameSelectorTest methodsFor: 'assertions' stamp: 'HAW 3/7/2020 18:44:59'! +assertWasRenamedInClassAndMeta: aClass - "see UnicodeNotes.md" - " - self new setUp test1ReadBinary - " - | content | - content := self class fileName asFileEntry binaryContents. - self assert: content = bytesOfExample1! ! + self + assertWasRenamedInClass: aClass; + assertWasRenamedInClass: aClass class! ! -!UnicodeTest methodsFor: 'testing' stamp: 'jmv 10/3/2015 20:04'! -test2ReadWithOutBinary +!RenameSelectorTest methodsFor: 'setup' stamp: 'HAW 5/28/2017 21:46:55'! +setUp + + super setUp. - "see UnicodeNotes.md" - " - self new setUp test2ReadWithOutBinary - " - | content | - content := self class fileName asFileEntry textContents. - self deny: content = bytesOfExample1! ! + oldSelector := 'oldXyz__' asSymbol. + newSelector := 'newXyz__' asSymbol. + senderOfOldSelector := 'm1__' asSymbol.! ! -!UnicodeTest methodsFor: 'testing' stamp: 'jmv 5/26/2022 12:01:13'! -test3ReadUtf8 +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 12:03:44'! +test01MessageWithNoSendersCreatesNewMethodAndRemovesOldOne - "see UnicodeNotes.md" - " - self new setUp test3ReadUtf8 - " - | content byteArray | - byteArray _ self class fileName asFileEntry binaryContents. - content := String fromUtf8Bytes: byteArray. - self assert: content = 'abc àè¤ ˆ‰Š'! ! + | rename | + + classToRefactor := self createClassNamed: self classToRefactorName.. + classToRefactor compile: oldSelector asString. + + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: #(). + rename apply. + self deny: (classToRefactor includesSelector: oldSelector). + self assert: (classToRefactor includesSelector: newSelector) +! ! -!UnicodeTest methodsFor: 'testing' stamp: 'jmv 5/26/2022 12:00:15'! -test4BackConversion +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:30:40'! +test02SendersOfMessageAreRenamed - "see UnicodeNotes.md" + | rename senderMethod | - " - self new setUp test4BackConversion - " - | contentInternalString contentByteArray | + self createClassToRefactor. + + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>senderOfOldSelector). + rename apply. + + senderMethod := classToRefactor compiledMethodAt: senderOfOldSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector)! ! - contentInternalString := String fromUtf8Bytes: self class fileName asFileEntry binaryContents. - contentByteArray := self class fileName asFileEntry binaryContents. +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:30:51'! +test03OtherMessagesSendsAreNotRenamed - self assert: contentByteArray = (contentInternalString asUtf8Bytes: true)! ! + | rename senderMethod selectorToKeep | -!UnicodeTest methodsFor: 'testing' stamp: 'jmv 5/26/2022 12:00:29'! -test5ReadWriteUtf8 - - "see UnicodeNotes.md" + selectorToKeep := #toKeep. + self createClassToRefactor. + classToRefactor compile: senderOfOldSelector asString , ' self ' , oldSelector asString , '. self ' , selectorToKeep asString. - " - self new setUp test5ReadWriteUtf8 - " - | content byteArray byteArray2 | - - "read UTF8 Unicode file into internal string with NCRs" - "for NCR see http://en.wikipedia.org/wiki/Numeric_character_reference" + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>senderOfOldSelector). + rename apply. - byteArray := self class fileName asFileEntry binaryContents. - content := String fromUtf8Bytes: byteArray. - "NCRs were added to 'content' as needed" + senderMethod := classToRefactor compiledMethodAt: senderOfOldSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). + self assert: (senderMethod sendsOrRefersTo: selectorToKeep) +! ! - "write internal string back to UTF8 file with NCRs converted back to UTF8 chars" - self class fileName2 asFileEntry forceWriteStreamDo: [ :stream | - stream binary. - stream nextPutAll: (content asUtf8Bytes: true). "true means: convert NCRs back to UTF8" - ]. +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! +test04OldSelectorCanNotBeEmpty - "compare the two versions: what is in file 'fileName' with what is in file 'fileName2'" - byteArray := self class fileName asFileEntry binaryContents. - byteArray2 := self class fileName2 asFileEntry binaryContents. - self assert: byteArray = byteArray2! ! + self + assertCreation: [ RenameSelector from: '' asSymbol to: newSelector implementors: #() senders: #() ] + failsWith: [ RenameSelector oldSelectorCanNotBeEmptyErrorMessage ] +! ! -!UnicodeTest class methodsFor: 'as yet unclassified' stamp: 'hjh 2/12/2013 19:25'! -fileName - ^'UTF8abc-test.txt'! ! +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! +test05NewSelectorCanNotBeEmpty -!UnicodeTest class methodsFor: 'as yet unclassified' stamp: 'hjh 2/12/2013 21:35'! -fileName2 - ^'UTF8abc-test2.txt'! ! + self + assertCreation: [ RenameSelector from: oldSelector to: '' asSymbol implementors: #() senders: #() ] + failsWith: [ RenameSelector newSelectorCanNotBeEmptyErrorMessage ] +! ! -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 12:16:37'! -test00MessagesForTestingAreImplemented +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/30/2019 18:01:00'! +test06CanRenameWithoutImplementors - self assert: (self respondsTo: #_zz). - self assert: (self respondsTo: #!!). - ! ! + self shouldntFail: [ RenameSelector from: oldSelector to: newSelector implementors: #() senders: #() ] + ! ! -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:56:57'! -test01TypeOfMessageSentToLiteralNumberAreObtainedCorrectly +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/18/2018 15:48:43'! +test07AllImplementorsMustImplementOldSelector - self assertTypesAreValidWhenMessageSendTo: '1'! ! + | invalidImplementors | + + invalidImplementors := Array with: Object>>#printString. + + self + assertCreation: [ RenameSelector from: oldSelector to: newSelector implementors: invalidImplementors senders: #() ] + failsWith: [ RenameSelector errorMessageForInvalidImplementors: invalidImplementors ] +! ! -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:58:55'! -test02TypeOfMessageSentToLiteralStringAreObtainedCorrectly +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! +test08AllSendersShouldSendOldSelector - self assertTypesAreValidWhenMessageSendTo: '''a'''! ! + | implementors invalidSenders | + + oldSelector := #printString. + implementors := Array with: Object>>oldSelector. + invalidSenders := Array with: Object>>#size. + + self + assertCreation: [ RenameSelector from: oldSelector to: newSelector implementors: implementors senders: invalidSenders ] + failsWith: [ RenameSelector errorMessageForInvalidSenders: invalidSenders of: oldSelector ] +! ! -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:58:39'! -test03TypeOfMessageSentToLiteralSymbolAreObtainedCorrectly +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! +test09NewSelectorMustBeOfSameTypeAsOldSelector - self assertTypesAreValidWhenMessageSendTo: '#a'! ! + oldSelector := #size. + newSelector := #+. + + self + assertCreation: [ RenameSelector from: oldSelector to: newSelector implementors: #() senders: #() ] + failsWith: [ RenameSelector errorMessageForNewSelector: newSelector isNotOfSameTypeAs: oldSelector ] +! ! -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:59:12'! -test04TypeOfMessageSentToLiteralArrayAreObtainedCorrectly +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! +test10NewSelectorMustHaveSameNumberOfArgumentsAsOldSelector - self assertTypesAreValidWhenMessageSendTo: '#(1)'! ! + oldSelector := #printOn:. + newSelector := #do:separatedBy:. + + self + assertCreation: [ RenameSelector from: oldSelector to: newSelector implementors: #() senders: #() ] + failsWith: [ RenameSelector errorMessageForNewSelector: newSelector doesNotHaveSameNumberOfArgumentsAs: oldSelector ] +! ! -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:59:23'! -test05TypeOfMessageSentToLiteralBraceArrayAreObtainedCorrectly +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! +test11NewImplementorsKeepMethodCategory + + | rename oldSelectorCategory | + + oldSelectorCategory := 'oldSelectorCategory'. + self createClassToRefactor. + classToRefactor organization classify: oldSelector under: oldSelectorCategory. + + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>senderOfOldSelector). + rename apply. + + self assert: oldSelectorCategory equals: (classToRefactor organization categoryOfElement: newSelector) +! ! - self assertTypesAreValidWhenMessageSendTo: '{1}'! ! +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:30:58'! +test12RenamesRecursiveMethodsWhenNotInSenders -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:59:33'! -test06TypeOfMessageSentToLiteralBlockAreObtainedCorrectly + | rename senderMethod | + + self createClassToRefactor. + classToRefactor compile: oldSelector asString , ' self ' , oldSelector asString. + + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: #(). + rename apply. + + senderMethod := classToRefactor compiledMethodAt: newSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector) +! ! - self assertTypesAreValidWhenMessageSendTo: '[1]'! ! +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:31:04'! +test13RenamesRecursiveMethodsWhenInSenders -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:59:42'! -test07TypeOfMessageSentToLiteralCharacterAreObtainedCorrectly + | rename senderMethod implementorsAndSenders | + + self createClassToRefactor. + classToRefactor compile: oldSelector asString , ' self ' , oldSelector asString. + implementorsAndSenders := Array with: classToRefactor>>oldSelector. + + rename := RenameSelector from: oldSelector to: newSelector implementors: implementorsAndSenders senders: implementorsAndSenders. + rename apply. + + senderMethod := classToRefactor compiledMethodAt: newSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector) +! ! - self assertTypesAreValidWhenMessageSendTo: '$a'! ! +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/8/2018 15:27:09'! +test14RenamesSymbolsEqualToOldSelector -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:59:51'! -test08TypeOfMessageSentToLiteralNilAreObtainedCorrectly + | rename senderMethod referencerToOldSelector | + + referencerToOldSelector := #m1. + self createClassToRefactor. + classToRefactor compile: oldSelector asString. + classToRefactor compile: referencerToOldSelector asString , ' #' , oldSelector asString, ' size'. - self assertTypesAreValidWhenMessageSendTo: 'nil'! ! + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). + rename apply. + + senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector) +! ! -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 11:59:59'! -test09TypeOfMessageSentToLiteralTrueAreObtainedCorrectly +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:34:01'! +test15ScopeToRenameCanBeClassOnly + + | rename anotherClassSendingMessage | + + classToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. + + anotherClassSendingMessage := self createClassNamed: #ClassToAvoidRenameSelector. + anotherClassSendingMessage compile: senderOfOldSelector asString , ' self ' , oldSelector asString. - self assertTypesAreValidWhenMessageSendTo: 'true'! ! + rename := RenameSelector from: oldSelector to: newSelector in: classToRefactor. + rename apply. + + self assertWasRenamedInClassAndMeta: classToRefactor. + self assertWasNotRenamedInClass: anotherClassSendingMessage ! ! -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 12:00:08'! -test10TypeOfMessageSentToLiteralFalseAreObtainedCorrectly +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:07:15'! +test16ScopeToRenameCanBeHierarchyOnly + + | rename anotherClassSendingMessage superclassToRefactor subclassToRefactor | + + superclassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #SuperclassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. + classToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName subclassOf: superclassToRefactor categorizedAd: self classCategoryOfTestData. + subclassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #SubclassToRenameSelector subclassOf: classToRefactor categorizedAd: self classCategoryOfTestData. - self assertTypesAreValidWhenMessageSendTo: 'false'! ! + anotherClassSendingMessage := self createClassNamed: #ClassToAvoidRenameSelector. + anotherClassSendingMessage compile: senderOfOldSelector asString , ' self ' , oldSelector asString. -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 7/15/2021 10:47:18'! -test11TypeOfMessageSentToSelfAreObtainedCorrectly + rename := RenameSelector from: oldSelector to: newSelector inHierarchyOf: classToRefactor. + rename apply. + + self assertWasRenamedInClassAndMeta: superclassToRefactor. + self assertWasRenamedInClassAndMeta: classToRefactor. + self assertWasRenamedInClassAndMeta: subclassToRefactor. + self assertWasNotRenamedInClass: anotherClassSendingMessage ! ! - self - assertTypeOfMessageSend: 'm1 self _zz' - is: #undefinedUnary - in: Object - receiverRange: [ :ranges | ranges penultimate ] - messageRange: [ :ranges | ranges last ]. - self - assertTypeOfMessageSend: 'm1 self size' - is: #unary - in: Object - receiverRange: [ :ranges | ranges penultimate ] - messageRange: [ :ranges | ranges last ]. - - "Binary messages have been disabled - Hernan - self - assertTypeOfMessageSend: 'm1 self !! 2' - is: #undefinedBinary - in: Object - receiverRange: [ :ranges | ranges antepenultimate ] - messageRange: [ :ranges | ranges penultimate ]." - - self - assertTypeOfMessageSend: 'm1 self = 2' - is: #binary - in: Object - receiverRange: [ :ranges | ranges antepenultimate ] - messageRange: [ :ranges | ranges penultimate ].! ! +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:07:32'! +test17ScopeToRenameCanBeCategoryOnly + + | rename anotherClassSendingMessage anotherClassToRefactor | + + classToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. + anotherClassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #AnotherclassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. + + anotherClassSendingMessage := self createClassNamed: #ClassToAvoidRenameSelector category: self classCategoryOfTestDataToAvoid. + anotherClassSendingMessage compile: senderOfOldSelector asString , ' self ' , oldSelector asString. -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 12:00:26'! -test12TypeOfMessageSentToSuperAreObtainedCorrectly + rename := RenameSelector from: oldSelector to: newSelector inCategoryOf: classToRefactor organizedBy: SystemOrganization. + rename apply. - self assertTypesAreValidWhenMessageSendTo: 'super'! ! + self assertWasRenamedInClassAndMeta: classToRefactor. + self assertWasRenamedInClassAndMeta: anotherClassToRefactor. + self assertWasNotRenamedInClass: anotherClassSendingMessage + ! ! -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 7/15/2021 10:47:00'! -test13TypesIsUndefinedForAnyMessageSendToSuperFromProtoObject +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:07:49'! +test18ScopeToRenameCanBeCategoriesAndHierarchyOnly + + | rename anotherClassSendingMessage superclassToRefactor subclassToRefactor anotherClassToRefactor classInOtherCategoryToRefactor | + + superclassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #SuperclassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self anotherClassCategoryOfTestData. + classToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName subclassOf: superclassToRefactor categorizedAd: self classCategoryOfTestData. + subclassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #SubclassToRenameSelector subclassOf: classToRefactor categorizedAd: self classCategoryOfTestData. + anotherClassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #AnotheclassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. + classInOtherCategoryToRefactor := self + createClassWithImplementorAndSenderInMetaTooNamed: #OtherCatClassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self anotherClassCategoryOfTestData. + + anotherClassSendingMessage := self createClassNamed: #ClassToAvoidRenameSelector category: self classCategoryOfTestDataToAvoid. + anotherClassSendingMessage compile: senderOfOldSelector asString , ' self ' , oldSelector asString. - self - assertTypeOfMessageSend: 'm1 super size' - is: #undefinedUnary - in: ProtoObject - receiverRange: [ :ranges | ranges penultimate ] - messageRange: [ :ranges | ranges last ]. - - "binaryMessages have been disabled - Hernan - self - assertTypeOfMessageSend: 'm1 super = 2' - is: #undefinedBinary - in: ProtoObject - receiverRange: [ :ranges | ranges antepenultimate ] - messageRange: [ :ranges | ranges penultimate ]."! ! + rename := RenameSelector from: oldSelector to: newSelector inCategoriesAndHierarchyOf: classToRefactor organizedBy: SystemOrganization. + rename apply. -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 12:00:37'! -test14TypeOfMessageSentToGlobalVarAreObtainedCorrectly + self assertWasRenamedInClassAndMeta: superclassToRefactor. + self assertWasRenamedInClassAndMeta: classToRefactor. + self assertWasRenamedInClassAndMeta: subclassToRefactor. + self assertWasRenamedInClassAndMeta: anotherClassToRefactor. + self assertWasRenamedInClassAndMeta: classInOtherCategoryToRefactor. + self assertWasNotRenamedInClass: anotherClassSendingMessage ! ! - self assertTypesAreValidWhenMessageSendTo: 'Smalltalk'! ! +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:08:00'! +test19ScopeToRenameCanBeTheCompleteSystem + + | rename anotherClassToRefactor | + + classToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. + anotherClassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #AnotherclassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. -!SHST80RangeTypeTest methodsFor: 'tests' stamp: 'HAW 10/5/2020 12:24:04'! -test15TypeOfMessageSentToClassVarAreObtainedCorrectly + rename := RenameSelector from: oldSelector to: newSelector inSystem: Smalltalk. + "This is just to be sure that no more than the expected methods will be renamed because I'm using Smalltalk as system. + I could mock Smalltalk but I want to have a real test using Smalltalk, not a mock, that it is why I have these assertions here - Hernan" + self assert: 4 equals: rename implementorsSize. + self assert: 4 equals: rename sendersSize. + + rename apply. - ClassVar1 := 1. - self assertTypesAreValidWhenMessageSendTo: 'ClassVar1'! ! + self assertWasRenamedInClassAndMeta: classToRefactor. + self assertWasRenamedInClassAndMeta: anotherClassToRefactor +! ! -!SHST80RangeTypeTest methodsFor: 'assertions' stamp: 'HAW 10/5/2020 12:02:43'! -assertTypeOfBinaryMessageSend: aSourceCode is: aExpectedType +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! +test20CanNotRenameToItSelf self - assertTypeOfMessageSend: aSourceCode - is: aExpectedType - receiverRange: [ :ranges | ranges antepenultimate ] - messageRange: [ :ranges | ranges penultimate ] + assertCreation: [ RenameSelector from: oldSelector to: oldSelector asSymbol implementors: #() senders: #() ] + failsWith: [ RenameSelector newSelectorEqualToOldSelectorErrorMessage ] ! ! -!SHST80RangeTypeTest methodsFor: 'assertions' stamp: 'jmv 4/26/2021 19:40:38'! -assertTypeOfMessageSend: aSourceCode - is: aExpectedType - in: aClassOrMetaClass - receiverRange: aReceiverRangeBlock - messageRange: aMessageRangeBlock +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! +test21NewSelectorCanNotBeImplementedOnAnyClassImplementingOldSelector - | parser ranges st80RangeType type | + | implementors | - parser := SHParserST80 new. - ranges := parser - workspace: nil; - classOrMetaClass: aClassOrMetaClass ; - source: aSourceCode; - parse; - ranges. - - st80RangeType := SHST80RangeType for: aSourceCode in: aClassOrMetaClass. - st80RangeType lastRange: (aReceiverRangeBlock value: ranges). - type := st80RangeType ofCurrentRangeOrMessageSendIn: (aMessageRangeBlock value: ranges). + oldSelector := #printString. + newSelector := #size. + implementors := Array with: Object>>oldSelector. - self assert: aExpectedType equals: type - ! ! - -!SHST80RangeTypeTest methodsFor: 'assertions' stamp: 'HAW 10/5/2020 12:23:51'! -assertTypeOfMessageSend: aSourceCode - is: aExpectedType - receiverRange: aReceiverRangeBlock - messageRange: aMessageRangeBlock - self - assertTypeOfMessageSend: aSourceCode - is: aExpectedType - in: self class - receiverRange: aReceiverRangeBlock - messageRange: aMessageRangeBlock! ! + assertCreation: [ RenameSelector from: oldSelector to: newSelector implementors: implementors senders: #() ] + failsWith: [ RenameSelector errorMessageForNewSelector: newSelector implementedInAll: (Array with: Object) ] +! ! -!SHST80RangeTypeTest methodsFor: 'assertions' stamp: 'HAW 10/5/2020 12:02:52'! -assertTypeOfUnaryMessageSend: aSourceCode is: aExpectedType +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 8/15/2018 11:52:37'! +test22WarnsWhenOverridesSuperclassImplementation + | implementors | + + oldSelector := #negated. + newSelector := #size. + implementors := Array with: Number>>oldSelector. + self - assertTypeOfMessageSend: aSourceCode - is: aExpectedType - receiverRange: [ :ranges | ranges penultimate ] - messageRange: [ :ranges | ranges last ] + assertCreation: [ RenameSelector from: oldSelector to: newSelector implementors: implementors senders: #() ] + warnsWith: [ RenameSelector warningMessageForImplementationOf: newSelector in: Number willOverrideImplementationIn: Object ] ! ! -!SHST80RangeTypeTest methodsFor: 'assertions' stamp: 'HAW 7/15/2021 10:45:30'! -assertTypesAreValidWhenMessageSendTo: aReceiverAsString - - self assertTypeOfUnaryMessageSend: 'm1 ', aReceiverAsString, ' _zz' is: #undefinedUnary. - self assertTypeOfUnaryMessageSend: 'm1 ', aReceiverAsString, ' size' is: #unary. - - " binary messages has beed disabled by now - Hernan - self assertTypeOfBinaryMessageSend: 'm1 ', aReceiverAsString, ' !! 2' is: #undefinedBinary. - self assertTypeOfBinaryMessageSend: 'm1 ', aReceiverAsString, ' = 2' is: #binary - "! ! - -!SHST80RangeTypeTest methodsFor: 'messages for testing' stamp: 'HAW 10/5/2020 12:15:40'! -!! something +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/29/2018 14:14:49'! +test23OldSelectorIsRenamedWhenDefinedInLiteralArray - "Do not remove this method because it exists for its name to have implementors - Hernan"! ! + | rename senderMethod referencerToOldSelector | + + referencerToOldSelector := #m1. + self createClassToRefactor. + classToRefactor compile: oldSelector asString. + classToRefactor compile: referencerToOldSelector asString , ' ^#(#' , oldSelector asString, ')'. -!SHST80RangeTypeTest methodsFor: 'messages for testing' stamp: 'HAW 10/5/2020 12:15:50'! -_zz + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). + rename apply. + + senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector) +! ! - "Do not remove this method because it exists for its name to have implementors - Hernan"! ! +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/29/2018 15:20:23'! +test24OldSelectorIsRenamedWhenDefinedInLiteralArrayMoreThanOnce -!DebuggerTest methodsFor: 'tests - method categories' stamp: 'HAW 8/19/2021 15:31:36'! -testCategoriesAreAddedSortedByAndSeparatedByClass + | rename senderMethod referencerToOldSelector | + + referencerToOldSelector := #m1. + self createClassToRefactor. + classToRefactor compile: oldSelector asString. + classToRefactor compile: referencerToOldSelector asString , ' ^#(#' , oldSelector asString, ' #' , oldSelector asString,')'. - | objectCategories protoObjectCategories categoriesPrompter | - - objectCategories := Object methodCategoriesAsSortedCollection. - protoObjectCategories := ProtoObject methodCategoriesAsSortedCollection removeAllFoundIn: objectCategories; yourself. + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). + rename apply. - "Test pre-conditions. May seem unnecesary but they are not if we take time into account - Hernan" - self assert: ProtoObject equals: Object superclass. - self assert: nil equals: ProtoObject superclass. - self assert: objectCategories notEmpty. - self assert: protoObjectCategories notEmpty. + senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector) +! ! + +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/29/2018 15:22:15'! +test25OldSelectorIsRenamedWhenDefinedInMoreThanOneLiteralArrayMoreThanOnce + + | rename senderMethod referencerToOldSelector | - categoriesPrompter := MethodCategoriesPrompter staringFrom: Object rejectingFirst: false. + referencerToOldSelector := #m1. + self createClassToRefactor. + classToRefactor compile: oldSelector asString. + classToRefactor compile: referencerToOldSelector asString , ' ^#(#' , oldSelector asString, ' #' , oldSelector asString,'), #(#' , oldSelector asString, ' #' , oldSelector asString,')'. + + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). + rename apply. - self assert: 2 equals: categoriesPrompter lines size. - self assert: 1 equals: categoriesPrompter lines first. - self assert: (categoriesPrompter categories copyFrom: 2 to: categoriesPrompter lines second) asArray equals: objectCategories asArray. - self assert: (categoriesPrompter categories copyFrom: categoriesPrompter lines second + 1 to: categoriesPrompter categories size) asArray equals: protoObjectCategories asArray. - ! ! + senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector) +! ! -!DebuggerTest methodsFor: 'tests - method categories' stamp: 'HAW 8/19/2021 15:33:48'! -testMetaclassCategoriesIncludesInstanceCreation +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/29/2018 15:24:47'! +test26DoesNotRenameLiteralsThatBeginsWithOldSelectorInsideLiteralArray - | categoriesPrompter | + | rename senderMethod referencerToOldSelector | + + referencerToOldSelector := #m1. + self createClassToRefactor. + classToRefactor compile: oldSelector asString. + classToRefactor compile: referencerToOldSelector asString , ' ^#(#' , oldSelector asString, ' #' , oldSelector asString,'1)'. - categoriesPrompter := MethodCategoriesPrompter staringFrom: ProtoObject class rejectingFirst: false. + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). + rename apply. - self assert: Categorizer instanceCreation equals: categoriesPrompter categories second ! ! + senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). + self assert: (senderMethod sendsOrRefersTo: (oldSelector,'1') asSymbol) +! ! -!StrikeFontTest methodsFor: 'testing' stamp: 'jmv 6/11/2020 16:30:55'! -testBaseAndDerivedFont - " - StrikeFontTest new testBaseAndDerivedFont - " +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 11/30/2018 15:04:14'! +test27DoesNotRenameLiteralsThatBeginsWithOldSelectorAndEndWithColonInsideLiteralArray - | base italic italicItalic boldItalic italicBold boldItalic2 underlined underlinedItalic italicUnderlined struckThrough1 struckThrough2 | - base _ FontFamily defaultFamilyPointSize: 14. - self assert: base isBaseFont. - italic _ base italic. - self deny: italic isBaseFont. - italicItalic _ italic italic. - self assert: italicItalic == italic. - boldItalic _ base bold italic. - self deny: boldItalic isBaseFont. - boldItalic2 _ base boldItalic. - italicBold _ italic bold. - self assert: boldItalic == italicBold. - self assert: boldItalic == boldItalic2. - underlined _ base underlined. - self deny: underlined isBaseFont. - underlinedItalic _ underlined italic. - italicUnderlined _ italic underlined. - self assert: underlinedItalic == italicUnderlined. - struckThrough1 _ base italic underlined bold struckThrough. - struckThrough2 _ base bold underlined italic struckThrough. - self assert: struckThrough1 == struckThrough2! ! + | rename senderMethod referencerToOldSelector | + + referencerToOldSelector := #m1. + self createClassToRefactor. + classToRefactor compile: oldSelector asString. + classToRefactor compile: referencerToOldSelector asString , ' ^#(#' , oldSelector asString, ' #' , oldSelector asString,':)'. -!StrikeFontTest methodsFor: 'testing' stamp: 'jmv 6/11/2020 16:25:48'! -testBaseAndDerivedFontSanity - " - StrikeFontTest new testBaseAndDerivedFontSanity - " + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). + rename apply. + + senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). + self assert: (senderMethod sendsOrRefersTo: (oldSelector,':') asSymbol) +! ! - StrikeFont allInstances do: [ :f | - f isBaseFont - ifTrue: [ - self assert: (f instVarNamed: 'baseFont') isNil. - self assert: f baseFont == f. - self assert: (f instVarNamed: 'derivativeFonts') notNil ] - ifFalse: [ - self assert: f baseFont notNil. - self assert: (f instVarNamed: 'derivativeFonts') isNil. - self assert: (f baseFont emphasized: f emphasis) == f ] ]! ! +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/13/2018 18:46:23'! +test28CanRenameFromBinaryToKeywordOfOneParameter -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:20'! -test16bpp - | form n read | - form _ JpegTest lenaColor64 asFormOfDepth: 16. - self assert: form nativeDepth = 16. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read depth = 32. + | rename senderMethod referencerToOldSelector | + + referencerToOldSelector := #m1. + oldSelector := '&&' asSymbol. + newSelector := 'abc:' asSymbol. + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString, ' aParameter'. + classToRefactor compile: referencerToOldSelector asString , ' ^self ' , oldSelector asString,' 1'. - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). + rename apply. + + self assert: (classToRefactor includesSelector: newSelector). + self deny: (classToRefactor includesSelector: oldSelector). + senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). +! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:16'! -test16bpp61 - | form n read | - form _ (JpegTest lenaColor64 asFormOfDepth: 16) copy: (0@0 extent: 61@61). - self assert: form nativeDepth = 16. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read depth = 32. - self assert: read extent = (61@61). +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/13/2018 18:53:24'! +test29CanRenameFromKeywordOfOneParameterToBinary - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | rename senderMethod referencerToOldSelector | + + referencerToOldSelector := #m1. + oldSelector := 'abc:' asSymbol. + newSelector := '&&' asSymbol. + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString, ' aParameter'. + classToRefactor compile: referencerToOldSelector asString , ' ^self ' , oldSelector asString,' 1'. -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:13'! -test16bpp62 - | form n read | - form _ (JpegTest lenaColor64 asFormOfDepth: 16) copy: (0@0 extent: 62@62). - self assert: form nativeDepth = 16. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read depth = 32. - self assert: read extent = (62@62). + rename := RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: (Array with: classToRefactor>>referencerToOldSelector). + rename apply. + + self assert: (classToRefactor includesSelector: newSelector). + self deny: (classToRefactor includesSelector: oldSelector). + senderMethod := classToRefactor compiledMethodAt: referencerToOldSelector. + self deny: (senderMethod sendsOrRefersTo: oldSelector). + self assert: (senderMethod sendsOrRefersTo: newSelector). +! ! - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/13/2018 19:00:10'! +test30CanNotRenameFromBinaryToKeywordOfMoreThanOneParameter -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:10'! -test16bpp63 - | form n read | - form _ (JpegTest lenaColor64 asFormOfDepth: 16) copy: (0@0 extent: 63@63). - self assert: form nativeDepth = 16. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read depth = 32. - self assert: read extent = (63@63). + oldSelector := '&&' asSymbol. + newSelector := 'abc:def:' asSymbol. + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: oldSelector asString, ' aParameter'. - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + self + should: [ RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: #() ] + raise: Error + withMessageText: (RenameSelector errorMessageForNewSelector: newSelector isNotOfSameTypeAs: oldSelector)! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:07'! -test16bppLE - | form n read | - form _ JpegTest lenaColor64 asFormOfDepth: -16. - self assert: form nativeDepth = -16. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read depth = 32. +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/13/2018 18:59:39'! +test31CanNotRenameFromKeywordOfOneParameterToBinary - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + oldSelector := 'abc:def:' asSymbol. + newSelector := '&&' asSymbol. + classToRefactor := self createClassNamed: self classToRefactorName. + classToRefactor compile: 'abc: p1 def: p2'. -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:04'! -test16bppLE61 - | form n read | - form _ (JpegTest lenaColor64 asFormOfDepth: -16) copy: (0@0 extent: 61@61). - self assert: form nativeDepth = -16. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read depth = 32. - self assert: read extent = (61@61). + self + should: [ RenameSelector from: oldSelector to: newSelector implementors: (Array with: classToRefactor>>oldSelector) senders: #() ] + raise: Error + withMessageText: (RenameSelector errorMessageForNewSelector: newSelector isNotOfSameTypeAs: oldSelector)! ! - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 20:08:36'! +test32HierarchyScopeRenamesSelectorsFromSuperclassDefiningSelector + + | rename superclassToRefactor subclassToRefactor | + + superclassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #SuperclassToRenameSelector subclassOf: RefactoringClassTestData categorizedAd: self classCategoryOfTestData. + classToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName subclassOf: superclassToRefactor categorizedAd: self classCategoryOfTestData. + subclassToRefactor := self createClassWithImplementorAndSenderInMetaTooNamed: #SubclassToRenameSelector subclassOf: superclassToRefactor categorizedAd: self classCategoryOfTestData. -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:59:00'! -test16bppLE62 - | form n read | - form _ (JpegTest lenaColor64 asFormOfDepth: -16) copy: (0@0 extent: 62@62). - self assert: form nativeDepth = -16. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read depth = 32. - self assert: read extent = (62@62). + rename := RenameSelector from: oldSelector to: newSelector inHierarchyOf: classToRefactor. + rename apply. + + self assertWasRenamedInClassAndMeta: superclassToRefactor. + self assertWasRenamedInClassAndMeta: classToRefactor. + self assertWasRenamedInClassAndMeta: subclassToRefactor. + ! ! - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! +!RenameSelectorTest methodsFor: 'tests' stamp: 'HAW 3/7/2020 18:48:46'! +test33DoNotRenameSendersAndImplementorsWhoseCompilerClassIsDifferentToCompiler + + "Requested by Phil B. to avoid refactoring OMeta2 classes - Hernan" + + | rename anotherClassSendingMessage | + + classToRefactor := self + createClassWithImplementorAndSenderInMetaTooNamed: self classToRefactorName + subclassOf: RefactoringClassTestData + categorizedAd: self classCategoryOfTestData. + + anotherClassSendingMessage := self + createClassWithImplementorAndSenderInMetaTooNamed: #ClassToAvoidRenameSelector + subclassOf: RefactoringClassTestData + categorizedAd: self classCategoryOfTestData. + + anotherClassSendingMessage class compile: 'compilerClass ^nil'. -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:57'! -test16bppLE63 - | form n read | - form _ (JpegTest lenaColor64 asFormOfDepth: -16) copy: (0@0 extent: 63@63). - self assert: form nativeDepth = -16. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read depth = 32. - self assert: read extent = (63@63). + rename := RenameSelector + from: oldSelector + to: newSelector + inCategoryOf: classToRefactor + organizedBy: SystemOrganization. + rename apply. - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + self assertWasRenamedInClassAndMeta: classToRefactor. + self assertWasNotRenamedInClass: anotherClassSendingMessage. + self assertWasRenamedInClass: anotherClassSendingMessage class. + ! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:53'! -test32bpp - | form n read | - form _ JpegTest lenaColor64. - self assert: form depth = 32. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read depth = 32. +!RenameTemporaryTest methodsFor: 'class factory' stamp: 'HAW 6/25/2017 21:53:44'! +classToRefactorName - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + ^#ClassToRenameTemp! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:50'! -test32bpp63 - | form n read | - form _ JpegTest lenaColor64 copy: (0@0 extent: 63@63). - self assert: form depth = 32. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read depth = 32. - self assert: read extent = (63@63). +!RenameTemporaryTest methodsFor: 'class factory' stamp: 'HAW 6/25/2017 21:53:44'! +methodNodeOf: aSourceCode - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + ^self methodNodeOf: aSourceCode in: self class! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:47'! -test32bppLE63 - | form n read | - form _ JpegTest lenaColor64 copy: (0@0 extent: 63@63). - self assert: form depth = 32. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read depth = 32. - self assert: read extent = (63@63). +!RenameTemporaryTest methodsFor: 'class factory' stamp: 'HAW 8/9/2018 23:23:12'! +methodNodeOf: aSourceCode in: aClass - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + ^aClass methodNodeFor: aSourceCode ! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:44'! -testBA16bpp - | form n read bytes | - form _ JpegTest lenaColor64 asFormOfDepth: 16. - self assert: form nativeDepth = 16. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ Form extent: form extent depth: 16. - JPEGReadWriter2 new uncompress: bytes into: read. +!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 10/4/2017 17:04:33'! +test01VariableToRenameHasToBeDefined - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | newVariable oldVariable methodNode | + + oldVariable := 'old'. + newVariable := 'new'. + + methodNode := self methodNodeOf: 'm1'. + + self + assertCreation: [ RenameTemporary from: oldVariable to: newVariable in: methodNode ] + failsWith: [ RenameTemporary errorMessageForTemporaryVariable: oldVariable notDefinedIn: methodNode ]! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:41'! -testBA16bpp61 - | form n read bytes | - form _ (JpegTest lenaColor64 asFormOfDepth: 16) copy: (0@0 extent: 61@61). - self assert: form nativeDepth = 16. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ Form extent: form extent depth: 16. - JPEGReadWriter2 new uncompress: bytes into: read. +!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 2/25/2020 00:02:32'! +test02NewVariableNameCanNotBeEmpty - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode newVariable oldVariable | + + oldVariable := 'old'. + newVariable := ' '. + + methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | '. + + self + assertCreation: [ RenameTemporary from: oldVariable to: newVariable in: methodNode ] + failsWith: [ NewTemporaryPrecondition errorMessageForEmptyTemporaryVariable ]! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:37'! -testBA16bpp62 - | form n read bytes | - form _ (JpegTest lenaColor64 asFormOfDepth: 16) copy: (0@0 extent: 62@62). - self assert: form nativeDepth = 16. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ Form extent: form extent depth: 16. - JPEGReadWriter2 new uncompress: bytes into: read. +!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 2/25/2020 00:06:33'! +test03NewVariableHasToBeValid - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode newVariable oldVariable | + + oldVariable := 'old'. + newVariable := 'a b'. + + methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | '. + + self + assertCreation: [ RenameTemporary from: oldVariable to: newVariable in: methodNode ] + failsWith: [ NewTemporaryPrecondition errorMessageForInvalidTemporaryVariable: newVariable ] + ! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:34'! -testBA16bpp63 - | form n read bytes | - form _ (JpegTest lenaColor64 asFormOfDepth: 16) copy: (0@0 extent: 63@63). - self assert: form nativeDepth = 16. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ Form extent: form extent depth: 16. - JPEGReadWriter2 new uncompress: bytes into: read. +!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 2/25/2020 00:07:12'! +test04NewVariableNameCanNotBeDefinedInMethod - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable | + + oldVariable := 'old'. + + methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | '. + + self + assertCreation: [RenameTemporary from: oldVariable to: oldVariable in: methodNode ] + failsWith: [ NewTemporaryPrecondition errorMessageForNewTemporaryVariable: oldVariable isAlreadyDefinedIn: methodNode ]! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:31'! -testBA16bppLE - | form n read bytes | - form _ JpegTest lenaColor64 asFormOfDepth: -16. - self assert: form nativeDepth = -16. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ Form extent: form extent depth: 16. - JPEGReadWriter2 new uncompress: bytes into: read. +!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 5/24/2020 20:01:16'! +test05FailsIfNewTemporaryIsEqualToInstanceVariableInClass - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable newVariable classToRefactor | + + oldVariable := 'old'. + newVariable := 'new'. + + classToRefactor := self createClassNamed: self classToRefactorName instanceVariableNames: newVariable. + methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | ' in: classToRefactor. + + self + assertCreation: [ RenameTemporary from: oldVariable to: newVariable in: methodNode ] + failsWith: [ NewTemporaryPrecondition errorMessageFor: newVariable canNotBeNamedDueToInstanceVariableDefinedIn: classToRefactor ]! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:28'! -testBA16bppLE61 - | form n read bytes | - form _ (JpegTest lenaColor64 asFormOfDepth: -16) copy: (0@0 extent: 61@61). - self assert: form nativeDepth = -16. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ Form extent: form extent depth: 16. - JPEGReadWriter2 new uncompress: bytes into: read. +!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 5/24/2020 20:01:16'! +test06FailsIfNewTemporaryIsEqualToInstanceVariableInAnySuperclass - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable newVariable classToRefactor superclassToRefactor | + + oldVariable := 'old'. + newVariable := 'new'. + + superclassToRefactor := self createClassNamed: #ClassToRefactorSuperclass instanceVariableNames: newVariable. + classToRefactor := self createClassNamed: self classToRefactorName subclassOf: superclassToRefactor. + methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | ' in: classToRefactor. + + self + assertCreation: [ RenameTemporary from: oldVariable to: newVariable in: methodNode ] + failsWith: [ NewTemporaryPrecondition errorMessageFor: newVariable canNotBeNamedDueToInstanceVariableDefinedIn: superclassToRefactor ]! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:25'! -testBA16bppLE62 - | form n read bytes | - form _ (JpegTest lenaColor64 asFormOfDepth: -16) copy: (0@0 extent: 62@62). - self assert: form nativeDepth = -16. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ Form extent: form extent depth: 16. - JPEGReadWriter2 new uncompress: bytes into: read. +!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! +test07RenameCreatesNewTemporaryVariableAndDeletesOldOne - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable newVariable rename newMethodNode | + + oldVariable := 'old'. + newVariable := 'new'. + + methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | '. + + rename := RenameTemporary from: oldVariable to: newVariable in: methodNode. + newMethodNode := rename methodNodeAfterApply. + + self deny: (newMethodNode hasArgumentOrTemporaryNamed: oldVariable). + self assert: (newMethodNode hasArgumentOrTemporaryNamed: newVariable)! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:20'! -testBA16bppLE63 - | form n read bytes | - form _ (JpegTest lenaColor64 asFormOfDepth: -16) copy: (0@0 extent: 63@63). - self assert: form nativeDepth = -16. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ Form extent: form extent depth: 16. - JPEGReadWriter2 new uncompress: bytes into: read. +!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 8/9/2018 19:28:42'! +test08RenameChangesReferencesFromOldVariableToNewVariable - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable newVariable rename newMethodNode assigmentNode | + + oldVariable := 'old'. + newVariable := 'new'. + + methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | ', oldVariable, ' := 1 + ', oldVariable. + + rename := RenameTemporary from: oldVariable to: newVariable in: methodNode. + newMethodNode := rename methodNodeAfterApply. + + assigmentNode := newMethodNode block statements first. + self assert: newVariable equals: assigmentNode variable name. + self assert: newVariable equals: assigmentNode value arguments first name.! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:16'! -testBA32bpp - | form n read bytes | - form _ JpegTest lenaColor64. - self assert: form depth = 32. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ JPEGReadWriter2 new uncompress: bytes into: nil. - self assert: read depth = 32. +!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! +test09RenamesArguments - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable newVariable rename newMethodNode | + + oldVariable := 'old'. + newVariable := 'new'. + + methodNode := self methodNodeOf: 'm1: ', oldVariable, ' ^', oldVariable. + + rename := RenameTemporary from: oldVariable to: newVariable in: methodNode. + newMethodNode := rename methodNodeAfterApply. + + self deny: (newMethodNode hasArgumentOrTemporaryNamed: oldVariable). + self assert: (newMethodNode hasArgumentOrTemporaryNamed: newVariable). + self assert: newVariable equals: newMethodNode block statements first expr name.! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:07'! -testBA32bpp63 - | form n read bytes | - form _ JpegTest lenaColor64 copy: (0@0 extent: 63@63). - self assert: form depth = 32. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ JPEGReadWriter2 new uncompress: bytes into: nil. - self assert: read depth = 32. - self assert: read extent = (63@63). +!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 2/25/2020 00:07:53'! +test10NewVariableNameCanNotBeDefinedAsBlockArgument - n _ form boundingBox width * form boundingBox height * 3. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable newVariable | + + oldVariable := 'old'. + newVariable := 'new'. + + methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | [:', newVariable, ' | ^1 ]'. + + self + assertCreation: [RenameTemporary from: oldVariable to: newVariable in: methodNode ] + failsWith: [ NewTemporaryPrecondition errorMessageForNewTemporaryVariable: newVariable isAlreadyDefinedIn: methodNode ]! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:03'! -testGray - | form n read | - form _ JpegTest lenaColor64 asGrayForm. - self assert: form nativeDepth = -8. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read nativeDepth = -8. +!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! +test11RenamesBlockArguments - n _ form boundingBox width * form boundingBox height. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable newVariable rename newMethodNode | + + oldVariable := 'old'. + newVariable := 'new'. + + methodNode := self methodNodeOf: 'm1 [:', oldVariable, '| ^', oldVariable, ']'. + + rename := RenameTemporary from: oldVariable to: newVariable in: methodNode. + newMethodNode := rename methodNodeAfterApply. + + self deny: (newMethodNode hasArgumentOrTemporaryNamed: oldVariable). + self assert: (newMethodNode hasArgumentOrTemporaryNamed: newVariable). + "asserts it renamed block argument - Hernan" + self assert: newVariable equals: newMethodNode block statements first arguments first name. + "asserts it renamed reference to block argument - Hernan" + self assert: newVariable equals: newMethodNode block statements first block statements first expr name! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:58:01'! -testGray61 - | form n read | - form _ JpegTest lenaColor64 asGrayForm copy: (0@0 extent: 61@61). - self assert: form nativeDepth = -8. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read nativeDepth = -8. - self assert: read extent = (61@61). +!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:12:33'! +test12RenamesBlockTemporaries - n _ form boundingBox width * form boundingBox height. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable newVariable rename newMethodNode | + + oldVariable := 'old'. + newVariable := 'new'. + + methodNode := self methodNodeOf: 'm1 [ |', oldVariable, '| ^', oldVariable, ']'. + + rename := RenameTemporary from: oldVariable to: newVariable in: methodNode. + newMethodNode := rename methodNodeAfterApply. + + self deny: (newMethodNode hasArgumentOrTemporaryNamed: oldVariable). + self assert: (newMethodNode hasArgumentOrTemporaryNamed: newVariable). + "asserts it renamed block temporary - Hernan" + self assert: newVariable equals: newMethodNode block statements first temporaries first name. + "asserts it renamed reference to block temporary - Hernan" + self assert: newVariable equals: newMethodNode block statements first block statements first expr name! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:57:57'! -testGray62 - | form n read | - form _ JpegTest lenaColor64 asGrayForm copy: (0@0 extent: 62@62). - self assert: form nativeDepth = -8. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read nativeDepth = -8. - self assert: read extent = (62@62). +!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:15:28'! +test13OldNodeMustBePartOfMethodNode - n _ form boundingBox width * form boundingBox height. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable newVariable oldVariableNode | + + oldVariable := 'old'. + newVariable := 'new'. + + methodNode := self methodNodeOf: 'm1 | ', oldVariable, ' | '. + oldVariableNode := methodNode tempNodes anyOne. + + self + assertCreation: [RenameTemporary fromOldVariableNode: oldVariableNode copy to: newVariable in: methodNode ] + failsWith: [RenameTemporary oldVariableNodeNotPartOfMethodNodeErrorDescription ] ! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:57:54'! -testGray63 - | form n read | - form _ JpegTest lenaColor64 asGrayForm copy: (0@0 extent: 63@63). - self assert: form nativeDepth = -8. - form writeJPEGfileNamed: 'test.jpg'. - read _ 'test.jpg' asFileEntry formContents. - self assert: read nativeDepth = -8. - self assert: read extent = (63@63). +!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:15:28'! +test14OldVariableNodeMustBeArgOrTempNode - n _ form boundingBox width * form boundingBox height. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode newVariable oldVariableNode | + + newVariable := 'new'. + + methodNode := self methodNodeOf: 'm1 self'. + oldVariableNode := methodNode block statements first. + + self + assertCreation: [RenameTemporary fromOldVariableNode: oldVariableNode to: newVariable in: methodNode ] + failsWith: [RenameTemporary oldVariableNodeMustBeArgOrTempNodeErrorDescription ] ! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:57:48'! -testGrayBA - | form n read bytes | - form _ JpegTest lenaColor64 asGrayForm. - self assert: form nativeDepth = -8. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ JPEGReadWriter2 new uncompress: bytes into: nil. - self assert: read nativeDepth = -8. +!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 12/17/2019 19:15:28'! +test15RenameVariablesWithSameNameInDifferentBlocksCorrectly - n _ form boundingBox width * form boundingBox height. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable newVariable oldVariableNode newMethodNode rename | + + oldVariable := 'old'. + newVariable := 'new'. + + methodNode := self methodNodeOf: 'm1 [|',oldVariable,'| ^',oldVariable, '].[|',oldVariable,'| ^',oldVariable, '].'. + oldVariableNode := methodNode block statements first temporaries first. + + rename := RenameTemporary fromOldVariableNode: oldVariableNode to: newVariable in: methodNode. + newMethodNode := rename methodNodeAfterApply. + + self + assert: 'm1 [|',newVariable,'| ^',newVariable, '].[|',oldVariable,'| ^',oldVariable, '].' + equals: newMethodNode sourceText! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:57:44'! -testGrayBA61 - | form n read bytes | - form _ JpegTest lenaColor64 asGrayForm copy: (0@0 extent: 61@61). - self assert: form nativeDepth = -8. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ JPEGReadWriter2 new uncompress: bytes into: nil. - self assert: read nativeDepth = -8. - self assert: read extent = (61@61). +!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 2/25/2020 00:08:04'! +test16CantRenameVariableToANameAlreadyUsedInAnUpperBlock - n _ form boundingBox width * form boundingBox height. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable newVariable oldVariableNode | + + oldVariable := 'old'. + newVariable := 'new'. + + methodNode := self methodNodeOf: 'm1 [|',newVariable,'| [|',oldVariable,'| ^', oldVariable,']. ^',newVariable,' ]'. + oldVariableNode := methodNode block statements first statements first temporaries first. + + self + assertCreation: [RenameTemporary fromOldVariableNode: oldVariableNode to: newVariable in: methodNode ] + failsWith: [ + NewTemporaryPrecondition errorMessageForNewTemporaryVariable: newVariable isAlreadyDefinedIn: methodNode ] + ! ! -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:57:40'! -testGrayBA62 - | form n read bytes | - form _ JpegTest lenaColor64 asGrayForm copy: (0@0 extent: 62@62). - self assert: form nativeDepth = -8. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ JPEGReadWriter2 new uncompress: bytes into: nil. - self assert: read nativeDepth = -8. - self assert: read extent = (62@62). +!RenameTemporaryTest methodsFor: 'tests' stamp: 'HAW 2/29/2020 18:09:43'! +test17RenamesOneCharVariableAfterAReturnWithoutCharsAfterThatCorrectly - n _ form boundingBox width * form boundingBox height. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! + | methodNode oldVariable newVariable rename newSource | + + "This test is due to a fixed error in the parser. + See ParserTest>>#testRangesAreOkWhenReturningAVariableWithoutSpaceAfterThat" + + oldVariable := 'o'. + newVariable := 'n'. -!JpegTest methodsFor: 'testing' stamp: 'jmv 2/21/2019 16:57:35'! -testGrayBA63 - | form n read bytes | - form _ JpegTest lenaColor64 asGrayForm copy: (0@0 extent: 63@63). - self assert: form nativeDepth = -8. - bytes _ JPEGReadWriter2 new compress: form quality: -1 progressiveJPEG: false. - read _ JPEGReadWriter2 new uncompress: bytes into: nil. - self assert: read nativeDepth = -8. - self assert: read extent = (63@63). + methodNode := self methodNodeOf: 'm1 |',oldVariable,'| ^',oldVariable. + + rename := RenameTemporary from: oldVariable to: newVariable in: methodNode. + newSource := rename apply. + + self + assert: 'm1 |',newVariable,'| ^',newVariable + equals: newSource + ! ! - n _ form boundingBox width * form boundingBox height. - self assert: (form pixelCompare: form boundingBox with: read at: 0@0) / n asFloat < 8! ! +!RenameTemporaryTest methodsFor: 'tests' stamp: 'RNG 4/26/2020 15:19:20'! +test18CantRenameVariableToAReservedName -!JpegTest class methodsFor: 'test examples' stamp: 'jmv 2/21/2019 16:55:22'! -lenaColor64 - " - ('LenaColor64.bmp' asFileEntry readStreamDo: [ :strm | strm binary. Base64MimeConverter mimeEncode: strm ]) upToEnd - JpegTest lenaColor64 display - " - ^Form fromBinaryStream: - 'Qk02MAAAAAAAADYAAAAoAAAAQAAAAEAAAAABABgAAAAAAAAwAADwCgAA8AoAAAAAAAAAAAAA -QWCvUXXHUHfGRGi/OTZkIB8tHx0qHx0oISArHh4pIyEtIR8vIB4qHx0pJyQxJB8vNCo9TjpI -V0NOHR0rHh4qHR4qHR0xISlbJTx/Kzl7IidFMUSPNU6lOlOsPVWtPlaxQFm3Qly4QFu4QFq4 -PVayOlWvP1myRWC3RmO3Um6/XnnJZIHNhJjbmKXhnqvmo67nmKXcKC9TLzlhKzJaLC5RJihG -ISNAR2ioYJbdQmaxJSxTHiA5IiNCKCtPLC1RJyZDQl+uUXTETnTDRmrAOjtrIyEwIB4qIB4q -JiQyJCIrJCIvJSExIB4qHRwoJyQyMSg1XkZSUkJUT0FmHRwqHh4uHR0tHR4sHyE6JjJzLD+K -Jjd6JSlIN06hOlOsPlSsP1a0Qlu4Q1y4Pli3PVe1P1q0QVuzQ1y1R2O6UGrAV3PEZH/OcYrR -h53dm6rln63moq/naG+gLDZdLzhkJitSJCVGHh80HR4wSG+vSoDJY5TdSnrJISZTJCVEJSdJ -KzBZKy5VR2S0UHPFUnbIQ2a7MzZzJyM2Hx0qIB4oJCAtJiMvJSItISAuHhwoJiQwNCw4UzxK -RTQ+JiEsLiY4KSU1HB4uHh8tHh4uHh4wHyVOLT6HL0KLKDJqLzluOVGnO1CpPle0QFq1Q1y5 -OlSxPVexP1m0Q164SWO7SmW7U27AVnPDbIXPfJPWkaXknKvloa7po7HpOUh1KzJVIyhKIidK -KCtLKS1MMTlgQl6cRXK2VIHEcajtNFKeJStTIihWIyhQMDRgSWm8UnbJVXrKQ2a6Mjl1JiQ6 -IB8pJCM0Hx0pJCAuIyEsIyIwJiMyJyMwJyEyRDVALCg5STlGLCQ2X01WRT5PHR8zHyA0HiAx -Hx43KTd1L0OTL0SWKSlTOE2gPlSrP1ezP1q1QVq1NlOtPFiyQFu1RF63SmW7Tmq/VnHBX3vJ -cYrRgZfZk6blorHvo7Ltoa3mMUJ6LDRaMTplOkdyQU99RFJ/R1iHR2OiOlaaSW2vfrHuS37L -Jzh5JitaJjBiJipRTGy/U3fJUXbHO1+0QkZ1ISEwHx4pHhwnJB8vKCUwIB4rIB8qIh8qJSIu -MiY2Oy88WkRLXkhQSTdEPTU/Hh4oHiI2HRs0HCA2HR0yICRPLkCHNUmbJCxfNkOHPlOrP1ay -QFq2P1e0O1WwO1ayQFu0RWC4Sma9U27CXHbHZYDMeZPXiZ7glqjnna7robDrY2ubRl6ZSluH -SluKRlmISluKSVmGR1aCQVaPOFafRnO+fq7vZZvkMEqTJzd2KzRnISlcTGy+U3bGUHG+RmGx -Rj9tISArHx8pIyEuJiMzMi06KSY2JCEuIyEvIB0pLyc0HxonSjdEZU9fU0RUUkZUUktfKylM -NDtvJyM5HR4zHyE7KDh8M0iaLjt7LDZtOE+mPlWuP1i1PFaxOlOsPli0RV22SmO7TGi9Um7C -X3nJaobRgJjbj6Tjmazrna/qnq7oSk9zR1yaU2maTF6NS16NSFmJRlmHRFOAQVOGUnm/canx -d6rsc6frPF6sJjt+JjNqLTt2TW7AVHnNVHrMQ2S6MDdnIiEuIR4rIR8rIiEqRC9BJyQyIB0n -ISAuIB4pLSk2SztJPCo5YEtUVU1lfWiCV1BgFhgoIiNAHB4yICE1ICE1KjFcMUaXKTqAKS1b -OE6kPFOuPVWwP1ewQFaxQ1y2SGC4S2S7VW/CWHPGZ4LRc47XhZ3gkKfnobDtoLDoprfvIB80 -Q12fTGOZSl6RSV2RRViIRViIRFKAO06BUHK0gLTweqvvfq/uToDMLECBKDNsKjp1Tmy9VnvP -UnbKP2O4SUp6HiApIiArHx0pICAqNCgyLSo7KCY0JCAuNC4+MSEzTTdHSDZGY0taaFFkGhoq -X1x1HBwpIydFHhwvHh4xHyE0HiE9KjmBJzZ4JyhLMkiePVOrP1WxPVWxPFavQ123R2C3TGa9 -V3LEWnfIZ4POdI7WhJ/kkqnqobLsprXsbHqpICE4Q1qZSV+VSl6VR1ySSFuLR1eGQlF/PEpz -P1iUe6nsa6Dpg7Xwap7iME+VKDNmKTZuTWu9UnbIVXfKPmK4Sk2LExgkISAnKCc3Hx8nJB8u -PS9BJCAuOC8/LSQxOCs7SzZFQjBAZk9bcV1uQzxQT1FtHR8kIyRBHyAzHh0vHyA2ICI3LDdx -KzZyKi1KMkSYPFGoPFKsP1WsQVmxQ1uzSWK6T2u+VnLCYn7NaofTc5LcgqDljqfon7HtpbLn -OTtaISM7Lz9vS1+TTWGYSl+URliKQlOEQ1ODRVOAN0l+QmatW4fNfq/sdafoUYDHJSxfJC1i -S2m6VXfLTXLGQl63bG2TJCE5JCExJCEwIB8wJyMzMCc4IB4rJiIuSThIMSQ0QzFAWURVZlNg -RTZHYl2DPTpLHR8mKCpHHB4uICAxIiM5Jic+KTFjIihdMDFZO0yYNkmYP1atQliuQViuRl20 -UGq/Vm/BYnzLY3/KaIjTdZXehKPoj6rpoLLsWl+DHR83IyZDPUh2S2CTS2CWR12SSFmKRliK -RlWFQk95QE13Mk6RPF2jfq/ue6zrZ5fYLUJ7JytTT23AUXLGTnLIQV61XWCRPEBpISErKykz -LSg8OzBJOi9DKiMuMio+SjtLMCIyRzRDalJgaFJZUVFwOi1FKChFHR4pJShFHRwuHh4wHyEz -Hh40JipRIiNBLTNiM0ONNkePPlGfQ1muQVesQ1qwT2a4WHLBZH/Jb4vTdJLYfZvgh6LkkKfj -eoCjIyc+HR46JCZIR1F3RVuTSl+SSVyPSFqNRFKCRVGAP0tzNj9pMUqHLkSBa5rcd6rqcaHh -TXK1ISE8UG3AU3LHVnTFU23AKipTQDxVIB8pJyQyLyU3KiQ0NCw/KyQyVkBQUz9NVkROSzlH -SjNAUz1STUJZOzFIICA+Hx8tISQ+Hx8wHx8zHh4wHyA1HyA/IyU+KC9gNkWMOkuYPE6bP1Sk -RFmsRlutR12uVW68cIjOe5XWgZvdh5/fi5/ZR01qIiE6IylIIyRFJSlNPkBhP1WTSlyORFeM -P058OUp/Mj5rLDVfKTBWMUBuKjNdV3m7b6TreKbnZJPXPlqZUG7AVHPFUHTHQFqqYWeUKiFD -JydEKSM1KSU4KyY0Ix8sVz1KXURPJyExb1RbUT1LZExRQz1RXlJrHx4rISE6Hx8yISQ7Hx8w -HR4wHh4xICE2HyA8HSA6KTJkNkWTOEmYPU+fPFKdSF2vT2OySV2pUmaxaoXEf5fVd4i5TVZ5 -ISEuHyAzISM5ICVEJihKISZIKypEQFKQOUl7MUF0M0B0LDloMTtmND9pO0VvQEhvQklrZYjI -canvb6Lmc6PkYYzTUW/BVXbIT3PIPFquIytXTERnNjlRKSE4KCQzKSM0IRwocVFPPTA+QTA/ -YUlRY0tdW1ByST1UHR4pHR4rICI3ISI2IiM6Hh0wHh4wHh40ICI5ICI9HiJDICRGICZTNT16 -N0aCOEqLTFusVmm7WGy7XG29XmqlMjdgHxw1ISAzIyI5ICE1IiM6LzVWJilLJCdGIyA9Qlyd -MD5qNkV3QEt/RlWDSlmFSluISlqFRlN6QUpvYHyzhLXyea3sdqfpcaLoUW/AVHbIUXTGPVqs -KC1gKipSLClGNi5GJB8tKCExKSEwc1RVRzRCZEhQWUJMX1J6KClaLjBUICAyIiAxIB8xICE2 -IiE4Hx40Hh8xJCY8IyQ8HiA6HyJGHyJLJzRxNEWZPVGmQVeuTGK3X3PGXG/AXnC/UGGqLThw -HR00IB8xHx83ICA5IiI5MTZbJytNHiE8IyM7WXCvRlmOTWKVTWGQT2GRS1+QT2GQTV2HR1WB -TFZ9T2WWksD3fLHvfrHwg7DuTm2/VHjMVHjMPVywIydaODZdNTBTLCU3JCAwLCcyKSMwmXJo -VT5CW0JSSjZGRj5iPT1me4rgISdKHx8uHyAxHB0xHh0zICEyHyA4IyQ+ICM+JCZGIipdLjl7 -MkKQOEyiQVWsRVqxSFyzTWK4VGq/VWy/T2OyQFOfIB42Hh4wHh8zHyA4HR41KzFSJypOJitF -IiM9W3GvSV6UUGicUGaYTGGUU2eXUGOUTFyKTVuIRlR+QVSBj7v2irv3h7TxhLDuUG/DVXnO -VnjNS2O2Ky9hPDtlOTxvKyg8NTBHOCo4KiMxVjpETztFRzlJUjVBR0BaKz6AYmGeSGGcHCA9 -HB4uHx8yHR4yHx82IyM+HyE6KClOIidQKzd7LTyIN0eaOU2oQFSsQFaxOk+pNUmfNkqjO0ul -QlSmR1ajLDl3Hh8xHBwxISE6HSA6JitHLjJVICJAJSZAVmypSWKgT2idTmWYTWScT2WbTmKS -TV2PSFqMR1aIRliHgrPzirn2irfxjLfyVXXGV3nMUXfLQletQUB0JylWS0iDMSxONSw9JiAt -OCs8SztFQjBAUz5MQzlKSTlKPlWjcX2zOUp6U1mGISExHx4wHyA4Hh80JilDHyA3JypPJzBo -LUGQM0WaOEynPlOvQlu3OVKxM0utN024Tlq/cnrQcXzPSVWrQFWdHyVJHR4xHB0wHyE8HCE6 -JSZLGx06JyhDR16aQ2GlTmmkTWScUGaeTGKYUWSXSluRTV6SSluOSV6TcqbthbTzgrHvh7Lv -UnPFUHPGUnfMPlyxJy9oRkJ4ODpyNy5OOi0+JyExLCczQDE+RDFBQzFDSzxLTjlHREB0hIGs -d32sKCpaNTZgHhwxIiRHISE4JidCHh41LjBbKjZ8N0mhNkqkPVKvQVezQFayLj+NLDiALz2O -LjuGJTaAP0upNEOXN0iQMkGGHh8yICA0HR02HSA8ISRGHiI7NTpZOkyAQ2CoTmilTmWfTGGZ -T2KXTF6SSl2TSV+VS12TRViMYJThgbLwfq3sfq/uTm7DVHTKVXnNP12wJy1iJypcQ0F/PjVY -Tz1NKCQyKyMzLCQzNys7Pi8+XUJYRkdqHR0uODhVWVyDTmKcR1GHHitRJiRBHyA2JydCGxw1 -LTJlLT2MOEukPE6rPlGyPlS0Q1i1Rly5SV22RluxT2O6WW/Ic4zceILPU2W1RU6aIChMGxwx -HB0yJCZHIyZGISM+OT5lPkRzRWClTWajUGafT2OcTmCYTGCYUGKYSl6WR1uTRFaMVonVc6fu -fa3udqnqTm3DUXLIU3bPRF+zJy1gJitfNjdyOjNeLig6PzJCJB4tQS9BUTlIaE1XWEBPLic5 -IixTKSc2NzZMWl6COURyTWGXHhwuHiAzIB83Hxw0KDBsMECSNEiiOUuoQlW1QVe2SV+9UGXA -VGrDUGW7SmC0Vmq8d4TQiZnaWW68RFSkMTqAHh80HR4xJidLHB4+IyQ/Uld+VVuFP1iaTWSg -TGWhTmOeTmObSmCYTmGZS1+XTF6TRFeHVoTOYZnleq3ve6rtTm7DUnTITnPIPFiuLCpkKy1l -Nzt2PTVjNSo8RTlTSjlJNSo5RS45WUNUUUNHHx4uHjFIKyYzMDBWLChEKTFPSF2ZbXSVIR81 -Hx8yIx02MjpyKzyLOkymPU+tQ1e2SF26TmPCUGXCUmi/S2G2OU+kOk6nOEqYZXK8W3G9RFem -OEeVISNGHx8yISNAHR8+ISM4U1qJQkZrO0uCRmCgT2ikTWOfUWWcSl6WSV2TS16WSluSQ1eI -T3a+X5fmZ5/oeqvtUHDGUnXJUnbON1OoLC9ePjx3NjduNS5hNyk8SzdLMyQzNy9AVz1JWkRP -JiEzHx4uIyMzHiIvMD+GJylHIyMxVGWNQVOEPklzHh8wJCE5IildLD2JN0mkQlSxRFm4SF69 -TWO/UGfBUmm/PVOpPFGoNkqgNEimUmnCeI3TRlurPU6eKTV0Hh4zIiQ8ICFBIyQ3V2OYNTdX -MzlbQFmaUWilT2aiUGWdTGGaSl6VSF6XTV+VSluTSmahYJfkXpXjbaHnUW/CTnHFTnHJN1Kr -JipdODtvU015SkRwPzVLRDJRNSo3TjpGYEJKSTpWIBwtIB8rIyEvLzhlLzZqSkmDKSVIGh8o -MUiDh5O/IiVHISM2IydWMD+OOEukP1KvTWPBUWfGUmnDV27HVWvDP1awNkmgNkuiOU+nY3LH -sLnqTGKxQ1WlL0GNHiFBICA7JCdIHiA5Y3GkIyQ/ISI8QFeWT2mnTWemSmOgSmGcT2SfSl+Y -SFqQRlmPSFuPXo3VW5XkXpfjUHHFU3XITHHHOFOuJShaMDRlNDV4U0+FSDxLQzpUPTFEKx8s -SzdDNCczIx0vHh8rIB0rLCs/JyQ7OztoPUuHHR0sKjViZnKpcXuiICAwJCpVKz2OPU+pRVi0 -S1++VGrIYXfQYXjQXHPKSWC7QFSsOU2mPVOugI3WipPOUGW0SFirNkeUJStcHR03JylJLS5J -VmWbHiA1IiM3QFCISWGbTmqrUWilTWSgTWKeTF+YTF6WS12URVaLUm6rXpbjWpPkT3HFU3bL -UHTJOlWrJy5gJy5mND+CRUB/RDhSLiM2KyU2PS9BPik7QDJFHh0qHh8sIyEvHRwsJiQxOj1q -ISY6Hx0uIx4vPUuHaYK/SEp7ISRRMEGVOU2nSFu4U2fCXHLMaXvRZXzOX3XJTWS7Sl62PlOt -RViwmZ3ggpLRV2q5SFisOEmaJzBwIiI/IiFBQEFiTFKDIiE1IiE2NT5kR1qSUWqnTmaiTGOf -SmGcS2CbTWGZS1+VSVuSRFWKV4HIXJblUXPIU3nPVHjPOlaqKC1hJjBpKjZ6VFCFX1V2SDln -MSU6JSExSDpLRjFELCE1JCIuOys6V0FNPjRJMTBLJSM3Hx4vHx4wMTReU2OghJPDKzZnMUGN -P1KnSV21XXDHZXjOZ3nLZ3vMZXjIU2e7RlmvPE+rRVeyp6rlgI/SVmm2QFKnOEaXKDJzHx8/ -IyFCPD9lPUFqIiE0IiE1LjBKQ1aNUmmnU2qmTWSjS2CbTmSgTWCaSVySTF2VR1iMSFyQVoTK -TXHGVnrRUnjPPVmsKjBjKDJqLTyANkGMUlaJQkJoNStMJyM5JyIwVT5KVj5LKyc0NSs4Pi8+ -YUdWMCtBHx0tHx8vIB8xHh4uQEqCa4LAe43FKDmCPEueSl6yU2S5UmW5UWC2Wmq1W27AW2u5 -RFSmPU6oT2K8qq7pdILATF6rO0iYLDZ4Ji9nHx8+JSVCPkRpOTxgISA0IiE1Hx4zRlaJTmSf -T2elTWWjTmWiTGOfTWKdTWScTWKXR1uPR1eKTWKUUHTKU3nPT3LHN1GlJixcKjRtKTZ0PEyJ -KipRNDVRV1eYaHeoNS5ZNTFBNCY5MCc4LyMzUztJQzJCJSAzICAvIR4vICAxHx8wJzBXWmeb -cX+3eIG3NkWTQlCgR1epNUKMPkmNWF6eX2GnUVyyOUqaOk2kUGW7rbLtSVSQR1CUU1COJC1g -HiNKHh46JSQ/SUptNzlfIiA2Hx8wJSU5PENuRliPVGupUmmnTmWhUGeiT2SgS2KeUGWfTF+a -S12SR1iMTnLIUnfKS23BNU6fJSdTJSxhJzJxKjZ2LjVvJi9kX2+pQ2GxQlekJy9XJCMtMCY5 -Lik7QDE+Nig8IB4rHBwqOzRDHxwuICMyIyM0MDphZHCegY2+cYC3NUWNLDNfKCtUKypLRkNd -l5nOOUOMMD+KOUugUWi9mKXhM0KCKCpGNzZYQUqIHR83HB4zJyVAT1FyJiVHJiY8Hx4xIiI2 -LC1KRliST2ikTmelUGWgTGShTWOjTWSjTmOgTWSgS2CVSVuQT3HEU3fMTG7CNU6fKCpUKC1f -KTJqKzZ1Kjd2JzRyVl6RQFOdRV6uNUN8MTJsKCQwPCtHOCo+Tz1SJCAvMio7HhwvMSo3RTdH -HRwwKSc+TF6ZXHi4iZK+anOxIzBoIiNEHR83JCQ6NzdVJixUOU2hPFCqU2zEgJDabYDEIidS -ISA5KitIHiA5HyA6IiI3Q0ZxJydHKSc/IB8zICA0IyA1Q1SLSl6WT2enTmalS2SjTGWlSWOi -S2SfSmObTGObS2CWTnDEUnTIUHXKNk2dKSpUJSpYKTNqKDNxJzNyKjZ2KjiANUONP1ahOUeK -LzJTMD9+ICY/PjFDMyY3RDJEICAtISAxLyU5Hx8uMSg7KiU9KjBRZ3WxdIW9cYG0aHqxOkyM -NkWPOkmOQUyYKzV7LTd5S2K5WnPLdYvaeIrXW3HBMT55JSxeKjZyJSdLJCE5Sk16JiZBJyY7 -IB8zIiE0IiE1PkZxR1WITmmoTmenUGimTWWjS2OeUGijTWWfTWWaTmKYUXDCUHPGTm/EM0qX -KClSJipbKzZsKTRzKjRyKjd4Lj2BNkaNMUCPMkaGKjJhdXurNEOCLytLLSY6SDVEIiAvJSI4 -JSQ1Hh8vLio5LSY8KCU4NkR+UGmmbH+3Z3WshpK5T1+lOEWCPEWBRlabZnjLZn7UZ3/UeI/b -d43ZhJjiepLhVmiyLDJqHh02JyY/VFmIHB00IiE2IiI3Hx8xIiA0MDBMQVCFT2ahT2ioUWql -T2afT2efUmqkUWWdT2WcUWaZUXLGUXPDUHHENUqWKChUJipZKzRsKjVxLDZ3LDh6Lz2BNEOR -MEOWMUaLMEN5MD+JSkiAQ0J6JiQ2Nis7JCAwKSQ3LCU6IB4vIhwtLSQ5JiExIyQtNj95XW6s -X3azgY29bnynZXSyWmy7XXDBZnnMaYDUdYvbh5vkh5njjJzil6fpj53hNEaQIiU9JCQ8TlWD -HyA3IiI3JiQ4ISE0IB4yJSI1Q1CESFmRVG6rUmukU2ujUmylVGujUmecTmGTTFuJTnDET3HE -T2/EOE2aKCZTJitcJzBqKDNvJzJxKTN1NEGKMj2FNEOQMkCDUXK4M0KGP0mMRE+XMjZ4KiM8 -IB8tLSU6JyM1IB8wJCM2JCAxRTdMQThMJzFOUGGeZoC8cYO3ZGqThI+9aHeuWGy1X3XGaH/S -fpLcip3jjaDklaPmmKbnfI7WLzh3ISA0KihEU1WFGhwvHyA1IyI2ICA0Hx8zIiE0OD9kSFqM -UWupU2ulU2idUGWbTmGWTl+PU2OWUF+STnDEUXTIS2zAN0yZJiNQKSxdLjdwJDFtLTZyKjV1 -MTl9Lz2GLzyDSV+cYYjXLzt7NkOFPkuSLjx9Ky1ZKCpJKSM5ISAwISAxLig9KyM4HR8vPTBB -ISAzKDFUS1mYYHe2b2yLc3+vbnyxaHWlX3CyZHfId4vWgpXbjJ7jlKXnl6jrX3TCJCpaIyM4 -SEZgREZsHh4xHh4yJiU4JSQ4Hh0vKig8LCk/RVSHTmGWUGOcUGCWUWObUWWdU2iiVWqlV2ul -UHHGUnTISWrANEmXJidKIyZWKDBnKzRvJzJsJjFvLzt9MT6FMD19XXCtb53pNU6SPEiEOUSF -PkaNOkydMTVrLy1RJiQ3Kyc6MSpBKSU2Myg7PjFEICAxISA1LCtESEl2fICVbX+3doS0Y3Kn -dICxYnKqbH29gZTajp3hipfbhJXaRFimJCpNLy5MR0ZnPEV2ICAvHBsuIyI2JCI2Hh0wISAx -JSIzQElyRlJ8UWWbV22pVm+rV22nUmekVW2qUmekT3HDUXPGSGm/N02ZJiZLKS5ZKjJoKTRu -JTFuJDFuKzl8Kzh5LTp2dozFWoXNPVCXOkeJQEiGPEaDVU18S06LPD1yNjBYNi1JKyQ7IiAw -NCpDIh40JiI6Jh81Mig8U0BUW1V0bXigdoe8c4O1bnyxcH+zcH+veYe3hJDQhJPZfI3PNUKL -LS1cPDtZT09zQFSYHh0xHB0tIyM2ISE1Hx8yIyMzJCI2MC9LPkhzUGKZWHCrWG+pVm6pVGqn -WW+oVGqlT3HDTHHERWe8MEWQJSZLKCtcJzBlKjRtKjRuKTRwKjl7KTd2P1mNaazyVXe+SmCi -O0uMPkuMOUSFRE2KQ0uPPkabMDJgLSlJKyE3KCM3KCU7HR0tMyxKKyk+QTFKLyU8QjdKVlV/ -d4i9fpLFdYW1dYOzan2wc4Cxfou5c4G2XGyrKCxVKipJSEZkSk14XHa+UG6uISlMHx8yIyI2 -Hx4yHyAxIyE0JyI2P0h0S1iOWHCrVWymVGqnVW2pVGmjUGajTXDDT3DCR2m9L0SNJyhMJSpa -KjNqJzJrKzVwLDdyJzV0KjVsZ3y6SX3lSGq7O1WmMzx5QlKXPU2UPkqJQ06WMjxzQk+SOkaO -PT9yMCg/MytDIyI1OzFDNClJNi1DPDBHKSU6SkFOOk6Lc4G1c4a8doW3eIe2dYa2eYi2e4y6 -iZa7XG6gPT5lPTpYWWSbTW6+VXO+Y3m/KjRWISA0ISE1ICAzISAyJCI0OTxeTVyXU2elV26p -V2unVGqmV2ulUmajTnHHTm/ESWq+L0SOKitRJy1cJy9iKjNvKzRuLDd0KjRyKjRshrPtYnzN -PlKsNEqMMj+CMjx4PE+WOUaIPEiMQU+VPk6PQlOcQESCQ0F8QDZXPTNWKiU8STdMRjZPT0Fe -MixBHiAyIx4wUlqQa3SrboXBh5bFhJLBe4y8gpHAi5fCj5jGjZjFbnSiMzdjLzVhO0l/T2Sh -Zn/CLTZXHx4yIiEzIB4xJiM4JiM3TFqXTV2bVWuoU2ilU2mlWWylUWWgT3LFT3HESWm/MkOM -JidNJyxaKzJlLjdxKTRtKTVxKjZ1MT5yUZPvZpHWOFWhO1ipOUWIOEF+OkV/O06TQVCXPEeK -QlGSRVScS1WdU1SaRkZ5QThlPTBSWVl4Yk1mSTtYQDRILCY+ISA9KyY+U1qDXm+tg5XHhpfJ -gI+/g5O/i5nEj5zHk5/MkpzJjZnQWWWXMDp0KTFYOkZ8Zn25P0RiISAzHx4xHx8zICAyO0Fq -SlqbVGmmUWipUWenUWWkT2KfTW/DTm/DQ2a8LkCIJylQJCpaKDFmKjNsLThtKTVwKTVyUVuO -cI7XPWzRQF+sNUykN0OFQE+aRk6NNkKFQ1ekRVSgRFGVRVaZTFqfSVeUUVSNVFCHSE6HY2uY -VleCTVaFWmepXWajZG2tS1CDUlWAYGukb4G9d4u9iZXGhpTCipbCjprFkJ7KlKDNlqLOlZ/I -mKbPVGWlND5vPUVweIvBHB8xHx4yIiEyJSQ5Kic/SluZT2CfUminUWepTGKgUGakS23BTGy/ -RGa6MUGLJyhQJy5fLDNqLDZwKDNqKDVxJjRwPD95WJPYP1e0PFm6MkaUKzl0PEmMQE+bQE6K -O0eKQVakQFKfSFObTV+ZUWWrUGSrYGq0am+yamukYHO8VmapX3SuXm+0XGyyXm6zZ3CpYXCu -XGmhaoCxdYbEhZPIfZPJhJG/jJjDkZzFk5/LlZ/In6fOiZTBXm6cT2GgaHOhQlByIR8yICAy -ICAzJCE1QENtS1ycVGilUmioU2qqUWWmUHDETnDCRWS4MUKHJyhQKC5fJzJrKDJuKDNsJjJv -Kzh5KDBqUpXuRGexN0+VMj+CMDl1NkOHNUGERFalVGCnO0yTUGGsS1mgUF+jWmasVGGjYnfB -YW6wZHSyYHK4ZG+yXHGwYHazaHizZ3i3doO+a3uybXywdH60cXuteZHDiY6/lKLMiZjHiJbD -jZrEk57Ik5zIoaTNany1X2ylU2GWXG2eIB8xISAzHx8wISA0LCpETFuXUV+aUmmnUWenUmeo -TG7CT3LHRme6L0CFJidPJSteKjJqKjVvJzFqKDRzJzR5KjVwUIjkN1esLj+EMDuAND19OEaE -O0aQPEmIRVunQVOgQlaVU2WvTF6dVWOqY3S5ZHW0aHq6XHO6bX+9anq9XXG2an+/aX3Fc4O/ -doW6gou9cH61aXu3c36ucXqncoCwe42/hJHDk6TPkqLQj5rGkJzJlp/KkaHNY3WtiZfCmqLN -IyQ7ISEzICAyIB8yJSI2ODldTV6fTmKfUmmsUWepS23BUHHER2e5MECFJidPJitdKzRqLTdx -KTNtKTVyKjd5LTp3aJbiN0+iLDh2Kzd5KzdxMj18NkKJOEWLPk2PSF2pR1mhSVyeUmmyXXKx -Wm+3b3a0aHq2ZnK4ZHe/eITJYHy9eYjAbYTDaX65g4zCfYzAgou5hY3Ag5C+h466gomxlJTA -cYK+g5jOk5jOkqPQkaDJk5/Im6TOkZ7Jm6PKr6/VWWOIIyM1HR4wICAyIyE1KCc+R1CGTF2c -UmmnT2WoSWm7Tm7AQ2G1LTuAKChPKS9dJjBoMDt2LDhzLjp5Kzl+Lj6CaHq7NkeRLDRsLjqA -NEB/OESKNUWDPUuWMkCIOUiKUWWvS12nU2uvZna5aX2/bn+5cYXIg5LMbnq0donGfIzFe43H -jJbJpKXNdIe5eI27jZnJmKTRlJ/Ll5vEoqLHdoW5QWS8UmaxcoS9hpvJl6TNmqnSmKPPmKXQ -n6nPqK7TaGqFIiI0JCM1ISAzIB8zJSM3LCpFTF2cSVuXUGeoS2u8SGi6P1yuLz1/JiZIJChU -KTFmKzRuKjRxLjl2Kzh7MT+CT3K2OlWgKjVxMDt8KzdvN0WSNkaPMkGBOEmUNkiNOUSGY3Wv -XW+zWnG4a3zBcoLGeY3IZnu3kY/Ae4bAi5nMkJnQlaLVjJnNmKDQgZXCk6PPmKPLoafPqavQ -mJu9N1ShRmW6P2CyM0mRUE5yeYKojZi+o7Hal6bRkZzEqq/Ta3KhIB8xISE0IiEzHx8yIyI1 -IyI0PUJoTV6bTWGdSGm8TGq6P1ywLDp8KChIJilVKTFnKTBmKTJnKDNtKzZ2Ljp9R1SOPl2t -LjdyLzl5NkOBNUORPUqIOEyXN0OJPlCWQlGVOUh8YW+vYHm9bHq7dYG4Znq6fZXLbYe/nJzK -hZHAkprJlaPTlqHTj6LQl6XQoKzToKrQqK7TsrPQLDdsP1mnRWW4RGO0OFGcJCtWIyI1bnaN -jJq+srrWqrXbo63Tb3GUIB8xIB8yIB8yIB8yHx8vJiQ2JCM2SFWJSFiRSmm8Smi7QFywLjt9 -JSZJKy9eKjNnLjVsKTJsLDdzMDp8Mz+CMTp+T264Ljl3LTh4MT1/NUODO0eLOUqIQFGTSFyg -PFCTPEuOO0yTVl+UdIXGb3+5cYrGZH+9e4vIk5rIi5nLoqbXnKnWpavRm6bQpq/aoavToK7U -v77gaG+TLj55QFurRWK2Q1+wOU+bJCpXIyI3IiE0S0xkmajSoKvPubbOSk5zISEyIB4xISAz -Hh0vISAyIiEyIiE0KilBTFqVS2m8S2m6QFmqKjd8KSlNJypdKTFmKjNrKDJrKzZwMD19Lj2C -M0GKN0+UKzh6Ljt4ND2BN0CGNEJ+OEaLQ0+NSViqQVCVRFOaPk+dQlGUUVyccH6ydIfEgJbO -cIvJiJXLoabTm6zcoazUpq/Wn6nUoazUoqjQsLfblpy9MDNfLz5/P1mpRWCwQl2tO1GdJixZ -IyE2ISM7KzduO1KjQFWgPlehOE+cIB80Hh4vIB8zISA0Hh4uIR8zHx4xJCM0MjNSTGzASme5 -QF2vLTl9JidLJi5ZKTFlKDFrKzRtLDVxMz58M0KGMUCIMkKMM0SMLj19NUKBMkGFOUSFN0SF -PEuFPU+WQ1SWRlOXQ1mjRleUSV+nVm2qcX2xfpHHkaLRmKTTiZbHmp/Noa3dmaHLo67XpbLd -pLHVl6DANDljJi5eM0WKQl2uRGGzRmCwOlGcJStYISA1Ji5bO0+bQV2xO1SkOlWnQFqpLz96 -HR0vHh4vISA0ISAyHyEwHh0wIiM1Kyk6RGi+SGi7PluuLTt9JSdMKS5hLDNnLDVvKTVtLTdy -NEB+NUSJNEOPNUaOOUmRM0KGMj97NUKDN0OANkF5N0OAOEiIQ1KNQFSbQlWdSVmeTl2dVm2r -c4K/eICyl5vDmKTTr7Dcpq3ZoKvSo67XoarUt7rakZnAJCpVJS5eKzRqNkeNQFuvRmK2QFyu -NUybJSpVIiREM0KEQ1ytP1qsPlelPVanPVeqQlquIylOHR0sIB8yIiI0Hx8vISEzICEvIiE0 -Sm7BS2i9PVuwLDp/JidNLDJjKjFlKzVsKjRuKTRsMT9/MUCFMUKKNkWMNEePMkaRLDp+MD16 -OUaGP0qRPkyMOEaKQE6URFaUQUiDSlqiTV6hXHOzcYW8d4u+bIS/jZXEoanTqbHcpq7YoK3X -oK/boKjHKDFeLThvMDlwKjRtPE2TQF6yRGK3QF2xO1GeJClYLDRtPVOhQlywPlmsOlOkQFur -OVWlQlqsN1ChIR84Hh4tHyAxHx4yHh0tIB8zHB0rTHDDS2y9PF2vMD2CJihNKS9fLDJlKzVn -JTBnKzVyLzt8LDyBMkGGM0SLNUeQMkWSPlSeNEOBMz1/NkSBOkeLOUePOkmKQ1CVR1KWTl6i -TlmSXXGndoO8gpDCeI7Fh5fGgJPJgYu6kKPLqKvJsa/FSFN/LTl2Ljx4MDx6Lzl1NUiQQl6z -RGO5Ql+yNkuXLTt8Ok2YQVytP1yvPluvQVusP1mpO1apPlurPlusMUSHHR0tHx8tIiE0Hx4y -ICEvIB8xS23ARWe5P16xLDuAJShLIilXKjFmLTVsJjFsLTh0Lzt8NEGIN0WJNESLNUiTN0eT -NEiNOlGPPUiLPEWBPEaERFCOQEqMSVaUS1aTTGCUXmyzbnmuZ4K5dou5forAgJLGgZbMfpPB -h5nFWGOTLz17LDt6MkCBLTx6Ljp5MDt4M0aOQFutRmG1P1mnPVSfOlCbQVuqPlmrP1quPVuu -PlenO1akPliqPFmoQF2sQmCvN02QHyEwHR0vISA0HR4vHh8uS2/CS2vAPV6yMEGFJihQJy5f -KzNqKjVwKTVzMTx6MkCHMUCJNESPNUaPNEeSO0uXOUiZPEeYVFyWRFCMPkiHQE2DR1GKQ1eL -UmCgWGKsWWebZnusboO3dYW8gIzBe47IepHDcYGwRlGJMUCGNESLNEWNOEeLMT+DMD16MDx3 -OUySQVqqQFurOlalQVqnQFqqQVytPFemP1uvQFurPFikPlupO1akPVqpPFmmVHzLh7bzPVGP -ICAyHRwtICAzICAyTGy+R2i8QGC2LDuEKSxaLDVtLDdzKjVxLTh2NECDNEOLNUaQNkmTOUyY -NUaSOEuXO02cO0+cO0ucOkubQVCbSVeZVl2WSlmUV2GgaHKrbG6ocX2tb32tZnqwdYO2fJG+ -U2OWMEOML0GLM0aRNEaRN0eSNkeKM0OFLj9/MD18NkqUPlipPFalP1mnQlypQ1+wQ1+vQFus -QF2wQFysPVmnOlSkOFSkQFuoQGCve63xkb73VX7DIyM8HR8vIiIzISE0SWi8R2W5PVyzMT+D -JilYKDBqKzRyLTZyLjdzLDl7MD+HOEiROUmVPE6ZN0eVO0yZOEqeOEqcOEqbO06eOEqdNUqf -PE2aQFOXSFSVUmCbanOfdXuzX3atW2GeRFSONEOSMUaVM0qYN0uYOEmWOkyYOEuYN0mSM0WJ -M0KELzx7NkiQQFmmP1mnRV+tQmCwQ2O0Q2GxRWS3QWG0P16wPlqrOlenPlupPFupY5Lfibz4 -cqLjM0R7LTlwICE5Hx4xHh4wRmW6SGe6Pl2zLj2CJyxcKjJsKjRwLTh0LDRvLjh3NkOJMkCJ -N0aPMUWQNUiUO0yYOEuZNkmbO06gOkyeOUueMkebNEudN0ufNkuZMEWTMkeWMUSQNEaOMkOT -NkiXN0uaNkybNEqbN0yeNUqXMkeUOEyYN0mVMkSNMECELjt8M0aQPlaqQ1+vRmS0RWO2QmK2 -RGS3QmGzQ2O4QmK2P1yvPlusPlysT3bIhrf3iLn3QF2bKzhzMkF9M0B8ISM8Hh8vSmu+R2e6 -RWS6Lz+HKi9iJzFsKjV1JzNzKjRyMTl7NkONOEmTMkSPOEycO0+fOlCfOk2bOE2fOk+hOEqc -NkmbNkqbOE2hNkueN0qaNEaWNkiWNkqWPE2ZN0mWO06bNUqbNEqcN02fOE6fNUmaNUiWOk6a -NkqUM0OKMj+CMT5/O02aQ1ywR2a7RGS6SGe7RGe7R2a5R2W6SGi+RWe7QmK0P16vQWCwcKXu -j7/8YY7VLTt0L0B/NUaFOEqKMkKBIiQ/S26/SGm7RGO4Lj2CJy1eKzVyMTp5LTh1Ljh0MT18 -Lj2GN0iPNUmUOk+dOlGgO0+cPFCdOlCeOU+fPVGhPFGgO1CiN0yfOE2iNkudNUuaOU2bOk+b -OUyYOU+eOVCfOlGhN0+eOU+fNk2bOE2aOE6aN0yYNkuTOEmNMj9/MD1/Ok6ZR2O2SGjASm3C -S2vARmu/Q2S6SGi9R2e5RWS3Q2SyQmGvV4TTgrf5eazwNkyGMEJ+NUeEN0mIN0uJNkqLN0iM -TXHESm/DQGG2LT2AKC5eLTZvMDp3MDt2Lzt1MUB+M0SKO0qQOE6WPFKdOlOePFOfPVSiO1Og -PFSkPlOkO1KhO1KfN02dOE6fO1GhO1KhOlGfOVKgPFOePFWgOlOgOlKdOlGeOlGeOVKdOlGb -OVGaOFCZOE+UNEmMNkWDLjx6P1eiR2i5THC/SGzASW7DR2vAR2m9QmW5SGe3RmSyRWSzS3LA -dqvwgrf4RWqpLkB2N0eANkmFOUyGOk6GN0yHOE+S' - base64Decoded asByteArray readStream! ! + | methodNode oldVariable newVariable | + + oldVariable := 'old'. + + ClassBuilder reservedNames do: [ :reservedName | + newVariable := reservedName asString. + methodNode := self methodNodeOf: 'm1 |' , oldVariable , '| ^ ' , oldVariable. + + self + assertCreation: [ RenameTemporary from: oldVariable to: newVariable in: methodNode ] + failsWith: [ NewTemporaryPrecondition errorMessageForNewTemporaryVariableCanNotBeAReservedName: newVariable ] ]! ! + +!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/1/2018 16:43:08'! +test02ClassesWithNoReferencesAndNoSubclassesAreSafetelyRemoved -!TrieTest methodsFor: 'aux' stamp: 'jmv 6/21/2011 22:05'! -assert: subject isEquivalentToDictionary: controlGroup - "Test #size, #do:, " - | count subjectAsDictionary someRandomString | - self assert: subject isEmpty = controlGroup isEmpty. - self assert: subject size = controlGroup size. - controlGroup keysDo: [ :each | - self assert: (subject includesKey: each) ]. - subject keysDo: [ :each | - self assert: (controlGroup includesKey: each) ]. - controlGroup keysAndValuesDo: [ :k :v | - self assert: (subject at: k) = v ]. - subject keysAndValuesDo: [ :k :v | - self assert: (controlGroup at: k) = v ]. - someRandomString _ 'someRandomStringZZZ'. - self assert: (subject includesKey: someRandomString) - = (controlGroup includesKey: someRandomString). - subjectAsDictionary _ Dictionary new. - count _ 0. - subject keysAndValuesDo: [ :k :v | - subjectAsDictionary at: k put: v. - count _ count + 1 ]. - self assert: subjectAsDictionary size = controlGroup size. - self assert: count = controlGroup size. - self assert: subjectAsDictionary = controlGroup.! ! + | classToRemove safeRemove | + + classToRemove := self createClassNamed: self classToRemoveName. + safeRemove := SafelyRemoveClass of: classToRemove. + safeRemove apply. + + self assert: classToRemove isObsolete ! ! + +!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/1/2018 16:43:11'! +test03RemovingTheMetaclassRemovesTheClass + + | classToRemove safeRemove | + + classToRemove := self createClassNamed: self classToRemoveName. + safeRemove := SafelyRemoveClass of: classToRemove class. + safeRemove apply. + + self assert: classToRemove isObsolete ! ! + +!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 16:40:06'! +test04CanNotRemoveClassWithReferencesOutsideHierarchy + + | classToRemove classReferencing methodNameReferencingClass | + + classToRemove := self createClassNamed: self classToRemoveName. + classReferencing := self createClassNamed: #ClassReferencingClassToRemove. + methodNameReferencingClass := #m1. + classReferencing compile: methodNameReferencingClass asString, ' ^', classToRemove name asString. + + self + should: [ SafelyRemoveClass of: classToRemove ] + raise: self canNotRefactorDueToReferencesRefactoringError + withExceptionDo: [ :anError | | reference | + self + assert: (SafelyRemoveClass errorMessageForCanNotRemove: classToRemove dueToReferencesToAll: (Array with: classToRemove)) + equals: anError messageText. + self assert: 1 equals: anError numberOfReferences. + reference := anError anyReference. + self assert: classReferencing name equals: reference classSymbol. + self assert: methodNameReferencingClass equals: reference methodSymbol ]! ! + +!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/1/2018 16:43:21'! +test05CanRemoveClassWithReferencesFromItself + + | classToRemove methodNameReferencingClass remove | + + classToRemove := self createClassNamed: self classToRemoveName. + methodNameReferencingClass := #m1. + classToRemove compile: methodNameReferencingClass asString, ' ^', classToRemove name asString. + + remove := SafelyRemoveClass of: classToRemove. + remove apply. + + self assert: classToRemove isObsolete ! ! + +!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/1/2018 16:43:27'! +test06WarnIfClassToRemoveHasSubclasses + + | classToRemove classToRemoveSubclass | + + classToRemove := self createClassNamed: self classToRemoveName. + classToRemoveSubclass := self createClassNamed: 'ClassToRemoveSubclass' asSymbol subclassOf: classToRemove. + + self + assertCreation: [ SafelyRemoveClass of: classToRemove ] + warnsWith: [ SafelyRemoveClass warningMessageFor: classToRemove hasSubclasses: (Array with: classToRemoveSubclass) ]! ! + +!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/17/2018 16:38:44'! +test07CanNotRemoveClassWhenSubclassesHaveReferencesOutsideTheHierarchy + + | classToRemove classToRemoveSubclass classReferencing methodNameReferencingClass | + + classToRemove := self createClassNamed: self classToRemoveName. + classToRemoveSubclass := self createClassNamed: 'ClassToRemoveSubclass' asSymbol subclassOf: classToRemove. + classReferencing := self createClassNamed: #ClassReferencingClassToRemoveSubclass. + methodNameReferencingClass := #m1. + classReferencing compile: methodNameReferencingClass asString, ' ^', classToRemoveSubclass name asString. + + self + should: [ SafelyRemoveClass of: classToRemove ] + raise: self canNotRefactorDueToReferencesRefactoringError + withExceptionDo: [ :anError | | reference | + self + assert: (SafelyRemoveClass errorMessageForCanNotRemove: classToRemove dueToReferencesToAll: (Array with: classToRemoveSubclass)) + equals: anError messageText. + self assert: 1 equals: anError numberOfReferences. + reference := anError anyReference. + self assert: classReferencing name equals: reference classSymbol. + self assert: methodNameReferencingClass equals: reference methodSymbol ] +! ! + +!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/1/2018 16:47:12'! +test08HierarchyIsRemovedIfSubclassesWarningIsResumed + + | classToRemove classToRemoveSubclass | + + classToRemove := self createClassNamed: self classToRemoveName. + classToRemoveSubclass := self createClassNamed: 'ClassToRemoveSubclass' asSymbol subclassOf: classToRemove. + + self safelyRemoveHierarchyOf: classToRemove. + + self assert: classToRemove isObsolete. + self assert: classToRemoveSubclass isObsolete + + + ! ! + +!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 8/1/2018 16:47:17'! +test09CanRemoveIfReferencesToSubclassesAreInTheHierarchy + + | classToRemove classToRemoveSubclass | + + classToRemove := self createClassNamed: self classToRemoveName. + classToRemoveSubclass := self createClassNamed: 'ClassToRemoveSubclass' asSymbol subclassOf: classToRemove. + classToRemove compile: 'm1 ^', classToRemoveSubclass name asString. + classToRemoveSubclass compile: 'm2 ^', classToRemove name asString. + + self safelyRemoveHierarchyOf: classToRemove. + + self assert: classToRemove isObsolete. + self assert: classToRemoveSubclass isObsolete.! ! + +!SafelyRemoveClassTest methodsFor: 'tests' stamp: 'HAW 12/18/2019 16:04:18'! +test10WarnWhenHasReferencesToName + + | classToRemove classReferencing methodNameReferencingClass | + + classToRemove := self createClassNamed: self classToRemoveName. + classReferencing := self createClassNamed: #ClassReferencingClassToRemove. + methodNameReferencingClass := #m1. + classReferencing compile: methodNameReferencingClass asString, ' ^#', classToRemove name asString. + + self + should: [ SafelyRemoveClass of: classToRemove ] + raise: self referencesRefactoringWarning + withExceptionDo: [ :aWarning | | reference | + self + assert: (SafelyRemoveClass warningMessageForReferencesToNames: (Array with: classToRemove)) + equals: aWarning messageText. + self assert: 1 equals: aWarning numberOfReferences. + reference := aWarning anyReference. + self assert: classReferencing name equals: reference classSymbol. + self assert: methodNameReferencingClass equals: reference methodSymbol ]! ! + +!SafelyRemoveClassTest methodsFor: 'test support' stamp: 'HAW 8/1/2018 15:48:56'! +assertSubclassesReturnsACopy + + "This is a precondition for the remove to work properly with subclasses of the class to remove. + I do not put it in the refactoring to avoid innecesary checks and because tests verify preconditions. + It is not a seprate test because I do not want senders of this precondition to run if it fails - Hernan" + self deny: self class superclass subclasses == self class superclass subclasses! ! + +!SafelyRemoveClassTest methodsFor: 'test support' stamp: 'HAW 8/1/2018 16:47:22'! +safelyRemoveHierarchyOf: classToRemove + + | remove | + + "see comment of #assertSubclassesReturnsACopy - Hernan" + self assertSubclassesReturnsACopy. + + [ remove := SafelyRemoveClass of: classToRemove ] + on: self refactoringWarning + do: [ :aWarning | + self assert: (SafelyRemoveClass warningMessageFor: classToRemove hasSubclasses: classToRemove allSubclasses) equals: aWarning messageText. + aWarning resume ]. + + remove apply.! ! + +!SafelyRemoveClassTest methodsFor: 'class factory' stamp: 'HAW 7/11/2018 16:56:05'! +classToRemoveName + + "I can not use the symbol directly because it would be a reference - Hernan" + ^ 'ClassToRemove' asSymbol. + ! ! + +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:26:04'! +methodSourceCodeNamed: aSelector withTemporaryVariableDeclaration: aTemporaryVariableName + + ^aSelector, '| ', aTemporaryVariableName, ' |'.! ! + +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:31:12'! +methodSourceCodeNamed: aSelector withTemporaryVariableDeclarations: temporaryVariableNames + ^String streamContents: [ :stream | + stream nextPutAll: aSelector, '| '. + temporaryVariableNames do: [ :temporaryVariableName | + stream nextPutAll: temporaryVariableName, ' ' ]. + stream nextPut: $|. ].! ! + +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:26:04'! +test01ApplyChangesTemporaryVariableToInstanceVariable + + | variableName classToRefactor messageName refactoring sourceText methodNode changedMethodNode | + + classToRefactor _ self createClassNamed: self classToRefactorName. + messageName _ #m1. + variableName _ 'a'. + sourceText _ self methodSourceCodeNamed: messageName withTemporaryVariableDeclaration: variableName. + methodNode _ self compileMethodNodeIn: classToRefactor named: messageName sourceCode: sourceText. + + refactoring _ TemporaryToInstanceVariable named: variableName fromMethod: methodNode. + refactoring apply. + + self assert: (classToRefactor definesInstanceVariableNamed: variableName). + self assert: (classToRefactor canUnderstand: messageName). + + changedMethodNode _ self methodNodeIn: classToRefactor named: messageName. + self assert: 0 equals: changedMethodNode temporaries size.! ! + +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:26:04'! +test02ApplyDoesntChangeRestOfSourceCode + + | variableName classToRefactor messageName refactoring sourceText methodNode changedMethodNode restOfSourceCode | + + classToRefactor _ self createClassNamed: self classToRefactorName. + messageName _ #m1. + variableName _ 'a'. + sourceText _ self methodSourceCodeNamed: messageName withTemporaryVariableDeclaration: variableName. + restOfSourceCode _ variableName, ' := 2. + ^', variableName. + sourceText _ sourceText, restOfSourceCode. + methodNode _ self compileMethodNodeIn: classToRefactor named: messageName sourceCode: sourceText. + + refactoring _ TemporaryToInstanceVariable named: variableName fromMethod: methodNode. + refactoring apply. + + changedMethodNode _ self methodNodeIn: classToRefactor named: messageName. + self assert: (changedMethodNode sourceText findString: restOfSourceCode :: > 0).! ! + +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'HAW 5/19/2019 17:35:13'! +test03TemporaryToChangeShouldExist -!TrieTest methodsFor: 'aux' stamp: 'jmv 6/15/2011 09:58'! -assert: subject isEquivalentToSet: controlGroup - "Test #size, #do:, " - | count subjectAsSet someRandomString | - self assert: subject isEmpty = controlGroup isEmpty. - self assert: subject size = controlGroup size. - controlGroup do: [ :each | - self assert: (subject includes: each) ]. - someRandomString _ 'someRandomStringZZZ'. - self assert: (subject includes: someRandomString) - = (controlGroup includes: someRandomString). - subjectAsSet _ Set new. - count _ 0. - subject do: [ :element | - subjectAsSet add: element. - count _ count + 1 ]. - self assert: subjectAsSet size = controlGroup size. - self assert: count = controlGroup size. - self assert: subjectAsSet = controlGroup.! ! + | classToRefactor messageName methodNode sourceText | -!TrieTest methodsFor: 'aux' stamp: 'jmv 6/22/2011 12:51'! -assert: subject prefixSelection: aString isEquivalentToSet: controlGroup - | selection1 selection2 | - selection1 _ OrderedCollection new. - subject forPrefix: aString keysAndValuesDo: [ :k :v | - selection1 add: k ]. - selection2 _ (controlGroup select: [ :each | - aString isEmpty or: [ - each asLowercase asUnaccented beginsWith: aString asLowercase asUnaccented]]) asOrderedCollection - sort: [ :a :b | a asLowercase asUnaccented < b asLowercase asUnaccented ]. - self assert: selection1 = selection2.! ! + classToRefactor _ self createClassNamed: self classToRefactorName. + messageName _ #m1. + sourceText _ messageName. + methodNode _ self compileMethodNodeIn: classToRefactor named: messageName sourceCode: sourceText. + + self + should: [TemporaryToInstanceVariable named: 'a' fromMethod: methodNode] + raise: RefactoringError + withExceptionDo: [ :error | + self + assert: TemporaryToInstanceVariable inexistentTemporaryErrorDescription + equals: error messageText. + + self assertMethodNamed: messageName in: classToRefactor hasSourceEqualTo: sourceText ].! ! -!TrieTest methodsFor: 'testing' stamp: 'jmv 6/21/2011 22:14'! -testAllMesssagesLikeDicionary - " - TrieTest new testAllMesssagesLikeDicionary - " - | subject controlGroup allMessages copy c set1 set2 | - subject _ Trie new. - controlGroup _ Dictionary new. - allMessages _ Smalltalk allImplementedMessages. - c _ 0. - 3 timesRepeat: [ - allMessages do: [ :symbol | - subject at: symbol put: c. - controlGroup at: symbol put: c. - c _ c + 1 ]]. - self assert: subject isEquivalentToDictionary: controlGroup. +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:26:04'! +test04TemporaryShouldNotExistInOtherClassMethod - copy _ Dictionary new. - set1 _ Set new. - subject keysAndValuesDo: [ :symbol :number | - copy at: symbol put: number. - set1 add: number ]. + | classToRefactor firstMessageName firstMethodNode firstSourceText variableName secondMessageName secondSourceText | - set2 _ Set new. - subject do: [ :number | - set2 add: number ]. + classToRefactor _ self createClassNamed: self classToRefactorName. + variableName _ 'a'. + firstMessageName _ #m1. + firstSourceText _ self + methodSourceCodeNamed: firstMessageName + withTemporaryVariableDeclaration: variableName. + firstMethodNode _ self + compileMethodNodeIn: classToRefactor + named: firstMessageName + sourceCode: firstSourceText. + + secondMessageName _ #m2. + secondSourceText _ self + methodSourceCodeNamed: secondMessageName + withTemporaryVariableDeclaration: variableName. + classToRefactor compile: secondSourceText. + + self + should: [TemporaryToInstanceVariable named: variableName fromMethod: firstMethodNode] + raise: RefactoringError + withExceptionDo: [ :error | + self + assert: TemporaryToInstanceVariable temporaryExistsInOtherMethodsErrorDescription + equals: error messageText. + + self assertMethodNamed: firstMessageName in: classToRefactor hasSourceEqualTo: firstSourceText. + self assertMethodNamed: secondMessageName in: classToRefactor hasSourceEqualTo: secondSourceText ].! ! - self assert: subject isEquivalentToDictionary: copy. - self assert: copy isEquivalentToDictionary: controlGroup. - self assert: set1 = set2! ! +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:26:04'! +test05InstanceVariableShouldNotExistInSubclass -!TrieTest methodsFor: 'testing' stamp: 'jmv 6/21/2011 22:01'! -testAllMesssagesLikeSet - " - TrieTest new testAllMesssagesLikeSet - " - | subject controlGroup allMessages copy| - subject _ Trie new. - controlGroup _ Set new. - allMessages _ Smalltalk allImplementedMessages. - 3 timesRepeat: [ - allMessages do: [ :symbol | - subject add: symbol. - controlGroup add: symbol ]]. - self assert: subject isEquivalentToSet: controlGroup. + | classToRefactor messageName methodNode sourceText variableName subclassToRefactor | - copy _ Set new. - subject do: [ :symbol | - copy add: symbol ]. + variableName _ 'a'. + + classToRefactor _ self createClassNamed: self classToRefactorName. + subclassToRefactor _ self + createClassNamed: #SubclassToRefactor + subclassOf: classToRefactor + instanceVariableNames: variableName + classVariableNames: '' + poolDictionaries: '' + category: self classCategoryOfTestData. + + messageName _ #m1. + sourceText _ self + methodSourceCodeNamed: messageName + withTemporaryVariableDeclaration: variableName. + methodNode _ self + compileMethodNodeIn: classToRefactor + named: messageName + sourceCode: sourceText. - self assert: subject isEquivalentToSet: copy. - self assert: copy isEquivalentToSet: controlGroup.! ! + self + should: [TemporaryToInstanceVariable named: variableName fromMethod: methodNode] + raise: RefactoringError + withExceptionDo: [ :error | + self + assert: TemporaryToInstanceVariable temporaryExistsAsInstVarInSubclassesErrorDescription + equals: error messageText. + + self assertMethodNamed: messageName in: classToRefactor hasSourceEqualTo: sourceText. + self assert: (subclassToRefactor instVarNames includes: variableName) ].! ! -!TrieTest methodsFor: 'testing' stamp: 'HAW 6/12/2019 17:38:28'! -testIncludesReturnsFalseForObjectsThatAreNotString +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:26:04'! +test06TemporaryShouldNotExistInSubclassMethod + + | classToRefactor firstMessageName firstMethodNode firstSourceText variableName secondMessageName secondSourceText subclassToRefactor | + + classToRefactor _ self createClassNamed: self classToRefactorName. + subclassToRefactor _ self + createClassNamed: #SubclassToRefactor + subclassOf: classToRefactor + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: self classCategoryOfTestData. - self deny: ((Trie with: 'hello') includes: 1) - ! ! + variableName _ 'a'. + firstMessageName _ #m1. + firstSourceText _ self + methodSourceCodeNamed: firstMessageName + withTemporaryVariableDeclaration: variableName. + firstMethodNode _ self + compileMethodNodeIn: classToRefactor + named: firstMessageName + sourceCode: firstSourceText. + + secondMessageName _ #m2. + secondSourceText _ self + methodSourceCodeNamed: secondMessageName + withTemporaryVariableDeclaration: variableName. + subclassToRefactor compile: secondSourceText. + + self + should: [TemporaryToInstanceVariable named: variableName fromMethod: firstMethodNode] + raise: RefactoringError + withExceptionDo: [ :error | + self + assert: TemporaryToInstanceVariable temporaryExistsInOtherMethodsErrorDescription + equals: error messageText. + + self assertMethodNamed: firstMessageName in: classToRefactor hasSourceEqualTo: firstSourceText. + self assertMethodNamed: secondMessageName in: subclassToRefactor hasSourceEqualTo: secondSourceText ].! ! -!TrieTest methodsFor: 'testing' stamp: 'HAW 6/12/2019 17:38:51'! -testIncludesReturnsFalseForStringsNotIncluded +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/28/2019 19:13:24'! +test07RemovesPipesWhenRemovingLastTemporaryInMethod + + | variableName classToRefactor messageName refactoring sourceText methodNode | + classToRefactor _ self createClassNamed: self classToRefactorName. + messageName _ #m1. + variableName _ 'a'. + sourceText _ self methodSourceCodeNamed: messageName withTemporaryVariableDeclaration: variableName. + methodNode _ self compileMethodNodeIn: classToRefactor named: messageName sourceCode: sourceText. - self deny: ((Trie with: 'hello') includes: 'bye') - ! ! + refactoring _ TemporaryToInstanceVariable named: variableName fromMethod: methodNode. + refactoring apply. + + self assertMethodNamed: messageName in: classToRefactor hasSourceEqualTo: 'm1 '.! ! -!TrieTest methodsFor: 'testing' stamp: 'HAW 6/12/2019 17:39:09'! -testIncludesReturnsTrueForIncludedStrings +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/25/2019 00:30:25'! +test08DoesntRemoveOtherVariables + + | variableName classToRefactor messageName refactoring sourceText methodNode otherVariableName | + classToRefactor _ self createClassNamed: self classToRefactorName. + messageName _ #m1. + variableName _ 'a'. + otherVariableName _ 'b'. + sourceText _ self + methodSourceCodeNamed: messageName + withTemporaryVariableDeclarations: {variableName. otherVariableName}. + methodNode _ self compileMethodNodeIn: classToRefactor named: messageName sourceCode: sourceText. - self assert: ((Trie with: 'hello') includes: 'hello') - ! ! + refactoring _ TemporaryToInstanceVariable named: variableName fromMethod: methodNode. + refactoring apply. + + self assertMethodNamed: messageName in: classToRefactor hasSourceEqualTo: 'm1| b |'.! ! -!TrieTest methodsFor: 'testing' stamp: 'HAW 4/4/2019 08:18:55'! -testKeyNotFoundSignalTheRightMessage +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/28/2019 00:17:27'! +test09TemporaryShouldNotExistInOtherBlockInSameMethod + + | classToRefactor messageName methodNode sourceText variableName blockWithVariableString | + + classToRefactor _ self createClassNamed: self classToRefactorName. + + variableName _ 'a'. + messageName _ #m1. + blockWithVariableString _ '[ | ', variableName, ' | ].'. + sourceText _ messageName, ' + ', blockWithVariableString, ' + ', blockWithVariableString. + methodNode _ self + compileMethodNodeIn: classToRefactor + named: messageName + sourceCode: sourceText. + + self + should: [ TemporaryToInstanceVariable named: variableName fromMethod: methodNode ] + raise: RefactoringError + withExceptionDo: [ :error | + self + assert: TemporaryToInstanceVariable temporaryExistsInOtherBlockErrorDescription + equals: error messageText. + + self assertMethodNamed: messageName in: classToRefactor hasSourceEqualTo: sourceText. ].! ! - self - should: [ Trie new errorKeyNotFound ] - raise: Error - withMessageText: Dictionary keyNotFoundErrorDescription ! ! +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 5/28/2019 19:52:12'! +test10RemovesPipesWhenRemovingLastTemporaryInBlock -!TrieTest methodsFor: 'testing' stamp: 'jmv 6/22/2011 12:30'! -testPrefixIteration - " - TrieTest new testPrefixIteration - " - | subject controlGroup | - subject _ Trie new. - controlGroup _ Set new. + | classToRefactor messageName methodNode sourceText variableName blockWithVariableString newSourceCode refactoring | - self assert: subject prefixSelection: '' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'c' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'ca' isEquivalentToSet: controlGroup. + classToRefactor _ self createClassNamed: self classToRefactorName. + + variableName _ 'a'. + messageName _ #m1. + blockWithVariableString _ '[ | ', variableName, ' | ].'. + sourceText _ messageName, ' + ', blockWithVariableString. + methodNode _ self + compileMethodNodeIn: classToRefactor + named: messageName + sourceCode: sourceText. + refactoring _ TemporaryToInstanceVariable named: variableName fromMethod: methodNode. + refactoring apply. + + newSourceCode _ messageName, ' + [ ].'. + + self assertMethodNamed: messageName in: classToRefactor hasSourceEqualTo: newSourceCode.! ! - subject add: 'car'. - controlGroup add: 'car'. - subject add: 'car'. - controlGroup add: 'car'. - subject add: 'cat'. - controlGroup add: 'cat'. - subject add: 'cart'. - controlGroup add: 'cart'. +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 12/22/2019 18:18:26'! +test11TemporaryShouldNotExistAsArgumentInOtherBlocksInSameMethod - self assert: subject prefixSelection: '' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'c' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'ca' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'car' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'cat' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'cart' isEquivalentToSet: controlGroup. + | classToRefactor messageName methodNode sourceText variableName blockWithTempString blockWithArgumentString | - subject add: 'ñandú'. - controlGroup add: 'ñandú'. - subject add: 'ñandues'. - controlGroup add: 'ñandues'. - subject add: 'ÑANDÚSES'. - controlGroup add: 'ÑANDÚSES'. + classToRefactor _ self createClassNamed: self classToRefactorName. - self assert: subject prefixSelection: '' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'c' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'ca' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'car' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'cat' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'cart' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'ñ' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'ñan' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'ñandu' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'ñandú' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'Ñ' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'ÑANDÚ' isEquivalentToSet: controlGroup.! ! + variableName _ 'a'. + messageName _ #m1. + blockWithTempString _ '[ | ', variableName, ' | ].'. + blockWithArgumentString _ '[ :', variableName, ' | ].'. + sourceText _ messageName, ' ', blockWithTempString, ' ', blockWithArgumentString. + methodNode _ self + compileMethodNodeIn: classToRefactor + named: messageName + sourceCode: sourceText. + + self assertCreation: [ TemporaryToInstanceVariable named: variableName fromMethod: methodNode ] + failsWith: [ TemporaryToInstanceVariable temporaryExistsInOtherBlockErrorDescription ]. +! ! -!TrieTest methodsFor: 'testing' stamp: 'jmv 6/22/2011 12:50'! -testPrefixIteration2 - " - TrieTest new testPrefixIteration2 - " - | subject controlGroup allMsg toAvoid | - subject _ Trie new. - controlGroup _ Set new. +!TemporaryToInstanceVariableTest methodsFor: 'testing' stamp: 'EB 12/22/2019 18:38:40'! +test12CantExtractArgument - allMsg _ Smalltalk allImplementedMessages. - toAvoid _ (allMsg asArray collect: [ :each | each asLowercase asUnaccented ]) asBag. - allMsg do: [ :symbol | - (toAvoid occurrencesOf: symbol) = 1 ifTrue: [ - subject add: symbol. - controlGroup add: symbol ]]. + | classToRefactor methodNode sourceText | + + classToRefactor _ self createClassNamed: self classToRefactorName. - self assert: subject prefixSelection: '' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'a' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'at' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'at:' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'at:p' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'at:pu' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'at:put' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'at:put:' isEquivalentToSet: controlGroup. - self assert: subject prefixSelection: 'at:put:nonExistant:' isEquivalentToSet: controlGroup.! ! + sourceText := 'm1: a'. + methodNode _ self + compileMethodNodeIn: classToRefactor + named: #m1: + sourceCode: sourceText. + + self assertCreation: [ TemporaryToInstanceVariable named: 'a' fromMethod: methodNode ] + failsWith: [ TemporaryToInstanceVariable inexistentTemporaryErrorDescription ]. +! ! -!TrieTest methodsFor: 'testing' stamp: 'jmv 6/23/2011 11:02'! -testRemoveLikeDicionary - " - TrieTest new testRemoveLikeDicionary - " - | subject controlGroup allMessages copy c set1 set2 | - subject _ Trie new. - controlGroup _ Dictionary new. - allMessages _ Smalltalk allImplementedMessages. +!TemporaryToInstanceVariableTest methodsFor: 'assertions' stamp: 'HAW 5/19/2019 17:29:33'! +assertMethodNamed: aMethodName in: aClass hasSourceEqualTo: aSourceCode - subject at: 'doNotRemove' put: 'this'. - controlGroup at: 'doNotRemove' put: 'this'. - - c _ 0. - 3 timesRepeat: [ - allMessages do: [ :symbol | - subject at: symbol put: c. - controlGroup at: symbol put: c. - c _ c + 1 ]]. + | changedMethodNode | - subject at: 'doNotRemove2' put: 'this2'. - controlGroup at: 'doNotRemove2' put: 'this2'. + changedMethodNode _ self methodNodeIn: aClass named: aMethodName. + self assert: aSourceCode equals: changedMethodNode sourceText. + ! ! - self assert: subject isEquivalentToDictionary: controlGroup. - - allMessages do: [ :symbol | - subject removeKey: symbol. - controlGroup removeKey: symbol ]. +!TemporaryToInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 5/19/2019 17:29:44'! +classToRefactorName - copy _ Dictionary new. - set1 _ Set new. - subject keysAndValuesDo: [ :symbol :number | - copy at: symbol put: number. - set1 add: number ]. + ^ #ClassToChangeVariable.! ! - set2 _ Set new. - subject do: [ :number | - set2 add: number ]. +!TemporaryToInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 5/19/2019 17:31:47'! +compileMethodNodeIn: aClass named: aSelector sourceCode: sourceCode - self assert: subject isEquivalentToDictionary: copy. - self assert: copy isEquivalentToDictionary: controlGroup. - self assert: set1 = set2. - self assert: subject isEmpty = controlGroup isEmpty. + aClass compile: sourceCode. - subject removeKey: 'doNotRemove'. - controlGroup removeKey: 'doNotRemove'. + ^self methodNodeIn: aClass named: aSelector.! ! - self assert: subject isEquivalentToDictionary: controlGroup. - self deny: subject isEmpty. - self deny: controlGroup isEmpty. +!TemporaryToInstanceVariableTest methodsFor: 'class factory' stamp: 'HAW 5/19/2019 17:31:40'! +methodNodeIn: aClass named: aSelector - subject removeKey: 'doNotRemove2'. - controlGroup removeKey: 'doNotRemove2'. + ^ aClass compiledMethodAt: aSelector :: methodNode.! ! - self assert: subject isEquivalentToDictionary: controlGroup. - self assert: subject isEmpty. - self assert: controlGroup isEmpty.! ! +!TestValueWithinFix methodsFor: 'tests' stamp: 'jmv 4/17/2013 12:11'! +testValueWithinNonLocalReturnFixReal + "self run: #testValueWithinNonLocalReturnFixReal" + "The real test for the fix is just as obscure as the original problem" + | startTime | + self valueWithinNonLocalReturn. + startTime := Time localMillisecondClock. + [[] repeat] valueWithin: 100 milliSeconds onTimeout:[ | deltaTime | + "This *should* timeout after 100 msecs but the pending process from + the previous invokation will signal timeout after 20 msecs already + which will in turn cut this invokation short." + deltaTime := Time localMillisecondClock - startTime. + self deny: deltaTime < 90. + ]. +! ! -!TrieTest methodsFor: 'testing' stamp: 'jmv 6/22/2011 15:54'! -testRemoveLikeSet - " - TrieTest new testRemoveLikeSet - " - | subject controlGroup allMessages copy | - subject _ Trie new. - controlGroup _ Set new. - allMessages _ Smalltalk allImplementedMessages. +!TestValueWithinFix methodsFor: 'tests' stamp: 'ar 8/17/2007 13:38'! +testValueWithinNonLocalReturnFixSimply + "self run: #testValueWithinNonLocalReturnFixSimply" + "The simple version to test the fix" + self valueWithinNonLocalReturn. + self shouldnt:[(Delay forMilliseconds: 50) wait] raise: TimedOut.! ! - subject add: 'doNotRemove'. - controlGroup add: 'doNotRemove'. - - 3 timesRepeat: [ - allMessages do: [ :symbol | - subject add: symbol. - controlGroup add: symbol ]]. +!TestValueWithinFix methodsFor: 'tests' stamp: 'jmv 5/31/2022 16:44:39'! +testValueWithinTimingBasic + "Test timing of valueWithin:onTimeout:" + | time | + time := [ + [1000 milliSeconds asDelay wait] + valueWithin: 100 milliSeconds onTimeout: [] + ] durationToRun. + self assert: time < 200 milliSeconds.! ! - subject add: 'doNotRemove2'. - controlGroup add: 'doNotRemove2'. +!TestValueWithinFix methodsFor: 'tests' stamp: 'jmv 11/7/2019 18:18:10'! +testValueWithinTimingNestedInner + "Test nested timing of valueWithin:onTimeout:" + | time | + time := [ + [ + [5 seconds asDelay wait] + valueWithin: 100 milliSeconds onTimeout: [] + ] valueWithin: 500 milliSeconds onTimeout: [] + ] durationToRun. + self assert: time < 200 milliSeconds.! ! + +!TestValueWithinFix methodsFor: 'tests' stamp: 'ar 12/4/2012 20:35'! +testValueWithinTimingNestedOuter + "Test nested timing of valueWithin:onTimeout:" + | time | + time := [ + [ + 3 timesRepeat: [ + [5 seconds asDelay wait] + valueWithin: 100 milliSeconds onTimeout: []] + ] valueWithin: 150 milliSeconds onTimeout: [] + ] durationToRun. + self assert: time > 100 milliSeconds. + self assert: time < 200 milliSeconds. + ! ! - self assert: subject isEquivalentToSet: controlGroup. - - allMessages do: [ :symbol | - subject remove: symbol. - controlGroup remove: symbol ]. +!TestValueWithinFix methodsFor: 'tests' stamp: 'jmv 5/31/2022 16:45:10'! +testValueWithinTimingRepeat + "Test timing of valueWithin:onTimeout:" + | time | + time := [ + 3 timesRepeat: [ + [500 milliSeconds asDelay wait] + valueWithin: 100 milliSeconds onTimeout: []] + ] durationToRun. + self assert: time < 400 milliSeconds. +! ! - copy _ Set new. - subject do: [ :symbol | - copy add: symbol ]. +!TestValueWithinFix methodsFor: 'tests' stamp: 'ar 8/17/2007 13:37'! +valueWithinNonLocalReturn + "Do a non-local return from a valueWithin: block" + [^self] valueWithin: 20 milliSeconds onTimeout:[]. +! ! - self assert: subject isEquivalentToSet: copy. - self assert: copy isEquivalentToSet: controlGroup. +!BecomeTestExperiment methodsFor: 'as yet unclassified' stamp: 'jmv 1/11/2019 12:21:36'! +initialize + a _ 1. + b _ 2.! ! - subject remove: 'doNotRemove'. - controlGroup remove: 'doNotRemove'. +!BecomeTestExperiment methodsFor: 'as yet unclassified' stamp: 'jmv 1/29/2019 10:59:12'! +messStuffUp +"In a Workspace - self assert: subject isEquivalentToSet: controlGroup. - self deny: subject isEmpty. - self deny: controlGroup isEmpty. +BecomeTestExperiment twoVars. +e _ BecomeTestExperiment new. +e messStuffUp. - subject remove: 'doNotRemove2'. - controlGroup remove: 'doNotRemove2'. +e _ nil. Smalltalk garbageCollect. +BecomeTestExperiment allInstances - self assert: subject isEquivalentToSet: controlGroup. - self assert: subject isEmpty. - self assert: controlGroup isEmpty.! ! +Processor invalidMethodInStackDueToClass: BecomeTestExperiment +" -!TrieTest methodsFor: 'testing' stamp: 'jmv 6/22/2011 15:42'! -testSetProtocol - " - TrieTest new testSetProtocol - " - | subject controlGroup | - subject _ Trie new. - controlGroup _ Set new. - self assert: subject isEquivalentToSet: controlGroup. - - subject add: 'car'. - controlGroup add: 'car'. - self assert: subject isEquivalentToSet: controlGroup. + BecomeTestExperiment threeVars. "New ivar c is added before a and be" + ^a + b! ! - subject add: 'car'. - controlGroup add: 'car'. - self assert: subject isEquivalentToSet: controlGroup. +!BecomeTestExperiment methodsFor: 'as yet unclassified' stamp: 'jmv 1/29/2019 10:59:16'! +messStuffUpWBecome +"In a Workspace - subject add: 'cat'. - controlGroup add: 'cat'. - self assert: subject isEquivalentToSet: controlGroup. +BecomeTestExperiment twoVars. +e _ BecomeTestExperiment new. +e messStuffUpWBecome. - subject add: 'cart'. - controlGroup add: 'cart'. - self assert: subject isEquivalentToSet: controlGroup. +e _ nil. Smalltalk garbageCollect. +BecomeTestExperiment allInstances - subject add: 'ñandú'. - controlGroup add: 'ñandú'. - self assert: subject isEquivalentToSet: controlGroup. +Processor invalidMethodInStackDueToClass: BecomeTestExperiment +" - subject add: 'ñandu'. - controlGroup add: 'ñandu'. - self assert: subject isEquivalentToSet: controlGroup. + self becomeForward: {22}. + ^a + b! ! - subject add: 'ÑANDÚ'. - controlGroup add: 'ÑANDÚ'. - self assert: subject isEquivalentToSet: controlGroup.! ! +!BecomeTestExperiment class methodsFor: 'as yet unclassified' stamp: 'jmv 3/8/2019 11:37:17'! +threeVars -!TrieUnicodeTest methodsFor: 'testing' stamp: 'jmv 6/6/2022 11:47:11'! -test01 - | t all | - t _ Trie new. - t add: #toto. - t at: #toton put: 47. - t add: 'carrr'. - t at: 'car' put: Float pi. - t at: 'cat' put: Date today. - self assert: (t includesKey: 'car'). - self deny: (t includes: 'car'). - self assert: (t includesKey: 'cat'). - self deny: (t includes: 'cat'). - self assert: (t includes: #toto). - self assert: (t includes: 'toto'). - all _ Array streamContents: [ :strm | - t keysAndValuesDo: [ :k :v | strm nextPut: {k. k class. v. v class} ]]. - self assert: all size = 5. - self assert: (all includes: {#toto. Symbol. #toto. Symbol}). - self assert: (all includes: {#toton. Symbol. 47. SmallInteger}). - self assert: (all includes: {'carrr'. String. 'carrr'. String}). - self assert: (all includes: {'car'. String. Float pi. SmallFloat64}). - self assert: (all includes: {'cat'. String. Date today. Date}).! ! + Object subclass: #BecomeTestExperiment + instanceVariableNames: 'c a b' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Kernel'! ! -!TrieUnicodeTest methodsFor: 'testing' stamp: 'jmv 6/6/2022 12:13:02'! -test02 - | t all | - t _ Trie new. - t add: #toto. - t at: #toton put: 47. - t add: 'carrrs'. - t add: 'carrr' asUtf8String. - t at: 'car' asUtf8String put: Float pi. - t at: 'cat' put: Date today. - self assert: (t includesKey: 'carrrs'). - self assert: (t includes: 'carrrs'). - self assert: (t includesKey: 'carrrs' asUtf8String). - self assert: (t includes: 'carrrs' asUtf8String). - self assert: (t includesKey: 'carrr'). - self assert: (t includes: 'carrr'). - self assert: (t includesKey: 'carrr' asUtf8String). - self assert: (t includes: 'carrr' asUtf8String). - self assert: (t includesKey: 'car'). - self deny: (t includes: 'car'). - self assert: (t includesKey: 'cat'). - self deny: (t includes: 'cat'). - self assert: (t includes: #toto). - self assert: (t includes: 'toto'). - all _ Array streamContents: [ :strm | - t keysAndValuesDo: [ :k :v | strm nextPut: {k. k class. v. v class} ]]. - self assert: all size = 6. - self assert: (all includes: {#toto. Symbol. #toto. Symbol}). - self assert: (all includes: {#toton. Symbol. 47. SmallInteger}). - self assert: (all includes: {'carrrs'. String. 'carrrs'. String}). - self assert: (all includes: {'carrr'. Utf8String. 'carrr'. Utf8String}). - self assert: (all includes: {'car'. Utf8String. Float pi. SmallFloat64}). - self assert: (all includes: {'cat'. String. Date today. Date}).! ! +!BecomeTestExperiment class methodsFor: 'as yet unclassified' stamp: 'jmv 3/8/2019 11:37:22'! +twoVars -!TrieUnicodeTest methodsFor: 'testing' stamp: 'jmv 6/6/2022 12:09:17'! -test03 - | t all s1 s2 | - t _ Trie new. - s1 _ ('totoU', Random next mantissaPart printString) asUtf8String asSymbol. - t add: s1. - s2 _ ('totoUn', Random next mantissaPart printString) asUtf8String asSymbol. - t at: s2 put: 47. - t add: 'carrr' asUtf8String. - t at: 'car' put: Float pi. - t at: 'cat' asUtf8String put: Date today. - self assert: (t includesKey: 'car'). - self deny: (t includes: 'car'). - self assert: (t includesKey: 'cat'). - self deny: (t includes: 'cat'). - self assert: (t includes: s1). - self assert: (t includes: s1 asString). - all _ Array streamContents: [ :strm | - t keysAndValuesDo: [ :k :v | strm nextPut: {k. k class. v. v class} ]]. - self assert: all size = 5. - self assert: (all includes: {s1. Utf8Symbol. s1. Utf8Symbol}). - self assert: (all includes: {s2. Utf8Symbol. 47. SmallInteger}). - self assert: (all includes: {'carrr'. Utf8String. 'carrr'. Utf8String}). - self assert: (all includes: {'car'. String. Float pi. SmallFloat64}). - self assert: (all includes: {'cat'. Utf8String. Date today. Date}).! ! + Object subclass: #BecomeTestExperiment + instanceVariableNames: 'a b' + classVariableNames: '' + poolDictionaries: '' + category: 'BaseImageTests-Kernel'! ! !ExceptionTester methodsFor: 'accessing' stamp: 'dtl 6/1/2004 21:53'! basicANSISignaledExceptionTestSelectors @@ -29255,63 +30939,6 @@ wantsChangeSetLogging ^false! ! -!BecomeTestExperiment methodsFor: 'as yet unclassified' stamp: 'jmv 1/11/2019 12:21:36'! -initialize - a _ 1. - b _ 2.! ! - -!BecomeTestExperiment methodsFor: 'as yet unclassified' stamp: 'jmv 1/29/2019 10:59:12'! -messStuffUp -"In a Workspace - -BecomeTestExperiment twoVars. -e _ BecomeTestExperiment new. -e messStuffUp. - -e _ nil. Smalltalk garbageCollect. -BecomeTestExperiment allInstances - -Processor invalidMethodInStackDueToClass: BecomeTestExperiment -" - - BecomeTestExperiment threeVars. "New ivar c is added before a and be" - ^a + b! ! - -!BecomeTestExperiment methodsFor: 'as yet unclassified' stamp: 'jmv 1/29/2019 10:59:16'! -messStuffUpWBecome -"In a Workspace - -BecomeTestExperiment twoVars. -e _ BecomeTestExperiment new. -e messStuffUpWBecome. - -e _ nil. Smalltalk garbageCollect. -BecomeTestExperiment allInstances - -Processor invalidMethodInStackDueToClass: BecomeTestExperiment -" - - self becomeForward: {22}. - ^a + b! ! - -!BecomeTestExperiment class methodsFor: 'as yet unclassified' stamp: 'jmv 3/8/2019 11:37:17'! -threeVars - - Object subclass: #BecomeTestExperiment - instanceVariableNames: 'c a b' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel'! ! - -!BecomeTestExperiment class methodsFor: 'as yet unclassified' stamp: 'jmv 3/8/2019 11:37:22'! -twoVars - - Object subclass: #BecomeTestExperiment - instanceVariableNames: 'a b' - classVariableNames: '' - poolDictionaries: '' - category: 'BaseImageTests-Kernel'! ! - !BoxedFloat64 methodsFor: '*BaseImageTests-Kernel-Numbers' stamp: 'jmv 2/25/2019 17:20:54'! primTestAdd: aNumber "Primitive. Answer the sum of the receiver and aNumber. Essential.