Patrick Rein uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-pre.410.mcz ==================== Summary ==================== Name: Tests-pre.410 Author: pre Time: 30 April 2019, 6:59:05.800906 pm UUID: d17c6b3c-0c13-2544-8c34-7f11ac74c762 Ancestors: Tests-eem.409 Recategorizes test methods and expected failure methods into tests and failures categories. =============== Diff against Tests-eem.409 =============== Item was changed: SystemOrganization addCategory: #'Tests-Bugs'! SystemOrganization addCategory: #'Tests-Compiler'! SystemOrganization addCategory: #'Tests-Dependencies'! SystemOrganization addCategory: #'Tests-Digital Signatures'! SystemOrganization addCategory: #'Tests-Environments'! SystemOrganization addCategory: #'Tests-Exceptions'! SystemOrganization addCategory: #'Tests-FilePackage'! SystemOrganization addCategory: #'Tests-Files'! SystemOrganization addCategory: #'Tests-Finalization'! SystemOrganization addCategory: #'Tests-Hex'! SystemOrganization addCategory: #'Tests-Installer-Core'! SystemOrganization addCategory: #'Tests-Localization'! SystemOrganization addCategory: #'Tests-Monticello'! SystemOrganization addCategory: #'Tests-Monticello-Mocks'! SystemOrganization addCategory: #'Tests-Monticello-Utils'! SystemOrganization addCategory: #'Tests-Object Events'! SystemOrganization addCategory: #'Tests-ObjectsAsMethods'! SystemOrganization addCategory: #'Tests-PrimCallController'! SystemOrganization addCategory: #'Tests-Release'! + SystemOrganization addCategory: #'Tests-System-Applications'! SystemOrganization addCategory: #'Tests-System-Digital Signatures'! SystemOrganization addCategory: #'Tests-System-Object Storage'! SystemOrganization addCategory: #'Tests-System-Preferences'! SystemOrganization addCategory: #'Tests-System-Support'! SystemOrganization addCategory: #'Tests-Utilities'! SystemOrganization addCategory: #'Tests-VM'! - SystemOrganization addCategory: #'Tests-System-Applications'! - SystemOrganization addCategory: #'Tests-MonticelloMocks'! Item was changed: + ----- Method: ArrayLiteralTest>>tearDown (in category 'running') ----- - ----- Method: ArrayLiteralTest>>tearDown (in category 'initialize-release') ----- tearDown self class removeSelector: #array! Item was changed: + ----- Method: BecomeTest>>testBecome (in category 'tests') ----- - ----- Method: BecomeTest>>testBecome (in category 'Testing') ----- testBecome "Test the two way become. Note. we cannot use string literals for this test" | a b c d | a := 'ab' copy. b := 'cd' copy. c := a. d := b. a become: b. self assert: a = 'cd'; assert: b = 'ab'; assert: c = 'cd'; assert: d = 'ab'. ! Item was changed: + ----- Method: BecomeTest>>testBecomeForward (in category 'tests') ----- - ----- Method: BecomeTest>>testBecomeForward (in category 'Testing') ----- testBecomeForward "Test the forward become." | a b c d | a := 'ab' copy. b := 'cd' copy. c := a. d := b. a becomeForward: b. self assert: a = 'cd'; assert: b = 'cd'; assert: c = 'cd'; assert: d = 'cd'. ! Item was changed: + ----- Method: BecomeTest>>testBecomeForwardDontCopyIdentityHash (in category 'tests') ----- - ----- Method: BecomeTest>>testBecomeForwardDontCopyIdentityHash (in category 'Testing') ----- testBecomeForwardDontCopyIdentityHash "Check that 1. the argument to becomeForward: is NOT modified to have the receiver's identity hash. 2. the receiver's identity hash is unchanged." | a b hb | a := 'ab' copy. b := 'cd' copy. hb := b identityHash. a becomeForward: b copyHash: false. self assert: a identityHash = hb; assert: b identityHash = hb. ! Item was changed: + ----- Method: BecomeTest>>testBecomeForwardHash (in category 'tests') ----- - ----- Method: BecomeTest>>testBecomeForwardHash (in category 'Testing') ----- testBecomeForwardHash | a b c hb | a := 'ab' copy. b := 'cd' copy. c := a. hb := b hash. a becomeForward: b. self assert: a hash = hb; assert: b hash = hb; assert: c hash = hb. ! Item was changed: + ----- Method: BecomeTest>>testBecomeForwardIdentityHash (in category 'tests') ----- - ----- Method: BecomeTest>>testBecomeForwardIdentityHash (in category 'Testing') ----- testBecomeForwardIdentityHash "Check that 1. the argument to becomeForward: is modified to have the receiver's identity hash. 2. the receiver's identity hash is unchanged." | a b ha | a := 'ab' copy. b := 'cd' copy. ha := a identityHash. a becomeForward: b. self assert: a identityHash = ha; assert: b identityHash = ha. ! Item was changed: + ----- Method: BecomeTest>>testBecomeHash (in category 'tests') ----- - ----- Method: BecomeTest>>testBecomeHash (in category 'Testing') ----- testBecomeHash | a b c d ha hb | a := 'ab' copy. b := 'cd' copy. c := a. d := b. ha := a hash. hb := b hash. a become: b. self assert: a hash = hb; assert: b hash = ha; assert: c hash = hb; assert: d hash = ha. ! Item was changed: + ----- Method: BecomeTest>>testBecomeIdentityHash (in category 'tests') ----- - ----- Method: BecomeTest>>testBecomeIdentityHash (in category 'Testing') ----- testBecomeIdentityHash | a b c d numberOfRetry newAIdentityHash newBIdentityHash oldAIdentityHash oldBIdentityHash | numberOfRetry := 0. [a := 'ab' copy. c := IdentitySet new: 1000. b := 'cd' copy. d := IdentitySet new: 1000. "Note: the sets are allocated with enough room to reduce probability that two different hash lead to same slot" "Note2: a & b creation are interleaved with c & d, because some VM allocate the same identityHash for two consecutively created objects" c add: a; add: b. d add: a. oldAIdentityHash := a identityHash. oldBIdentityHash := b identityHash. oldAIdentityHash = oldBIdentityHash and: [numberOfRetry < 10]] whileTrue: [numberOfRetry := numberOfRetry + 1]. self assert: oldAIdentityHash ~= oldBIdentityHash description: 'The VM is spawning too many equal identityHash to be honest'. a become: b. newAIdentityHash := a identityHash. newBIdentityHash := b identityHash. self "The set c & d can still retrieve their elements because elements did not change their expected position" assert: (c includes: a); assert: (c includes: b); assert: (d includes: a); deny: (d includes: b); "Elements didn't change their expected position because identityHash did not change" assert: oldAIdentityHash = newAIdentityHash; assert: oldBIdentityHash = newBIdentityHash! Item was changed: + ----- Method: BlockLocalTemporariesRemovalTest>>testBlockTemporaries (in category 'tests') ----- - ----- Method: BlockLocalTemporariesRemovalTest>>testBlockTemporaries (in category 'testing') ----- testBlockTemporaries | someCode someOtherCode | someCode := 'test | temp | [ | foo | ]'. someOtherCode := 'test | temp | [ ]'. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #('foo'). someCode := 'test [ | foo | ]'. someOtherCode := 'test [ ]'. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #('foo'). someCode := 'test | temp | [ | foo | ]'. someOtherCode := 'test [ ]'. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #('foo' 'temp').! Item was changed: + ----- Method: BlockLocalTemporariesRemovalTest>>testComplex (in category 'tests') ----- - ----- Method: BlockLocalTemporariesRemovalTest>>testComplex (in category 'testing') ----- testComplex | someCode someOtherCode | someCode := 'removeUnusedTemps: methodNode "Scan for unused temp names, and prompt the user about the prospect of removing each one found" | madeChanges tempsMarkHolder unusedTempNames tempMarkHoldersToChange encoder requestor| encoder := requestor := 1. madeChanges := false. tempMarkHoldersToChange := OrderedCollection new. tempsMarkHolder := self collectTemporaryDeclarationsFrom: methodNode. unusedTempNames := encoder unusedTempNames select: [ :temp | (encoder lookupVariable: temp ifAbsent: [ ]) isUndefTemp and: [ UnusedVariable name: temp ]]. tempsMarkHolder do: [ :currentBlock | || tempMarkHoldersToChange add: currentBlock. unusedTempNames do: [ :temp || someAdditionalTemps | (self removeUnusedTemporaryNamed: temp from: requestor text asString lookingAt: currentBlock movingTempMarksOf: tempMarkHoldersToChange) ifTrue: [ madeChanges := true ]]]. madeChanges ifTrue: [ self removeEmptyTempDeclarationsFrom: methodNode. ReparseAfterSourceEditing signal ]'. someOtherCode := 'removeUnusedTemps: methodNode "Scan for unused temp names, and prompt the user about the prospect of removing each one found" | madeChanges tempsMarkHolder unusedTempNames tempMarkHoldersToChange encoder requestor| encoder := requestor := 1. madeChanges := false. tempMarkHoldersToChange := OrderedCollection new. tempsMarkHolder := self collectTemporaryDeclarationsFrom: methodNode. unusedTempNames := encoder unusedTempNames select: [ :temp | (encoder lookupVariable: temp ifAbsent: [ ]) isUndefTemp and: [ UnusedVariable name: temp ]]. tempsMarkHolder do: [ :currentBlock | tempMarkHoldersToChange add: currentBlock. unusedTempNames do: [ :temp | (self removeUnusedTemporaryNamed: temp from: requestor text asString lookingAt: currentBlock movingTempMarksOf: tempMarkHoldersToChange) ifTrue: [ madeChanges := true ]]]. madeChanges ifTrue: [ self removeEmptyTempDeclarationsFrom: methodNode. ReparseAfterSourceEditing signal ]'. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #('someAdditionalTemps')! Item was changed: + ----- Method: BlockLocalTemporariesRemovalTest>>testRegression (in category 'tests') ----- - ----- Method: BlockLocalTemporariesRemovalTest>>testRegression (in category 'testing') ----- testRegression | someCode someOtherCode | someCode := 'test | temp |'. someOtherCode := 'test '. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #('temp'). someCode := 'test | temp |'. someOtherCode := 'test | temp |'. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #(). someCode := 'test | temp temptemp |'. someOtherCode := 'test | temp |'. self assert: someCode isChangedDuringParsingTo: someOtherCode withRemovalOfTemporariesNamed: #('temptemp'). ! Item was changed: + ----- Method: ClosureTests>>methodArgument: (in category 'tests') ----- - ----- Method: ClosureTests>>methodArgument: (in category 'testing') ----- methodArgument: anObject ^ [ anObject ] ! Item was changed: + ----- Method: ClosureTests>>testBlockArgument (in category 'tests') ----- - ----- Method: ClosureTests>>testBlockArgument (in category 'testing') ----- 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! Item was changed: + ----- Method: ClosureTests>>testBlockTemp (in category 'tests') ----- - ----- Method: ClosureTests>>testBlockTemp (in category 'testing') ----- 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! Item was changed: + ----- Method: ClosureTests>>testCopyNonLocalReturn (in category 'tests') ----- - ----- Method: ClosureTests>>testCopyNonLocalReturn (in category 'testing') ----- testCopyNonLocalReturn "This should not fail." self methodWithNonLocalReturn! Item was changed: + ----- Method: ClosureTests>>testIsClean (in category 'tests') ----- - ----- Method: ClosureTests>>testIsClean (in category 'testing') ----- testIsClean | local | local := #testIsClean. self assert: [] isClean. "closes over nothing at all" self assert: [:a :b| a < b] isClean. "accesses only arguments" self assert: [:a :b| | s | s := a + b. s even] isClean. "accesses only local variables" self deny: [^nil] isClean. "closes over home (^-return)" self deny: [self] isClean. "closes over the receiver" self deny: [collection] isClean. "closes over the receiver (to access the inst var collection)" self deny: [local] isClean. "closes over local variable of outer context"! Item was changed: + ----- Method: ClosureTests>>testMethodArgument (in category 'tests') ----- - ----- Method: ClosureTests>>testMethodArgument (in category 'testing') ----- testMethodArgument | temp block | temp := 0. block := [ [ temp ] ]. temp := 1. block := block value. temp := 2. self assert: block value = 2! Item was changed: + ----- Method: ClosureTests>>testMethodTemp (in category 'tests') ----- - ----- Method: ClosureTests>>testMethodTemp (in category 'testing') ----- testMethodTemp | block1 block2 | block1 := self methodArgument: 1. block2 := self methodArgument: 2. self assert: block1 value = 1. self assert: block2 value = 2! Item was changed: + ----- Method: ClosureTests>>testToDoArgument (in category 'tests - todo') ----- - ----- Method: ClosureTests>>testToDoArgument (in category 'testing-todo') ----- testToDoArgument 1 to: 5 do: [ :index | collection add: [ index ] ]. self assertValues: #(1 2 3 4 5)! Item was changed: + ----- Method: ClosureTests>>testToDoArgumentNotInlined (in category 'tests - todo') ----- - ----- Method: ClosureTests>>testToDoArgumentNotInlined (in category 'testing-todo') ----- testToDoArgumentNotInlined | block | block := [ :index | collection add: [ index ] ]. 1 to: 5 do: block. self assertValues: #(1 2 3 4 5)! Item was changed: + ----- Method: ClosureTests>>testToDoInsideTemp (in category 'tests - todo') ----- - ----- Method: ClosureTests>>testToDoInsideTemp (in category 'testing-todo') ----- testToDoInsideTemp 1 to: 5 do: [ :index | | temp | temp := index. collection add: [ temp ] ]. self assertValues: #(1 2 3 4 5)! Item was changed: + ----- Method: ClosureTests>>testToDoInsideTempNotInlined (in category 'tests - todo') ----- - ----- Method: ClosureTests>>testToDoInsideTempNotInlined (in category 'testing-todo') ----- testToDoInsideTempNotInlined | block | block := [ :index | | temp | temp := index. collection add: [ temp ] ]. 1 to: 5 do: block. self assertValues: #(1 2 3 4 5)! Item was changed: + ----- Method: ClosureTests>>testToDoOutsideTemp (in category 'tests - todo') ----- - ----- Method: ClosureTests>>testToDoOutsideTemp (in category 'testing-todo') ----- testToDoOutsideTemp | temp | 1 to: 5 do: [ :index | temp := index. collection add: [ temp ] ]. self assertValues: #(5 5 5 5 5)! Item was changed: + ----- Method: ClosureTests>>testToDoOutsideTempNotInlined (in category 'tests - todo') ----- - ----- Method: ClosureTests>>testToDoOutsideTempNotInlined (in category 'testing-todo') ----- testToDoOutsideTempNotInlined | block temp | block := [ :index | temp := index. collection add: [ temp ] ]. 1 to: 5 do: block. self assertValues: #(5 5 5 5 5)! Item was changed: + ----- Method: ClosureTests>>testWhileModificationAfter (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileModificationAfter (in category 'testing-while') ----- testWhileModificationAfter | index | index := 0. [ index < 5 ] whileTrue: [ collection add: [ index ]. index := index + 1 ]. self assertValues: #(5 5 5 5 5)! Item was changed: + ----- Method: ClosureTests>>testWhileModificationAfterNotInlined (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileModificationAfterNotInlined (in category 'testing-while') ----- testWhileModificationAfterNotInlined | index block | index := 0. block := [ collection add: [ index ]. index := index + 1 ]. [ index < 5 ] whileTrue: block. self assertValues: #(5 5 5 5 5)! Item was changed: + ----- Method: ClosureTests>>testWhileModificationBefore (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileModificationBefore (in category 'testing-while') ----- testWhileModificationBefore | index | index := 0. [ index < 5 ] whileTrue: [ index := index + 1. collection add: [ index ] ]. self assertValues: #(5 5 5 5 5)! Item was changed: + ----- Method: ClosureTests>>testWhileModificationBeforeNotInlined (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileModificationBeforeNotInlined (in category 'testing-while') ----- testWhileModificationBeforeNotInlined | index block | index := 0. block := [ index := index + 1. collection add: [ index ] ]. [ index < 5 ] whileTrue: block. self assertValues: #(5 5 5 5 5)! Item was changed: + ----- Method: ClosureTests>>testWhileWithTemp (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileWithTemp (in category 'testing-while') ----- testWhileWithTemp | index | index := 0. [ index < 5 ] whileTrue: [ | temp | temp := index := index + 1. collection add: [ temp ] ]. self assertValues: #(1 2 3 4 5)! Item was changed: + ----- Method: ClosureTests>>testWhileWithTempIsNil (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileWithTempIsNil (in category 'testing-while') ----- testWhileWithTempIsNil | index | index := 0. [ index < 5 ] whileTrue: [ | temp | collection add: temp. temp := index := index + 1. collection add: temp]. self assertValues: #(nil 1 nil 2 nil 3 nil 4 nil 5)! Item was changed: + ----- Method: ClosureTests>>testWhileWithTempNotInlined (in category 'tests - while') ----- - ----- Method: ClosureTests>>testWhileWithTempNotInlined (in category 'testing-while') ----- 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)! Item was changed: + ----- Method: CompilerNotifyingTest>>expectedFailures (in category 'failures') ----- - ----- Method: CompilerNotifyingTest>>expectedFailures (in category 'accessing') ----- expectedFailures "For these tests, the Compiler does not insert the notification where it would be most informative." ^#( "Notifying before the literal (which can be a message send) would be more informative" testTooManyLiterals "Notifying right before the 16th argument would be informative" testTooManyArguments "Notifying before the extraneous argument in the right block woul be useful" testifTrueBlockWithArgument testCaseOtherwiseBlockWithArgument )! Item was changed: + ----- Method: CompilerNotifyingTest>>setUp (in category 'running') ----- - ----- Method: CompilerNotifyingTest>>setUp (in category 'initialize-release') ----- setUp failure := Object new.! Item was changed: + ----- Method: CompilerNotifyingTest>>testATempShadowingAnotherTemp (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testATempShadowingAnotherTemp (in category 'testing') ----- testATempShadowingAnotherTemp self setUpForErrorsIn: '| x | x := 1. ^[ | ` Name already used in this method ->`x | x ]'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testAlltogether (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testAlltogether (in category 'testing') ----- testAlltogether "Initialize for all known error conditions. Note that the chunk to be evaluated are separated by %, and expected errors enclosed in back quotes." self setUpForErrorsIn: ' "First, the senders of #offEnd:" #` Unmatched bracket ->`[ 1 2 % #[ 1 2 ` 8-bit integer or right bracket expected ->`256 4]% $` A Character was expected ->`% 1+2 ` Unmatched comment quote ->`"unfinished comment% #` Unmatched parenthesis ->`( 1 2% #` Unmatched parenthesis ->`( 1 2 % ^nil printString , ` Unmatched string quote ->`''unfinished string% "Then, the senders of #expected:" 2r` a digit between 0 and 1 expected ->`3% | x | x := ` Expression expected ->`% [ :x : ` Argument name expected ->`1]% [ :x ` Vertical bar expected ->`x + 1 ]% [:x | 1 ` Period or right bracket expected ->`( 1 ) ]% { 1. 2` Period or right brace expected ->`% { 1. 2 ` Period or right brace expected ->`% { 1. 2 ` Period or right brace expected ->`3 % { 1. 2. ` Variable or expression or right brace expected ->`| x | % super yourself` Cascading not expected ->`; yourself% nil yourself; ` Cascade expected ->`^ 2% "#externalFunctionDeclaration is skipped, this cannot be evaluated" 1 to: ` Argument expected ->`:=% 1 +` Argument expected ->`% 1 + ` Argument expected ->`* 2 + 3% 1+(2 ` right parenthesis expected ->`. % 1 + 2 ` Nothing more expected ->`^nil% "#pattern:inContext: skipped, cannot be evaluated" "#pragmaLiteral: #pragmaSequence #pragmaStatement skipped, cannot be evaluated" ( ` expression expected ->`. 2 . )% ( 1 ` right parenthesis expected ->`. 2 . )% "#primitive:error: #primitive:module:error: skipped, cannot be evaluated" ^ ` Expression to return expected ->`. 1 + 2% [ ^1 ` End of block expected ->`2]% | x y ` Vertical bar expected ->`% [:z | | x y ` Vertical bar expected ->`]% 1` an integer greater than 1 as valid radix expected ->`r0'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testAssignmentOfSelf (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testAssignmentOfSelf (in category 'testing') ----- testAssignmentOfSelf self setUpForErrorsIn: '` Cannot store into ->`self := 1. ^self'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testCascadeInASuperSend (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testCascadeInASuperSend (in category 'testing') ----- testCascadeInASuperSend self setUpForErrorsIn: 'super yourself` Cascading not expected ->`; yourself'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testCaseOtherwiseBlockWithArgument (in category 'tests - block arguments') ----- - ----- Method: CompilerNotifyingTest>>testCaseOtherwiseBlockWithArgument (in category 'testing-block arguments') ----- testCaseOtherwiseBlockWithArgument self setUpForErrorsIn: 'nil caseOf: { [nil] -> [1] } otherwise: [:x` <- otherwise arg of caseOf:otherwise: has too many arguments ->` | 2 ]. ^nil '. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testDigitTooLargeForARadix (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testDigitTooLargeForARadix (in category 'testing') ----- testDigitTooLargeForARadix self setUpForErrorsIn: '2r` a digit between 0 and 1 expected ->`3'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testEmptyCaseStatement (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testEmptyCaseStatement (in category 'testing') ----- testEmptyCaseStatement self setUpForErrorsIn: '^ nil caseOf: { ` At least one case required ->`} '. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testExpectedExpressionInBraceArray (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testExpectedExpressionInBraceArray (in category 'testing') ----- testExpectedExpressionInBraceArray self setUpForErrorsIn: '{ 1. 2 ` Period or right brace expected ->`3 }'. self enumerateAllSelections. self setUpForErrorsIn: '{ 1. 2. ` Variable or expression or right brace expected ->`| x | x}'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testExtraneousStatementAfterAReturnInABlock (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testExtraneousStatementAfterAReturnInABlock (in category 'testing') ----- testExtraneousStatementAfterAReturnInABlock self setUpForErrorsIn: '[ ^1 ` End of block expected ->`2]'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testInvalidExternalFunctionDeclaration (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testInvalidExternalFunctionDeclaration (in category 'testing') ----- testInvalidExternalFunctionDeclaration "Not implemented yet. #externalFunctionDeclaration skipped, cannot be evaluated"! Item was changed: + ----- Method: CompilerNotifyingTest>>testInvalidLiteralCharacter (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testInvalidLiteralCharacter (in category 'testing') ----- testInvalidLiteralCharacter self setUpForErrorsIn: '^ #yourself , #` Invalid literal character ->`) , #end'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testInvalidPattern (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testInvalidPattern (in category 'testing') ----- testInvalidPattern "Not implemented yet. #pattern:inContext: skipped, cannot be evaluated"! Item was changed: + ----- Method: CompilerNotifyingTest>>testInvalidPragma (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testInvalidPragma (in category 'testing') ----- testInvalidPragma "Not implemented yet. #pragmaLiteral: #pragmaSequence #pragmaStatement #pragmaPrimitives skipped, cannot be evaluated"! Item was changed: + ----- Method: CompilerNotifyingTest>>testInvalidPrimitive (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testInvalidPrimitive (in category 'testing') ----- testInvalidPrimitive "Not implemented yet. ##primitive:error: #primitive:module:error: skipped, cannot be evaluated"! Item was changed: + ----- Method: CompilerNotifyingTest>>testInvalidRadix (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testInvalidRadix (in category 'testing') ----- testInvalidRadix self setUpForErrorsIn: '1` an integer greater than 1 as valid radix expected ->`r0'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testLiteralCharacterMissing (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testLiteralCharacterMissing (in category 'testing') ----- testLiteralCharacterMissing self setUpForErrorsIn: '$` A Character was expected ->`'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingArgumentAfterABinaryMessage (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingArgumentAfterABinaryMessage (in category 'testing') ----- testMissingArgumentAfterABinaryMessage self setUpForErrorsIn: '1 +` Argument expected ->`'. self enumerateAllSelections. self setUpForErrorsIn: '1 + ` Argument expected ->`* 2 + 3'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingArgumentAfterAMessageKey (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingArgumentAfterAMessageKey (in category 'testing') ----- testMissingArgumentAfterAMessageKey self setUpForErrorsIn: '1 to: ` Argument expected ->`:='. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingBlockArgumentName (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingBlockArgumentName (in category 'testing') ----- testMissingBlockArgumentName self setUpForErrorsIn: '[ :x : ` Argument name expected ->`1]'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingExpression (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingExpression (in category 'testing') ----- testMissingExpression self setUpForErrorsIn: '| x | x := ` Expression expected ->'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingExpressionAfterAReturn (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingExpressionAfterAReturn (in category 'testing') ----- testMissingExpressionAfterAReturn self setUpForErrorsIn: '^ ` Expression to return expected ->`. 1 + 2'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingMessageAfterACascade (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingMessageAfterACascade (in category 'testing') ----- testMissingMessageAfterACascade self setUpForErrorsIn: 'nil yourself; ` Cascade expected ->`^ 2'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingPeriodSeparatorBetweenStatements (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingPeriodSeparatorBetweenStatements (in category 'testing') ----- testMissingPeriodSeparatorBetweenStatements self setUpForErrorsIn: '1 + 2 ` Nothing more expected ->`^nil'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testMissingSeparatorBetweenBlockArgumentAndStatements (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testMissingSeparatorBetweenBlockArgumentAndStatements (in category 'testing') ----- testMissingSeparatorBetweenBlockArgumentAndStatements self setUpForErrorsIn: '[ :x ` Vertical bar expected ->`x + 1 ]'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testTempDoubledDefined (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testTempDoubledDefined (in category 'testing') ----- testTempDoubledDefined self setUpForErrorsIn: '| x ` Name already used in this method ->`x | x := 1. ^x'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testTooLargeAnIntegerInALiteralByteArray (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testTooLargeAnIntegerInALiteralByteArray (in category 'testing') ----- testTooLargeAnIntegerInALiteralByteArray self setUpForErrorsIn: '#[ 1 2 ` 8-bit integer or right bracket expected ->`256 4 5]'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testTooManyArguments (in category 'tests - byteCode limits') ----- - ----- Method: CompilerNotifyingTest>>testTooManyArguments (in category 'testing-byteCode limits') ----- testTooManyArguments self setUpForErrorsIn: '^[:x1 :x2 :x3 :x4 :x5 :x6 :x7 :x8 :x9 :x10 :x11 :x12 :x13 :x14 :x15 ` Too many arguments ->`:x16 :x17 | ]'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testTooManyLiterals (in category 'tests - byteCode limits') ----- - ----- Method: CompilerNotifyingTest>>testTooManyLiterals (in category 'testing-byteCode limits') ----- testTooManyLiterals self setUpForErrorsIn: '{#(1). #(2). #(3). #(4). #(5). #(6). #(7). #(8). #(9). #(10). #(11). #(12). #(13). #(14). #(15). #(16). #(17). #(18). #(19). #(20). #(21). #(22). #(23). #(24). #(25). #(26). #(27). #(28). #(29). #(30). #(31). #(32). #(33). #(34). #(35). #(36). #(37). #(38). #(39). #(40). #(41). #(42). #(43). #(44). #(45). #(46). #(47). #(48). #(49). #(50). #(51). #(52). #(53). #(54). #(55). #(56). #(57). #(58). #(59). #(60). #(61). #(62). #(63). #(64). #(65). #(66). #(67). #(68). #(69). #(70). #(71). #(72). #(73). #(74). #(75). #(76). #(77). #(78). #(79). #(80). #(81). #(82). #(83). #(84). #(85). #(86). #(87). #(88). #(89). #(90). #(91). #(92). #(93). #(94). #(95). #(96). #(97). #(98). #(99). #(100). #(101). #(102). #(103). #(104). #(105). #(106). #(107). #(108). #(109). #(110). #(111). #(112). #(113). #(114). #(115). #(116). #(117). #(118). #(119). #(120). #(121). #(122). #(123). #(124). #(125). #(126). #(127). #(128). #(129). #(130). #(131). #(132). #(133). #(134). #(135) . #(136). #(137). #(138). #(139). #(140). #(141). #(142). #(143). #(144). #(145). #(146). #(147). #(148). #(149). #(150). #(151). #(152). #(153). #(154). #(155). #(156). #(157). #(158). #(159). #(160). #(161). #(162). #(163). #(164). #(165). #(166). #(167). #(168). #(169). #(170). #(171). #(172). #(173). #(174). #(175). #(176). #(177). #(178). #(179). #(180). #(181). #(182). #(183). #(184). #(185). #(186). #(187). #(188). #(189). #(190). #(191). #(192). #(193). #(194). #(195). #(196). #(197). #(198). #(199). #(200). #(201). #(202). #(203). #(204). #(205). #(206). #(207). #(208). #(209). #(210). #(211). #(212). #(213). #(214). #(215). #(216). #(217). #(218). #(219). #(220). #(221). #(222). #(223). #(224). #(225). #(226). #(227). #(228). #(229). #(230). #(231). #(232). #(233). #(234). #(235). #(236). #(237). #(238). #(239). #(240). #(241). #(242). #(243). #(244). #(245). #(246). #(247). #(248). #(249). #(250). #(251). #(252). #(253). #(254). #(255). #(256). `More than 256 literals ref erenced. You must split or otherwise simplify this method. The 257th literal is: ->`#(257)}'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testTooManyTemporaries (in category 'tests - byteCode limits') ----- - ----- Method: CompilerNotifyingTest>>testTooManyTemporaries (in category 'testing-byteCode limits') ----- testTooManyTemporaries "Nope, with Closure Compiler, an Error is raised before the Encoder has a chance to notify"! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedBlockBracket (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedBlockBracket (in category 'testing') ----- testUnmatchedBlockBracket self setUpForErrorsIn: 'nil yourself. [` Period or right bracket expected ->`'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedBraceArray (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedBraceArray (in category 'testing') ----- testUnmatchedBraceArray self setUpForErrorsIn: '{ 1. 2` Period or right brace expected ->`'. self enumerateAllSelections. self setUpForErrorsIn: '{ 1. 2 ` Period or right brace expected ->`'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedByteArrayBracket (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedByteArrayBracket (in category 'testing') ----- testUnmatchedByteArrayBracket self setUpForErrorsIn: '#` Unmatched bracket ->`[ 1 2 '. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedCommentQuote (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedCommentQuote (in category 'testing') ----- testUnmatchedCommentQuote self setUpForErrorsIn: '1+2 ` Unmatched comment quote ->`"unfinished comment'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedExpressionParenthesis (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedExpressionParenthesis (in category 'testing') ----- testUnmatchedExpressionParenthesis self setUpForErrorsIn: '1+(2 ` right parenthesis expected ->`. '. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedLiteralParenthesis (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedLiteralParenthesis (in category 'testing') ----- testUnmatchedLiteralParenthesis self setUpForErrorsIn: '#` Unmatched parenthesis ->`( 1 2'. self enumerateAllSelections. self setUpForErrorsIn: '#` Unmatched parenthesis ->`( 1 2 '. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedLocalTempDeclaration (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedLocalTempDeclaration (in category 'testing') ----- testUnmatchedLocalTempDeclaration self setUpForErrorsIn: '| x y ` Vertical bar expected ->`'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedLocalTempDeclarationInABlock (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedLocalTempDeclarationInABlock (in category 'testing') ----- testUnmatchedLocalTempDeclarationInABlock self setUpForErrorsIn: '[:z | | x y ` Vertical bar expected ->`]'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerNotifyingTest>>testUnmatchedStringQuote (in category 'tests') ----- - ----- Method: CompilerNotifyingTest>>testUnmatchedStringQuote (in category 'testing') ----- testUnmatchedStringQuote self setUpForErrorsIn: '^nil printString , ` Unmatched string quote ->`''unfinished string'. self enumerateAllSelections! Item was changed: + ----- Method: CompilerNotifyingTest>>testifTrueBlockWithArgument (in category 'tests - block arguments') ----- - ----- Method: CompilerNotifyingTest>>testifTrueBlockWithArgument (in category 'testing-block arguments') ----- testifTrueBlockWithArgument self setUpForErrorsIn: 'true ifTrue: [:x` <- argument of ifTrue: has too many arguments ->` | 1 + 1 ]'. self enumerateAllSelections. self setUpForErrorsIn: 'true ifTrue: [:x` <- argument of ifTrue: has too many arguments ->` :y | 1 + 1 ]'. self enumerateAllSelections.! Item was changed: + ----- Method: CompilerTest>>testAllNodePCsAreForBytecodesInCollections (in category 'tests - debugging') ----- - ----- Method: CompilerTest>>testAllNodePCsAreForBytecodesInCollections (in category 'debugging') ----- testAllNodePCsAreForBytecodesInCollections <timeout: 30> "Approximately 2 seconds on 2018 2.9GHz Core i9 MacBook Pro running 64-bit Squeak Cog VM" self runTestAllNodePCsAreForBytecodesInPackage: #Collections! Item was changed: + ----- Method: CompilerTest>>testAllNodePCsAreForBytecodesInKernel (in category 'tests - debugging') ----- - ----- Method: CompilerTest>>testAllNodePCsAreForBytecodesInKernel (in category 'debugging') ----- testAllNodePCsAreForBytecodesInKernel <timeout: 30> "Approximately 3 seconds on 2018 2.9GHz Core i9 MacBook Pro running 64-bit Squeak Cog VM" self runTestAllNodePCsAreForBytecodesInPackage: #Kernel! Item was changed: + ----- Method: CompilerTest>>testAllNodePCsAreForBytecodesInMorphic (in category 'tests - debugging') ----- - ----- Method: CompilerTest>>testAllNodePCsAreForBytecodesInMorphic (in category 'debugging') ----- testAllNodePCsAreForBytecodesInMorphic <timeout: 30> "Approximately 6 seconds on 2018 2.9GHz Core i9 MacBook Pro running 64-bit Squeak Cog VM" self runTestAllNodePCsAreForBytecodesInPackage: #Morphic! Item was changed: + ----- Method: CompilerTest>>testBinarySelectorWithBar (in category 'tests - syntax') ----- - ----- Method: CompilerTest>>testBinarySelectorWithBar (in category 'syntax') ----- testBinarySelectorWithBar "Acknowledge the fact that $| is now allowed at any place in a binary selector" #(#'||' #'|||' #'|||++' #'<|>') do: [:selector | | source tree | source := ('1 ' , selector , ' 2') readStream. tree := (Compiler new) compileNoPattern: source in: Object notifying: nil ifFail: [nil]. self assert: tree notNil. "Hem, this test is really ugly..." self assert: tree block statements first expr selector key = selector].! Item was changed: + ----- Method: CompilerTest>>testBinarySelectorWithMinus (in category 'tests - syntax') ----- - ----- Method: CompilerTest>>testBinarySelectorWithMinus (in category 'syntax') ----- testBinarySelectorWithMinus "Acknowledge the fact that $- is now allowed at any place in a binary selector" | source tree | source := '1 @- 2' readStream. tree := (Compiler new) compileNoPattern: source in: Object notifying: nil ifFail: [nil]. self assert: tree notNil. "Hem, this test is really ugly..." self assert: tree block statements first expr selector key = #'@-'.! Item was changed: + ----- Method: CompilerTest>>testEmptyTemporaries (in category 'tests - syntax') ----- - ----- Method: CompilerTest>>testEmptyTemporaries (in category 'syntax') ----- testEmptyTemporaries self assert: (Compiler evaluate: '||') isNil! Item was changed: + ----- Method: CompilerTest>>testEvaluationOfInlinedToDo (in category 'tests') ----- - ----- Method: CompilerTest>>testEvaluationOfInlinedToDo (in category 'testing') ----- testEvaluationOfInlinedToDo "Whether inlined or not, #to:do: should return the same value" | inlinedResult notInlinedResult | inlinedResult := Compiler new evaluate: '1+1 to: 0 do: [:i | ]' in: nil to: nil notifying: nil ifFail: [^ #failedDoit]. notInlinedResult := Compiler new evaluate: '| aBlock | aBlock := [:i | ]. 1+1 to: 0 do: aBlock' in: nil to: nil notifying: nil ifFail: [^ #failedDoit]. self assert: inlinedResult = notInlinedResult. inlinedResult := Compiler new evaluate: '| stream results | stream := ReadStream on: #(2 1). results := OrderedCollection new. stream next to: stream next do: [ :i | results add: i ]. results' in: nil to: nil notifying: nil ifFail: [^ #failedDoit]. self assert: inlinedResult isEmpty. inlinedResult := Compiler new evaluate: '| stream results | stream := ReadStream on: #(1 2). results := OrderedCollection new. stream next to: stream next do: [ :i | results add: i ]. results' in: nil to: nil notifying: nil ifFail: [^ #failedDoit]. self assert: inlinedResult asArray = #(1 2)! Item was changed: + ----- Method: CompilerTest>>testInvalidVerticalBarSelector (in category 'tests - syntax') ----- - ----- Method: CompilerTest>>testInvalidVerticalBarSelector (in category 'syntax') ----- testInvalidVerticalBarSelector self should: [Compiler evaluate: '1 | | 2'] raise: SyntaxErrorNotification. self should: [Compiler evaluate: '1 | - 2'] raise: SyntaxErrorNotification.! Item was changed: + ----- Method: CompilerTest>>testLocalTemporariesInABlock (in category 'tests - syntax') ----- - ----- Method: CompilerTest>>testLocalTemporariesInABlock (in category 'syntax') ----- testLocalTemporariesInABlock self assert: ((Compiler evaluate: '[:x|| tmp | tmp := x]') value: 2) = 2! Item was changed: + ----- Method: CompilerTest>>testMaxLiterals (in category 'tests - limits') ----- - ----- Method: CompilerTest>>testMaxLiterals (in category 'limits') ----- testMaxLiterals "Document the maximum number of literals in a compiled method" | maxLiterals stringThatCanBeCompiled stringWithOneTooManyLiterals | "Why 6? It's rather implementation dependent. But the {... construct is compiled as (Array braceStream: size) nextPut: expr; ...; braceArray where nextPut: is a special selector. So one each for Array binding, #braceStream, #braceArray and the size, one for the selector and one for the methodClass makes 6." maxLiterals := CompiledCode preferredBytecodeSetEncoderClass new maxNumLiterals - 6. stringThatCanBeCompiled := '{ ', (String streamContents: [:strm | 1 to: maxLiterals do: [:e | strm nextPutAll: '''', e asString, '''', ' . ']]), '}'. stringWithOneTooManyLiterals := '{ ', (String streamContents: [:strm | 1 to: maxLiterals + 1 do: [:e | strm nextPutAll: '''', e asString, '''', ' . ']]), '}'. self assert: ((1 to: maxLiterals) collect: #printString) equals: (Compiler evaluate: stringThatCanBeCompiled). "If the following test fails, it means that the limit has been raised or eliminated, and this test should be updated to reflect the improvement." self should: [Compiler evaluate: stringWithOneTooManyLiterals] raise: Error. ! Item was changed: + ----- Method: CompilerTest>>testNegativeNumbers (in category 'tests - syntax') ----- - ----- Method: CompilerTest>>testNegativeNumbers (in category 'syntax') ----- testNegativeNumbers "Acknowledge the fact that (- 2) which was accepted up to Squeak 3.10 is not valid anymore" self assert: (Compiler evaluate: '-2') = 2 negated. self should: [Compiler evaluate: '- 2'] raise: SyntaxErrorNotification description: 'A negative number literal shall not include any separator'! Item was changed: + ----- Method: CompilerTest>>testNegativeZero (in category 'tests - literals') ----- - ----- Method: CompilerTest>>testNegativeZero (in category 'literals') ----- testNegativeZero self assert: (Compiler evaluate: '-0.0') hex = Float negativeZero hex.! Item was changed: + ----- Method: CompilerTest>>testScaledDecimalLiterals (in category 'tests - literals') ----- - ----- Method: CompilerTest>>testScaledDecimalLiterals (in category 'literals') ----- testScaledDecimalLiterals "Equal ScaledDecimal with different scales should use different slots This is related to http://bugs.squeak.org/view.php?id=6797" "This correctly works when evaluated separately" self deny: (Compiler evaluate: '0.5s1') scale = (Compiler evaluate: '0.5s2') scale. "But not when evaluated together if literal reduction is too agressive" self deny: (Compiler evaluate: '0.5s1 scale = 0.5s2 scale').! Item was changed: + ----- Method: CompilerTest>>testToDoModifiesTheLimit (in category 'tests') ----- - ----- Method: CompilerTest>>testToDoModifiesTheLimit (in category 'testing') ----- testToDoModifiesTheLimit "This is a non regression test for http://bugs.squeak.org/view.php?id=7093. When blocks writes into to:do: loop limit, optimization shall be carried with care." self assert: 4 equals: [ | n | n := 2. 1 to: n do: [:i | (n := n+1)>10 ifTrue: [self error: 'Should not get here']]. n] value. self assert: 4 equals: [ | n | n := 2. 1 to: n by: 1 do: [:i | (n := n+1)>10 ifTrue: [self error: 'Should not get here']]. n] value. self assert: 4 equals: [ | n inc | n := 2. inc := 1. 1 to: n by: inc do: [:i | (n := n+1)>10 ifTrue: [self error: 'Should not get here']]. n] value.! Item was changed: + ----- Method: DecompilerTests>>expectedFailures (in category 'failures') ----- - ----- Method: DecompilerTests>>expectedFailures (in category 'testing') ----- expectedFailures ^ #(testDecompileUnreachableParameter)! Item was changed: + ----- Method: DecompilerTests>>tearDown (in category 'running') ----- - ----- Method: DecompilerTests>>tearDown (in category 'initialize-release') ----- tearDown self class removeSelector: #loopWithMovingLimit! Item was changed: + ----- Method: EnvironmentTest>>testAssociationsDo (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAssociationsDo (in category 'compatibility tests') ----- testAssociationsDo "For compatibility with legacy code, environments should implement the dictionary protocol." env at: #Griffle put: value. env at: #Plonk put: value. env at: #Nurp put: value. env associationsDo: [:assoc | (#(Smalltalk Undeclared) includes: assoc key) ifFalse: ["We're not interested in these default bindings" self assert: (#(Griffle Plonk Nurp) includes: assoc key). self assert: value equals: assoc value]]. ! Item was changed: + ----- Method: EnvironmentTest>>testAtDoesntFindUndeclared (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testAtDoesntFindUndeclared (in category 'binding tests') ----- testAtDoesntFindUndeclared "It seems reasonable for #bindingOf: to answer either an existing binding, or create an undeclared binding and answer that. Reasonable, but wrong. The tools expect to receive nil if no binding exists, and explicitly create an undeclared binding if that's desirable." env := Environment withName: #Test. env bindingOf: #Griffle. self should: [ env at: #Griffle ] raise: KeyNotFound! Item was changed: + ----- Method: EnvironmentTest>>testAtIfAbsent (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtIfAbsent (in category 'compatibility tests') ----- testAtIfAbsent "For compatibility with legacy code, environments should implement the dictionary protocol." | result | result := env at: #Griffle ifAbsent: [value]. self assert: result == value! Item was changed: + ----- Method: EnvironmentTest>>testAtIfAbsentNot (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtIfAbsentNot (in category 'compatibility tests') ----- testAtIfAbsentNot "For compatibility with legacy code, environments should implement the dictionary protocol." | result | env at: #Griffle put: value. result := env at: #Griffle ifAbsent: [self assert: false]. self assert: result == value! Item was changed: + ----- Method: EnvironmentTest>>testAtIfPresent (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtIfPresent (in category 'compatibility tests') ----- testAtIfPresent "For compatibility with legacy code, environments should implement the dictionary protocol." | result | env at: #Griffle put: value. env at: #Griffle ifPresent: [:v | result := v]. self assert: result == value! Item was changed: + ----- Method: EnvironmentTest>>testAtIfPresentIfAbsentAbsent (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtIfPresentIfAbsentAbsent (in category 'compatibility tests') ----- testAtIfPresentIfAbsentAbsent "For compatibility with legacy code, environments should implement the dictionary protocol." | answer result | result := Object new. answer := env at: #Griffle ifPresent: [:v | self fail: 'should not reach here'] ifAbsent: [result]. self assert: result identical: answer description: 'Method answers the result of the absent block'! Item was changed: + ----- Method: EnvironmentTest>>testAtIfPresentIfAbsentPresent (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtIfPresentIfAbsentPresent (in category 'compatibility tests') ----- testAtIfPresentIfAbsentPresent "For compatibility with legacy code, environments should implement the dictionary protocol." | answer argument result | result := Object new. env at: #Griffle put: value. answer := env at: #Griffle ifPresent: [:v | argument := v. result] ifAbsent: [#absent]. self assert: value identical: argument description: 'Value is passed to the ifPresent block'. self assert: result identical: answer description: 'Method answers the result of the block'! Item was changed: + ----- Method: EnvironmentTest>>testAtIfPresentNot (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtIfPresentNot (in category 'compatibility tests') ----- testAtIfPresentNot "For compatibility with legacy code, environments should implement the dictionary protocol." env at: #Griffle ifPresent: [self fail: 'should not reach here'].! Item was changed: + ----- Method: EnvironmentTest>>testAtPutDeclared (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtPutDeclared (in category 'compatibility tests') ----- testAtPutDeclared "For compatibility with legacy code, environments should implement the dictionary protocol." | binding | env bind: #Griffle to: Object new. binding := env associationAt: #Griffle. env at: #Griffle put: value. self assert: binding value == value! Item was changed: + ----- Method: EnvironmentTest>>testAtPutUndeclared (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testAtPutUndeclared (in category 'compatibility tests') ----- testAtPutUndeclared "For compatibility with legacy code, environments should implement the dictionary protocol." | binding | binding := env undeclare: #Griffle. env at: #Griffle put: value. self assert: binding value == value! Item was changed: + ----- Method: EnvironmentTest>>testDeclaredBecomeClassBinding (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testDeclaredBecomeClassBinding (in category 'compatibility tests') ----- testDeclaredBecomeClassBinding "If a global variable is assigned a class as its value, its binding will become a class binding." | binding class | class := Behavior new. binding := env bind: #Griffle to: value; declarationOf: #Griffle. env at: #Griffle put: class. self assert: (binding class == ClassBinding). self assert: binding value == class.! Item was changed: + ----- Method: EnvironmentTest>>testDeclaredBecomeGlobal (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testDeclaredBecomeGlobal (in category 'compatibility tests') ----- testDeclaredBecomeGlobal "If a class binding gets assigned a non- class value, the binding becomes a global." | binding class | class := Behavior new. binding := env bind: #Griffle to: class; declarationOf: #Griffle. env at: #Griffle put: value. self assert: (binding class == Global). self assert: binding value == value.! Item was changed: + ----- Method: EnvironmentTest>>testDestroyRemovesObservers (in category 'tests - observation') ----- - ----- Method: EnvironmentTest>>testDestroyRemovesObservers (in category 'observation tests') ----- testDestroyRemovesObservers "When an imported environment is destroyed, the import is destroyed along with it." | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. env import: foreign. foreign destroy. self assert: 0 equals: (env instVarNamed: 'policies') size! Item was changed: + ----- Method: EnvironmentTest>>testDestroyStopsObserving (in category 'tests - observation') ----- - ----- Method: EnvironmentTest>>testDestroyStopsObserving (in category 'observation tests') ----- testDestroyStopsObserving "When an environment is destroyed, it removes its self from the observers list of other environments." | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. env import: foreign. env destroy. self assert: 0 equals: (foreign instVarNamed: 'observers') size! Item was changed: + ----- Method: EnvironmentTest>>testDestroyedImportIsUndeclared (in category 'tests - observation') ----- - ----- Method: EnvironmentTest>>testDestroyedImportIsUndeclared (in category 'observation tests') ----- testDestroyedImportIsUndeclared "When an imported environment is destroyed, it's bindings become undeclared in the importing environment" | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Griffle put: value. env from: foreign import: #Griffle. foreign destroy. self assert: (env bindingOf: #Griffle) isNil. self assert: (env isUndeclared: #Griffle).! Item was changed: + ----- Method: EnvironmentTest>>testExclusiveExplicitExport (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExclusiveExplicitExport (in category 'export tests') ----- testExclusiveExplicitExport "Exporting one name shouldn't export others." env export: #Plonk. env at: #Griffle put: Object new. self denyExports: #Griffle! Item was changed: + ----- Method: EnvironmentTest>>testExclusiveMultiExplicitExport (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExclusiveMultiExplicitExport (in category 'export tests') ----- testExclusiveMultiExplicitExport "Exporting multiple names shouldn't export a name not on the list." env export: #(Plonk #Griffle). env at: #Nurp put: Object new. self denyExports: #Nurp! Item was changed: + ----- Method: EnvironmentTest>>testExplicitExport (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExplicitExport (in category 'export tests') ----- testExplicitExport "Export a single name" env export: #Griffle. env bind: #Griffle to: value. self assertExports: #Griffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testExportAddPrefix (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExportAddPrefix (in category 'export tests') ----- testExportAddPrefix "export all names, adding a prefix." env exportAddingPrefix: 'XX'. env at: #Griffle put: value. self assertExports: #XXGriffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testExportAddingPrefixPublicizesExistingValue (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExportAddingPrefixPublicizesExistingValue (in category 'export tests') ----- testExportAddingPrefixPublicizesExistingValue "Export, adding prefix, *after* the binding has been created" env at: #Griffle put: value. env exportAddingPrefix: 'XX'. self assertExports: #XXGriffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testExportPublicizesExistingValue (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExportPublicizesExistingValue (in category 'export tests') ----- testExportPublicizesExistingValue "Export a single name, after the binding as been created." env at: #Griffle put: value. env export: #Griffle. self assertExports: #Griffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testExportRemovingPrefix (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExportRemovingPrefix (in category 'export tests') ----- testExportRemovingPrefix "Export all names, removing a prefix" env exportRemovingPrefix: 'XX'. env at: #XXGriffle put: value. self assertExports: #Griffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testExportRemovingPrefixPublicizesExistingValue (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExportRemovingPrefixPublicizesExistingValue (in category 'export tests') ----- testExportRemovingPrefixPublicizesExistingValue "Export all names, removing a prefix, after a binding has been created." env at: #XXGriffle put: value. env exportRemovingPrefix: 'XX'. self assertExports: #Griffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testExportSelfPublicizesExistingValue (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testExportSelfPublicizesExistingValue (in category 'export tests') ----- testExportSelfPublicizesExistingValue "Export all values, after a binding has been created." env at: #Griffle put: value. env exportSelf. self assertExports: #Griffle value: value! Item was changed: + ----- Method: EnvironmentTest>>testImportAddingPrefix (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportAddingPrefix (in category 'import tests') ----- testImportAddingPrefix "Import a single name adding a prefix." | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Griffle put: value. env import: foreign addingPrefix: 'XX'. self assert: (env bindingOf: #XXGriffle) value == value! Item was changed: + ----- Method: EnvironmentTest>>testImportAddingPrefixResolvesUndeclared (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportAddingPrefixResolvesUndeclared (in category 'import tests') ----- testImportAddingPrefixResolvesUndeclared "If there's an existing undeclared variable, importing a binding with the same (transformed) name creates the binding." | binding foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign bind: #Griffle to: value. binding := env undeclare: #XXGriffle. env import: foreign addingPrefix: 'XX'. self assert: (env bindingOf: #XXGriffle) == binding. self assert: (env valueOf: #XXGriffle) == value! Item was changed: + ----- Method: EnvironmentTest>>testImportAlias (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportAlias (in category 'import tests') ----- testImportAlias | foreign binding | foreign := Environment withName: #Foreign. foreign exportSelf. foreign bind: #Griffle to: value. env from: foreign import: #Griffle -> #Plonk. binding := env bindingOf: #Plonk. self assert: binding key = #Plonk. self assert: binding value == value! Item was changed: + ----- Method: EnvironmentTest>>testImportAliases (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportAliases (in category 'import tests') ----- testImportAliases "Import several specific names, renaming them." | foreign v2 v3 | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Griffle put: value. foreign at: #Nurp put: (v2 := Object new). foreign at: #Ziffy put: (v3 := Object new). env from: foreign import: {#Nurp -> #Plonk. #Ziffy -> #Wiffy}. self assert: (env bindingOf: #Griffle) isNil. self assert: (env bindingOf: #Plonk) value == v2. self assert: (env bindingOf: #Wiffy) value == v3! Item was changed: + ----- Method: EnvironmentTest>>testImportFromOther (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportFromOther (in category 'import tests') ----- testImportFromOther "Import a whole environment." | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Griffle put: value. env import: foreign. self assert: (env bindingOf: #Griffle) value == value! Item was changed: + ----- Method: EnvironmentTest>>testImportOne (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportOne (in category 'import tests') ----- testImportOne "import s specific name" | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Griffle put: value. env from: foreign import: #Griffle. self assert: (env bindingOf: #Griffle) value == value! Item was changed: + ----- Method: EnvironmentTest>>testImportRemovingPrefix (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportRemovingPrefix (in category 'import tests') ----- testImportRemovingPrefix "Import all names, removing a prefix." | foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #XXGriffle put: value. env import: foreign removingPrefix: 'XX'. self assert: (env bindingOf: #Griffle) value == value! Item was changed: + ----- Method: EnvironmentTest>>testImportRemovingPrefixResolvesUndeclared (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportRemovingPrefixResolvesUndeclared (in category 'import tests') ----- testImportRemovingPrefixResolvesUndeclared "Import all names, removing a prefix, with undeclared" | binding foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #XXGriffle put: value. binding := env undeclare: #Griffle. env import: foreign removingPrefix: 'XX'. self assert: (env bindingOf: #Griffle) == binding. self assert: (env valueOf: #Griffle) == value! Item was changed: + ----- Method: EnvironmentTest>>testImportResolvesUndeclared (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportResolvesUndeclared (in category 'import tests') ----- testImportResolvesUndeclared "Import all bindings, with undeclared" | binding foreign | foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Griffle put: value. binding := env undeclare: #Griffle. env import: foreign. self assert: (env bindingOf: #Griffle) == binding. self assert: (env valueOf: #Griffle) == value! Item was changed: + ----- Method: EnvironmentTest>>testImportWritable (in category 'tests - import') ----- - ----- Method: EnvironmentTest>>testImportWritable (in category 'import tests') ----- testImportWritable "Imported globals, even if renamed, should be writable." | foreign binding | foreign := Environment withName: #Foreign. foreign exportSelf. foreign bind: #Griffle to: 'v1'. env from: foreign import: #Griffle -> #Plonk. binding := env bindingOf: #Plonk. binding value: 'v2'. self assert: (foreign declarationOf: #Griffle) value = 'v2' ! Item was changed: + ----- Method: EnvironmentTest>>testInternalVisibility (in category 'tests - compiling') ----- - ----- Method: EnvironmentTest>>testInternalVisibility (in category 'compiling tests') ----- testInternalVisibility "A method on a class in an environment can refer to other classes in that environment (provided the environment imports its self)" | griffle plonk | env importSelf. self createClass: #Griffle. self createClass: #Plonk. griffle := env at: #Griffle. griffle compileSilently: 'plonk ^ Plonk'. plonk := griffle new plonk. self assert: (env at: #Plonk) == plonk! Item was changed: + ----- Method: EnvironmentTest>>testKeysAndValuesDo (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testKeysAndValuesDo (in category 'compatibility tests') ----- testKeysAndValuesDo "For compatibility with legacy code, environments should implement the dictionary protocol." env at: #Griffle put: value. env at: #Plonk put: value. env at: #Nurp put: value. env keysAndValuesDo: [:key :val | (#(Smalltalk Undeclared) includes: key) ifFalse: ["We're not interested in these default bindings" self assert: (#(Griffle Plonk Nurp) includes: key). self assert: value equals: val]].! Item was changed: + ----- Method: EnvironmentTest>>testMultiExplicitExport (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testMultiExplicitExport (in category 'export tests') ----- testMultiExplicitExport "Export a list of names" | v2 | env export: #(#Griffle #Plonk). env at: #Griffle put: value. env at: #Plonk put: (v2 := Object new). self assertExports: #Griffle value: value. self assertExports: #Plonk value: v2! Item was changed: + ----- Method: EnvironmentTest>>testMultiExportPublicizesExistingValue (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testMultiExportPublicizesExistingValue (in category 'export tests') ----- testMultiExportPublicizesExistingValue "Export a list of names, with existing binaries." | v2 | env at: #Griffle put: value. env at: #Plonk put: (v2 := Object new). env export: #(Griffle Plonk). self assertExports: #Griffle value: value. self assertExports: #Plonk value: v2.! Item was changed: + ----- Method: EnvironmentTest>>testReadOnlyBindings (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testReadOnlyBindings (in category 'binding tests') ----- testReadOnlyBindings "It's almost always a bug to overwrite a class, so all class bindings should be read-only by default." | binding class | class := Behavior new. env importSelf. env bind: #Griffle to: class. binding := env bindingOf: #Griffle. self should: [binding value: nil] raise: AttemptToWriteReadOnlyGlobal! Item was changed: + ----- Method: EnvironmentTest>>testRemoveKey (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testRemoveKey (in category 'compatibility tests') ----- testRemoveKey "For compatibility with legacy code, environments should implement the dictionary protocol." self should: [env removeKey: #Griffle] raise: KeyNotFound.! Item was changed: + ----- Method: EnvironmentTest>>testRemoveKeyIfAbsent (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testRemoveKeyIfAbsent (in category 'compatibility tests') ----- testRemoveKeyIfAbsent "For compatibility with legacy code, environments should implement the dictionary protocol." | result | result := env removeKey: #Griffle ifAbsent: [#removed]. self assert: #removed equals: result. env at: #Griffle put: value. result := env removeKey: #Griffle ifAbsent: [#removed]. self assert: value equals: result.! Item was changed: + ----- Method: EnvironmentTest>>testRenameContinuity (in category 'tests - class') ----- - ----- Method: EnvironmentTest>>testRenameContinuity (in category 'class tests') ----- testRenameContinuity "When we rename a class, literal references to it from method bytecode should still work even though they are now undeclared." | class | env importSelf. class := self createClass: #Griffle. class compileSilently: 'foo ^ Griffle new' classified: ''. self shouldnt: [class new foo] raise: Error. self assert: class equals: class new foo class description: '<failsafe>'. class rename: #Plonk. self shouldnt: [class new foo] raise: Error. self assert: class equals: class new foo class description: 'The value of the binding should still be intact after a class rename'. ! Item was changed: + ----- Method: EnvironmentTest>>testRenameCreatesNewBinding (in category 'tests - class') ----- - ----- Method: EnvironmentTest>>testRenameCreatesNewBinding (in category 'class tests') ----- testRenameCreatesNewBinding "When we rename a class, a completely new binding should be created for the new name. The old binding is moved to undeclared." | class newBinding oldBinding | env importSelf. class := self createClass: #Griffle. oldBinding := env bindingOf: #Griffle. class rename: #Plonk. newBinding := env bindingOf: #Plonk. self deny: newBinding == oldBinding. self assert: class identical: oldBinding value. self assert: #Griffle equals: oldBinding key. self assert: #Plonk equals: newBinding key. self assert: class identical: newBinding value. ! Item was changed: + ----- Method: EnvironmentTest>>testRequireExplicitExports (in category 'tests - export') ----- - ----- Method: EnvironmentTest>>testRequireExplicitExports (in category 'export tests') ----- testRequireExplicitExports "Names that haven't been exported aren't visible, even if a binding exists." env bind: #Griffle to: Object new. self denyExports: #Griffle.! Item was changed: + ----- Method: EnvironmentTest>>testStoreDomesticValue (in category 'tests - compiling') ----- - ----- Method: EnvironmentTest>>testStoreDomesticValue (in category 'compiling tests') ----- testStoreDomesticValue "Create a class that implements #doStore. (see the comment in #storeValueMethod.) Send the message, then examine the results. The two values should be identical." | griffle values | env importSelf. env from: Smalltalk globals import: #Object. self createClass: #Griffle. env bind: #Plonk to: value. griffle := env at: #Griffle. griffle compileSilently: self storeValueMethod. values := griffle new doStore. self assert: values isArray. self assert: values size = 2. self assert: values first == values last. self assert: (env valueOf: #Plonk) == values first! Item was changed: + ----- Method: EnvironmentTest>>testStoreImportedValue (in category 'tests - compiling') ----- - ----- Method: EnvironmentTest>>testStoreImportedValue (in category 'compiling tests') ----- testStoreImportedValue "Create a class that implements #doStore. Import #Plonk from another environment. (see the comment in #storeValueMethod.) Send the message, then examine the results. The two values should be identical." | griffle foreign values | self createClass: #Griffle. foreign := Environment withName: #Foreign. foreign exportSelf. foreign at: #Plonk put: 'v1'. env from: foreign import: #Plonk. env from: Smalltalk globals import: #Object. griffle := env at: #Griffle. griffle compileSilently: self storeValueMethod. values := griffle new doStore. self assert: values isArray. self assert: values size = 2. self assert: values first == values last. self assert: (foreign at: #Plonk) == values first! Item was changed: + ----- Method: EnvironmentTest>>testUnbindDoesNotAlterImportedBindings (in category 'tests - observation') ----- - ----- Method: EnvironmentTest>>testUnbindDoesNotAlterImportedBindings (in category 'observation tests') ----- testUnbindDoesNotAlterImportedBindings "When attempting to unbind a symbol, do not alter bindings outside of the envrionments' own declarations." | foreign foreignBinding one two | foreign := Environment withName: #Foreign. foreign exportSelf. foreign bind: #Griffle to: value. foreignBinding := foreign associationAt: #Griffle. env at: #Griffle put: Object new. env importSelf. env import: foreign. one := env bindingOf: #Griffle. self assert: one == foreignBinding description: 'imported binding'. env unbind: #Griffle. two := env bindingOf: #Griffle. self assert: value equals: foreignBinding value description: 'imported value unaffacted'. self assert: two == foreignBinding description: 'imported binding still in place'.! Item was changed: + ----- Method: EnvironmentTest>>testUnbindDoesNotDestroyImportedBindingsFromAnotherEnvironment (in category 'tests - observation') ----- - ----- Method: EnvironmentTest>>testUnbindDoesNotDestroyImportedBindingsFromAnotherEnvironment (in category 'observation tests') ----- testUnbindDoesNotDestroyImportedBindingsFromAnotherEnvironment "When a symbol is undeclared, the observing environments should not lose a binding with the same key if that binding is actually imported from self or a third environment." | foreign foreignBinding one ownValue two three | foreign := Environment withName: #Foreign. foreign exportSelf. foreign bind: #Griffle to: value. foreignBinding := foreign associationAt: #Griffle. env importSelf. env import: foreign. one := env bindingOf: #Griffle. self assert: one == foreignBinding description: 'imported binding'. self assert: one value == value description: 'imported binding'. ownValue := Object new. env bind: #Griffle to: ownValue. two := env bindingOf: #Griffle. self assert: one ~~ two description: 'new binding'. foreign unbind: #Griffle. self assert: nil equals: one value description: 'imported binding undeclared'. three := env bindingOf: #Griffle. self assert: two == three description: 'own binding unaffected'. self assert: three value == ownValue description: 'own binding''s value unaffected'.! Item was changed: + ----- Method: EnvironmentTest>>testUndeclare (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testUndeclare (in category 'binding tests') ----- testUndeclare "When a symbol is undeclared, it's not visible to methods compiled in the environment, so #bindingOf: should answer nil. However, methods that refer to the symbol anyway use a canonical binding. That binding should have a nil value and be an instance of Global, rather than a class binding or alias." | one two | one := env undeclare: #Griffle. two := env bindingOf: #Griffle. self assert: nil equals: two description: '#bindingOf:'. self assert: Global equals: one class description: 'Type of binding'. self assert: nil equals: one value description: 'Value of binding'.! Item was changed: + ----- Method: EnvironmentTest>>testUndeclareAgain (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testUndeclareAgain (in category 'binding tests') ----- testUndeclareAgain "Multiple 'undeclarations' of the same variable name should use the same canonical binding." | one two | one := env undeclare: #Griffle. two := env undeclare: #Griffle. self assert: one == two.! Item was changed: + ----- Method: EnvironmentTest>>testUndeclareFromConflict (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testUndeclareFromConflict (in category 'binding tests') ----- testUndeclareFromConflict "When a shared variable is removed from a class pool, it gets undeclared in the environment. If that variable name is *already* undeclared in the environment, the binding in the environment is maintained, and references to the pool binding become references to the environment's binding. The binding should be a Global." | one pool three two | pool := IdentityDictionary new. pool at: #Griffle put: value. one := pool bindingOf: #Griffle. two := env undeclare: #Griffle. three := env undeclare: #Griffle from: pool. self assert: three == two description: 'Existing binding is reused'. self assert: three == one description: 'Pool binding is forwarded'. self assert: Global equals: three class description: 'Type of binding'. ! Item was changed: + ----- Method: EnvironmentTest>>testUndeclareFromEmpty (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testUndeclareFromEmpty (in category 'binding tests') ----- testUndeclareFromEmpty "When a binding is moved from a pool to an environment, but actually doesn't exist in the pool in the first place, a new binding with a nil value is created for the environment's undeclared dictionary." | binding | binding := env undeclare: #Griffle from: IdentityDictionary new. self assert: Global equals: binding class description: 'Type of binding'. self assert: nil equals: binding value description: 'Value of binding'.! Item was changed: + ----- Method: EnvironmentTest>>testUndeclareFromRemovesOld (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testUndeclareFromRemovesOld (in category 'binding tests') ----- testUndeclareFromRemovesOld "When a binding is removed from a pool, and undeclared in the enviornment, it should actually be removed from the pool dictionary." | pool | pool := IdentityDictionary new. pool at: #Griffle put: value. env undeclare: #Griffle from: pool. self assert: false equals: (pool includesKey: #Griffle) description: 'Existing binding is removed'. ! Item was changed: + ----- Method: EnvironmentTest>>testUndeclaredBecomeClassBinding (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testUndeclaredBecomeClassBinding (in category 'compatibility tests') ----- testUndeclaredBecomeClassBinding "When a undeclared name is bound to a class existing bindings are transformed into ClassBindings." | binding class | class := Behavior new. binding := env undeclare: #Griffle. env at: #Griffle put: class. self assert: (binding class == ClassBinding). self assert: binding value == class.! Item was changed: + ----- Method: EnvironmentTest>>testUndeclaredBecomesGlobal (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testUndeclaredBecomesGlobal (in category 'compatibility tests') ----- testUndeclaredBecomesGlobal "If a class binding is somehow undeclared, it becomes a Global when a non-behavior value is bound to the name." | binding class | class := Behavior new. binding := env undeclared add: (#Griffle => class); associationAt: #Griffle. env bind: #Griffle to: value. self assert: (binding class == Global). self assert: binding value == value.! Item was changed: + ----- Method: EnvironmentTest>>testUndeclaredBindingMoved (in category 'tests - binding') ----- - ----- Method: EnvironmentTest>>testUndeclaredBindingMoved (in category 'binding tests') ----- testUndeclaredBindingMoved "If a binding is undeclared, and subsequently declared, the existing binding is re-used for the declaration." | binding | binding := env undeclare: #Griffle. env bind: #Griffle to: value. self assert: (env declarationOf: #Griffle) = binding.! Item was changed: + ----- Method: EnvironmentTest>>testValuesDo (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testValuesDo (in category 'compatibility tests') ----- testValuesDo "For compatibility with legacy code, environments should implement the dictionary protocol." | count | env at: #Griffle put: value. env at: #Plonk put: value. env at: #Nurp put: value. count := 0. env valuesDo: [:val | count := count + 1]. self assert: 3 + 2 equals: count description: '#valuesDo: should see all declared vallues plus the ones from Smalltalk and Undeclares' ! Item was changed: + ----- Method: EnvironmentTest>>testWriteAndLookup (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testWriteAndLookup (in category 'compatibility tests') ----- testWriteAndLookup "For compatibility with SystemDictionary, #at:put: should create a binding which can subsequently be found with #associationAt:." | binding | env at: #Griffle put: value. binding := env associationAt: #Griffle. self assert: binding key == #Griffle. self assert: binding value == value. ! Item was changed: + ----- Method: EnvironmentTest>>testWriteAndRead (in category 'tests - compatibility') ----- - ----- Method: EnvironmentTest>>testWriteAndRead (in category 'compatibility tests') ----- testWriteAndRead "For compatibility with SystemDictionary, a value set with #at:put: should be retrievable with #at:" env at: #Griffle put: value. self assert: (env at: #Griffle) == value.! Item was changed: + ----- Method: ExceptionTests>>expectedFailures (in category 'failures') ----- - ----- Method: ExceptionTests>>expectedFailures (in category 'testing-outer') ----- expectedFailures "This test is a feature request. For more information on this issue visit: http://forum.world.st/The-Inbox-Tests-TestRunner-156-mcz-tc4643910.html#a4643987 http://forum.world.st/ExceptionTests-Wrong-error-handler-tc4848699.html http://forum.world.st/ExceptionTests-gt-testHandlerFromAction-fails-tc4872828.html#a4872958" ^ #(testHandlerFromAction).! Item was changed: + ----- Method: ExceptionTests>>testDoubleOuterPass (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testDoubleOuterPass (in category 'testing-ExceptionTester') ----- testDoubleOuterPass self assertSuccess: (ExceptionTester new runTest: #doubleOuterPassTest ) ! Item was changed: + ----- Method: ExceptionTests>>testDoublePassOuter (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testDoublePassOuter (in category 'testing-ExceptionTester') ----- testDoublePassOuter self assertSuccess: (ExceptionTester new runTest: #doublePassOuterTest ) ! Item was changed: + ----- Method: ExceptionTests>>testDoubleResume (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testDoubleResume (in category 'testing-ExceptionTester') ----- testDoubleResume self assertSuccess: (ExceptionTester new runTest: #doubleResumeTest ) ! Item was changed: + ----- Method: ExceptionTests>>testHandlerFromAction (in category 'tests - outer') ----- - ----- Method: ExceptionTests>>testHandlerFromAction (in category 'testing-outer') ----- 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: 'outer' equals: result description: 'Incorrect handler'. ! Item was changed: + ----- Method: ExceptionTests>>testHandlerReentrancy (in category 'tests') ----- - ----- Method: ExceptionTests>>testHandlerReentrancy (in category 'testing') ----- testHandlerReentrancy | callingOrder | "Handlers are not re-entrant by default, so inner is not activated twice" callingOrder := String streamContents: [:stream | [[stream nextPut: $s. Notification signal] "Inner handler" on: Notification do: [:ex | stream nextPut: $i. ex pass]] "outer handler" on: Notification do: [:ex | stream nextPut: $o. Notification signal]]. self assert: callingOrder = 'sio'. "Now make inner re-entrant" callingOrder := String streamContents: [:stream | [[stream nextPut: $s. Notification signal] "Inner handler" on: Notification do: [:ex | stream nextPut: $i. ex rearmHandlerDuring: [ex pass]]] "outer handler" on: Notification do: [:ex | stream nextPut: $o. Notification signal]]. self assert: callingOrder = 'sioi'.! Item was changed: + ----- Method: ExceptionTests>>testNoTimeout (in category 'tests') ----- - ----- Method: ExceptionTests>>testNoTimeout (in category 'testing') ----- testNoTimeout self assertSuccess: (ExceptionTester new runTest: #simpleNoTimeoutTest ) ! Item was changed: + ----- Method: ExceptionTests>>testNonResumableFallOffTheEndHandler (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testNonResumableFallOffTheEndHandler (in category 'testing-ExceptionTester') ----- testNonResumableFallOffTheEndHandler self assertSuccess: (ExceptionTester new runTest: #nonResumableFallOffTheEndHandler ) ! Item was changed: + ----- Method: ExceptionTests>>testNonResumableOuter (in category 'tests - outer') ----- - ----- Method: ExceptionTests>>testNonResumableOuter (in category 'testing-outer') ----- testNonResumableOuter self should: [ [Error signal. 4] on: Error do: [:ex | ex outer. ex return: 5] ] raise: Error ! Item was changed: + ----- Method: ExceptionTests>>testNonResumablePass (in category 'tests - outer') ----- - ----- Method: ExceptionTests>>testNonResumablePass (in category 'testing-outer') ----- testNonResumablePass self should: [ [Error signal. 4] on: Error do: [:ex | ex pass. ex return: 5] ] raise: Error ! Item was changed: + ----- Method: ExceptionTests>>testOuter (in category 'tests - outer') ----- - ----- Method: ExceptionTests>>testOuter (in category 'testing-outer') ----- testOuter | result | result := [[Notification signal. #signal] on: Notification do: [:ex| ex outer. #inner]] on: Notification do: [:ex| #outer]. self assert: result = #outer! Item was changed: + ----- Method: ExceptionTests>>testResumableFallOffTheEndHandler (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testResumableFallOffTheEndHandler (in category 'testing-ExceptionTester') ----- testResumableFallOffTheEndHandler self assertSuccess: (ExceptionTester new runTest: #resumableFallOffTheEndHandler ) ! Item was changed: + ----- Method: ExceptionTests>>testResumableOuter (in category 'tests - outer') ----- - ----- Method: ExceptionTests>>testResumableOuter (in category 'testing-outer') ----- testResumableOuter | result | result := [Notification signal. 4] on: Notification do: [:ex | ex outer. ex return: 5]. self assert: result = 5 ! Item was changed: + ----- Method: ExceptionTests>>testResumablePass (in category 'tests - outer') ----- - ----- Method: ExceptionTests>>testResumablePass (in category 'testing-outer') ----- testResumablePass | result | result := [Notification signal. 4] on: Notification do: [:ex | ex pass. ex return: 5]. self assert: result = 4 ! Item was changed: + ----- Method: ExceptionTests>>testSignalFromHandlerActionTest (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSignalFromHandlerActionTest (in category 'testing-ExceptionTester') ----- testSignalFromHandlerActionTest self assertSuccess: (ExceptionTester new runTest: #signalFromHandlerActionTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleEnsure (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleEnsure (in category 'testing-ExceptionTester') ----- testSimpleEnsure self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleEnsureTestWithError (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleEnsureTestWithError (in category 'testing-ExceptionTester') ----- testSimpleEnsureTestWithError self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithError ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleEnsureTestWithNotification (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleEnsureTestWithNotification (in category 'testing-ExceptionTester') ----- testSimpleEnsureTestWithNotification self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithNotification ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleEnsureTestWithUparrow (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleEnsureTestWithUparrow (in category 'testing-ExceptionTester') ----- testSimpleEnsureTestWithUparrow self assertSuccess: (ExceptionTester new runTest: #simpleEnsureTestWithUparrow ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleIsNested (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleIsNested (in category 'testing-ExceptionTester') ----- testSimpleIsNested self assertSuccess: (ExceptionTester new runTest: #simpleIsNestedTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleOuter (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleOuter (in category 'testing-ExceptionTester') ----- testSimpleOuter self assertSuccess: (ExceptionTester new runTest: #simpleOuterTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimplePass (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimplePass (in category 'testing-ExceptionTester') ----- testSimplePass self assertSuccess: (ExceptionTester new runTest: #simplePassTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleResignalAs (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleResignalAs (in category 'testing-ExceptionTester') ----- testSimpleResignalAs self assertSuccess: (ExceptionTester new runTest: #simpleResignalAsTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleResume (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleResume (in category 'testing-ExceptionTester') ----- testSimpleResume self assertSuccess: (ExceptionTester new runTest: #simpleResumeTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleRetry (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleRetry (in category 'testing-ExceptionTester') ----- testSimpleRetry self assertSuccess: (ExceptionTester new runTest: #simpleRetryTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleRetryUsing (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleRetryUsing (in category 'testing-ExceptionTester') ----- testSimpleRetryUsing self assertSuccess: (ExceptionTester new runTest: #simpleRetryUsingTest ) ! Item was changed: + ----- Method: ExceptionTests>>testSimpleReturn (in category 'tests - ExceptionTester') ----- - ----- Method: ExceptionTests>>testSimpleReturn (in category 'testing-ExceptionTester') ----- testSimpleReturn self assertSuccess: (ExceptionTester new runTest: #simpleReturnTest ) ! Item was changed: + ----- Method: ExceptionTests>>testTimeoutWithZeroDuration (in category 'tests') ----- - ----- Method: ExceptionTests>>testTimeoutWithZeroDuration (in category 'testing') ----- testTimeoutWithZeroDuration self assertSuccess: (ExceptionTester new runTest: #simpleTimeoutWithZeroDurationTest ) ! Item was changed: + ----- Method: FileDirectoryTest>>deleteDirectory (in category 'tests - create/delete') ----- - ----- Method: FileDirectoryTest>>deleteDirectory (in category 'create/delete tests') ----- deleteDirectory (self myDirectory exists) ifTrue: [self myDirectory containingDirectory deleteDirectory: self myLocalDirectoryName]! Item was changed: + ----- Method: FileDirectoryTest>>testAttemptExistenceCheckWhenFile (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testAttemptExistenceCheckWhenFile (in category 'existence tests') ----- testAttemptExistenceCheckWhenFile "How should a FileDirectory instance respond with an existent file name?" | directory filename | filename := 'aTestFile'. FileDirectory default forceNewFileNamed: filename. directory := FileDirectory default directoryNamed: filename. self shouldnt: [directory exists] description: 'Files are not directories.'. "clean up disk" FileDirectory default deleteFileNamed: filename ifAbsent: [ ]! Item was changed: + ----- Method: FileDirectoryTest>>testDeleteDirectory (in category 'tests - create/delete') ----- - ----- Method: FileDirectoryTest>>testDeleteDirectory (in category 'create/delete tests') ----- testDeleteDirectory "Test deletion of a directory" | aContainingDirectory preTestItems | aContainingDirectory := self myDirectory containingDirectory. preTestItems := aContainingDirectory fileAndDirectoryNames. self assert: self myAssuredDirectory exists. aContainingDirectory deleteDirectory: self myLocalDirectoryName. self shouldnt: [aContainingDirectory directoryNames includes: self myLocalDirectoryName ] description: 'Should successfully delete directory.'. self should: [preTestItems = aContainingDirectory fileAndDirectoryNames] description: 'Should only delete the indicated directory.'. ! Item was changed: + ----- Method: FileDirectoryTest>>testDirectoryExists (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testDirectoryExists (in category 'existence tests') ----- testDirectoryExists self assert: self myAssuredDirectory exists. self should: [self myDirectory containingDirectory directoryExists: self myLocalDirectoryName]. self myDirectory containingDirectory deleteDirectory: self myLocalDirectoryName. self shouldnt: [self myDirectory containingDirectory directoryExists: self myLocalDirectoryName]! Item was changed: + ----- Method: FileDirectoryTest>>testDirectoryExistsWhenLikeNamedFileExists (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testDirectoryExistsWhenLikeNamedFileExists (in category 'existence tests') ----- testDirectoryExistsWhenLikeNamedFileExists [ | testFileName | testFileName := self myAssuredDirectory fullNameFor: 'zDirExistsTest.testing'. (FileStream newFileNamed: testFileName) close. self should: [FileStream isAFileNamed: testFileName]. self shouldnt: [(FileDirectory on: testFileName) exists]] ensure: [self myAssuredDirectory deleteFileNamed: 'zDirExistsTest.testing'] ! Item was changed: + ----- Method: FileDirectoryTest>>testDirectoryNamed (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testDirectoryNamed (in category 'existence tests') ----- testDirectoryNamed self should: [(self myDirectory containingDirectory directoryNamed: self myLocalDirectoryName) pathName = self myDirectory pathName]! Item was changed: + ----- Method: FileDirectoryTest>>testDirectoryNicknames (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testDirectoryNicknames (in category 'existence tests') ----- testDirectoryNicknames | defaultDirectory | defaultDirectory := FileDirectory default. #('/.' '/../../.' '/././.') collect: [ :each | each copyReplaceAll: '/' with: FileDirectory slash ] thenDo: [:each | self assert: (defaultDirectory directoryExists: defaultDirectory fullName, each) description: 'Nickname of "', each, '"'. ]! Item was changed: + ----- Method: FileDirectoryTest>>testExists (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testExists (in category 'existence tests') ----- testExists self should: [FileDirectory default exists] description: 'Should know default directory exists.'. self should: [self myAssuredDirectory exists] description: 'Should know created directory exists.'. self myDirectory containingDirectory deleteDirectory: self myLocalDirectoryName. self shouldnt: [(self myDirectory containingDirectory directoryNamed: self myLocalDirectoryName) exists] description: 'Should know that recently deleted directory no longer exists.'.! Item was changed: + ----- Method: FileDirectoryTest>>testNonExistentDirectory (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testNonExistentDirectory (in category 'existence tests') ----- testNonExistentDirectory | directory parentDirectory | directory :=FileDirectory default directoryNamed: 'nonExistentFolder'. self shouldnt: [directory exists] description: 'A FileDirectory instance should know if it points to a non-existent directory.'. parentDirectory :=FileDirectory default. self shouldnt: [parentDirectory directoryExists: 'nonExistentFolder'] description: 'A FileDirectory instance should know when a directory of the given name doesn''t exist'. ! Item was changed: + ----- Method: FileDirectoryTest>>testOldFileOrNoneNamed (in category 'tests - existence') ----- - ----- Method: FileDirectoryTest>>testOldFileOrNoneNamed (in category 'existence tests') ----- testOldFileOrNoneNamed | file | file := self myAssuredDirectory oldFileOrNoneNamed: 'test.txt'. [self assert: file isNil. "Reproduction of Mantis #1049" (self myAssuredDirectory fileNamed: 'test.txt') nextPutAll: 'foo'; close. file := self myAssuredDirectory oldFileOrNoneNamed: 'test.txt'. self assert: file notNil] ensure: [ file ifNotNil: [file close]. self myAssuredDirectory deleteFileNamed: 'test.txt' ifAbsent: nil] ! Item was changed: + ----- Method: InstallerTest>>testPackageAndVersionNameShouldSanitiseInput (in category 'tests - package and version') ----- - ----- Method: InstallerTest>>testPackageAndVersionNameShouldSanitiseInput (in category 'package and version') ----- testPackageAndVersionNameShouldSanitiseInput | installer | installer := Installer new. self assert: {'Foo'. ''} equals: (installer packageAndVersionFrom: 'Foo'). self assert: {'Foo'. '1'} equals: (installer packageAndVersionFrom: 'Foo(1)'). self assert: {'Foo'. 'head'} equals: (installer packageAndVersionFrom: ' Foo ( head ) ').! Item was changed: + ----- Method: InstallerTest>>testSelectFullySpecifiedBranchVersion (in category 'tests - version selection') ----- - ----- Method: InstallerTest>>testSelectFullySpecifiedBranchVersion (in category 'version selection') ----- testSelectFullySpecifiedBranchVersion | installer | installer := InstallerMonticelloMock new. installer setMockCache: listOfFileNames. installer packages: { 'Chronology-Core.UTC-dtl.30' }. self assert: 'Chronology-Core.UTC-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core.UTC-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames. installer packages: { 'Chronology-Core.UTC-dtl.30.mcz' }. self assert: 'Chronology-Core.UTC-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core.UTC-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. ! Item was changed: + ----- Method: InstallerTest>>testSelectFullySpecifiedVersion (in category 'tests - version selection') ----- - ----- Method: InstallerTest>>testSelectFullySpecifiedVersion (in category 'version selection') ----- testSelectFullySpecifiedVersion | installer | installer := InstallerMonticelloMock new. installer packages: { 'Chronology-Core-dtl.30' }. installer setMockCache: listOfFileNames. self assert: 'Chronology-Core-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer packages: { 'Chronology-Core-dtl.30.mcz' }. installer setMockCache: listOfFileNames. self assert: 'Chronology-Core-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core-dtl.30' equals: installer mcThing mockConfigurationVersion versionName. installer packages: { 'Chronology-Core-bf.7' }. installer setMockCache: listOfFileNames. self assert: 'Chronology-Core-bf.7' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core-bf.7' equals: installer mcThing mockConfigurationVersion versionName. installer packages: { 'Chronology-Core-bf.7.mcz' }. installer setMockCache: listOfFileNames. self assert: 'Chronology-Core-bf.7' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core-bf.7' equals: installer mcThing mockConfigurationVersion versionName. ! Item was changed: + ----- Method: InstallerTest>>testSelectFullySpecifiedVersionWhereVersionNumberMayBeAmbiguous (in category 'tests - version selection') ----- - ----- Method: InstallerTest>>testSelectFullySpecifiedVersionWhereVersionNumberMayBeAmbiguous (in category 'version selection') ----- testSelectFullySpecifiedVersionWhereVersionNumberMayBeAmbiguous "Documents a bug in earlier versions of the Monticello installer, in which a requiest to load version 3 would load the wrong version if a version 30 existed in the same repository." "(self selector: #testSelectFullySpecifiedVersionWhereVersionNumberMayBeAmbiguous) debug" | installer | installer := InstallerMonticelloMock new. installer packages: { 'Chronology-Core-dtl.3' }. installer setMockCache: listOfFileNames. self deny: 'Chronology-Core-dtl.30' = installer mcThing mockConfigurationVersion versionName description: 'version 3 was specified, but version 30 was selected'. self assert: 'Chronology-Core-dtl.3' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self deny: 'Chronology-Core-dtl.30' = installer mcThing mockConfigurationVersion versionName description: 'version 3 was specified, but version 30 was selected'. self assert: 'Chronology-Core-dtl.3' equals: installer mcThing mockConfigurationVersion versionName. installer packages: { 'Chronology-Core-dtl.3.mcz' }. self deny: 'Chronology-Core-dtl.30' = installer mcThing mockConfigurationVersion versionName description: 'version 3 was specified, but version 30 was selected'. self assert: 'Chronology-Core-dtl.3' equals: installer mcThing mockConfigurationVersion versionName. installer setMockCache: listOfFileNames reversed. self deny: 'Chronology-Core-dtl.30' = installer mcThing mockConfigurationVersion versionName description: 'version 3 was specified, but version 30 was selected'. self assert: 'Chronology-Core-dtl.3' equals: installer mcThing mockConfigurationVersion versionName. ! Item was changed: + ----- Method: InstallerTest>>testSelectLatestVersionForPackage (in category 'tests - version selection') ----- - ----- Method: InstallerTest>>testSelectLatestVersionForPackage (in category 'version selection') ----- testSelectLatestVersionForPackage "The listOfFileNames test data set contains more than one Chronology-Core-???.30 version differing by author initials. The first detected in sort order is valid, therefore test only for package, branch, and version number." | installer | installer := InstallerMonticelloMock new. installer packages: { 'Chronology-Core' }. installer setMockCache: listOfFileNames. self assert: 'Chronology-Core' equals: installer mcThing mockConfigurationVersion packageAndBranchName. self assert: 30 equals: installer mcThing mockConfigurationVersion versionNumber. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core' equals: installer mcThing mockConfigurationVersion packageAndBranchName. self assert: 30 equals: installer mcThing mockConfigurationVersion versionNumber. ! Item was changed: + ----- Method: InstallerTest>>testSelectLatestVersionInBranchForPackage (in category 'tests - version selection') ----- - ----- Method: InstallerTest>>testSelectLatestVersionInBranchForPackage (in category 'version selection') ----- testSelectLatestVersionInBranchForPackage "The listOfFileNames test data set contains more than one Chronology-Core.UTC-???.30 version differing by author initials. The first detected in sort order is valid, therefore test only for package, branch, and version number." | installer | installer := InstallerMonticelloMock new. installer packages: { 'Chronology-Core.UTC' }. installer setMockCache: listOfFileNames. self assert: 'Chronology-Core.UTC' equals: installer mcThing mockConfigurationVersion packageAndBranchName. self assert: 30 equals: installer mcThing mockConfigurationVersion versionNumber. installer setMockCache: listOfFileNames reversed. self assert: 'Chronology-Core.UTC' equals: installer mcThing mockConfigurationVersion packageAndBranchName. self assert: 30 equals: installer mcThing mockConfigurationVersion versionNumber. ! Item was changed: + ----- Method: IslandVMTweaksTestCase>>testEmptyReplace (in category 'tests') ----- - ----- Method: IslandVMTweaksTestCase>>testEmptyReplace (in category 'testing') ----- testEmptyReplace | array1 array2 | array1 := Array with: 1 with: 2 with: 3 with: 4. array2 := Array with: 5 with: 6 with: 7. self replaceIn: array1 from: 1 to: 0 with: array2 startingAt: 1. self should: [ array1 = #(1 2 3 4) ]. ! Item was changed: + ----- Method: IslandVMTweaksTestCase>>testFlagInCompiledMethod (in category 'tests') ----- - ----- Method: IslandVMTweaksTestCase>>testFlagInCompiledMethod (in category 'testing') ----- testFlagInCompiledMethod "this tests that the flag in compiled methods is treated correctly" | method | method := self class compiledMethodAt: #returnTwelve. "turn off the flag" method objectAt: 1 put: (method header bitAnd: (1 << 29) bitInvert). self should: [ method flag not ]. "turn on the flag" method objectAt: 1 put: (method header bitOr: (1 << 29)). self should: [ method flag ]. "try running the method with the flag turned on" self should: [ self returnTwelve = 12 ]. "make sure the flag bit isn't interpreted as a primitive" self should: [ method primitive = 0 ].! Item was changed: + ----- Method: IslandVMTweaksTestCase>>testForgivingPrims (in category 'tests') ----- - ----- Method: IslandVMTweaksTestCase>>testForgivingPrims (in category 'testing') ----- testForgivingPrims | aPoint anotherPoint array1 array2 | aPoint := Point x: 5 y: 6. anotherPoint := Point x: 7 y: 8. "make sure there are multiple points floating around" anotherPoint. "stop the compiler complaining about no uses" self assert: Point equals: (self classOf: aPoint). self assert: 5 equals: (self instVarOf: aPoint at: 1). self instVarOf: aPoint at: 2 put: 10. self assert: 10 equals: (self instVarOf: aPoint at: 2). Smalltalk isRunningSpur "Spur does not maintain object ordering..." ifTrue: [self assert: Point equals: (self someInstanceOf: Point) class] ifFalse: [self someObject. self nextObjectAfter: aPoint. self assert: Point equals: (self someInstanceOf: Point) class. self assert: Point equals: (self nextInstanceAfter: aPoint) class]. array1 := Array with: 1 with: 2 with: 3. array2 := Array with: 4 with: 5 with: 6. self replaceIn: array1 from: 2 to: 3 with: array2 startingAt: 1. self assert: #(1 4 5) equals: array1.! Item was changed: + ----- Method: LocaleTest>>expectedFailures (in category 'failures') ----- - ----- Method: LocaleTest>>expectedFailures (in category 'testing') ----- expectedFailures ^ super expectedFailures, ((NaturalLanguageTranslator translators isEmpty or: [(NaturalLanguageTranslator translators values collect: [:t | t localeID ]) asSet size = 1]) ifTrue: [#(testLocaleChanged) "no locale available to switch to"] ifFalse: [ #()]), #(testIsFontAvailable "metatoys.org is not accessible") ! Item was changed: + ----- Method: MCClassDefinitionTest>>testCannotLoad (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testCannotLoad (in category 'testing') ----- testCannotLoad | d | d := self mockClass: 'MCMockClassC' super: 'NotAnObject'. self should: [d load] raise: Error. self deny: (Smalltalk hasClassNamed: 'MCMockClassC').! Item was changed: + ----- Method: MCClassDefinitionTest>>testComparison (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testComparison (in category 'testing') ----- testComparison | d1 d2 d3 d4 | d1 := self mockClass: 'A' super: 'X'. d2 := self mockClass: 'A' super: 'Y'. d3 := self mockClass: 'B' super: 'X'. d4 := self mockClass: 'B' super: 'X'. self assert: (d1 isRevisionOf: d2). self deny: (d1 isSameRevisionAs: d2). self assert: (d3 isRevisionOf: d4). self assert: (d3 isSameRevisionAs: d4). self deny: (d1 isRevisionOf: d3). self deny: (d4 isRevisionOf: d2).! Item was changed: + ----- Method: MCClassDefinitionTest>>testCreation (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testCreation (in category 'testing') ----- testCreation | d | d := self mockClassA asClassDefinition. self assert: d className = #MCMockClassA. self assert: d superclassName = #MCMock. self assert: d type = #normal. self assert: d category = self mockCategoryName. self assert: d instVarNames asArray = #('ivar'). self assert: d classVarNames asArray = #('CVar'). self assert: d classInstVarNames asArray = #(). self assert: d comment isString. self assert: d comment = self classAComment. self assert: d commentStamp = self mockClassA organization commentStamp! Item was changed: + ----- Method: MCClassDefinitionTest>>testDefinitionString (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testDefinitionString (in category 'testing') ----- testDefinitionString | d | d := self mockClassA asClassDefinition. self assert: d definitionString = self mockClassA definition.! Item was changed: + ----- Method: MCClassDefinitionTest>>testEquals (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testEquals (in category 'testing') ----- testEquals | a b | a := self mockClass: 'ClassA' super: 'SuperA'. b := self mockClass: 'ClassA' super: 'SuperA'. self assert: a = b! Item was changed: + ----- Method: MCClassDefinitionTest>>testEqualsSensitivity (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testEqualsSensitivity (in category 'testing') ----- testEqualsSensitivity | message a b defA args defB | message := self creationMessage. a := #(ClassA SuperA CategoryA #(iVarA) #(CVarA) #(PoolA) #(ciVarA) typeA 'A comment' 'A'). b := #(ClassB SuperB CategoryB #(iVarB) #(CVarB) #(PoolB) #(ciVarB) typeB 'B comment' 'B'). defA := message valueWithArguments: a. 1 to: 8 do: [:index | args := a copy. args at: index put: (b at: index). defB := message valueWithArguments: args. self deny: defA = defB.]! Item was changed: + ----- Method: MCClassDefinitionTest>>testKindOfSubclass (in category 'tests - class type') ----- - ----- Method: MCClassDefinitionTest>>testKindOfSubclass (in category 'testing - class type') ----- testKindOfSubclass {self mockClassA. String. ByteString. WideString. BlockClosure. WeakArray. BoxedFloat64. SmallFloat64. CompiledMethod. ByteArray. DoubleByteArray. IntegerArray. DoubleWordArray. } do: [:c | self assert: c asClassDefinition kindOfSubclass equals: c kindOfSubclass]! Item was changed: + ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledBlock (in category 'tests - class type') ----- - ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledBlock (in category 'testing - class type') ----- testKindOfSubclassForCompiledBlock "CompiledCode and its subclasses are a special case." | classDef | "CompiledBlock should be like CompiledMethod, both now are subclassed from CompiledCode" classDef := self mockClass: #CompiledBlock super: #CompiledCode. self assert: #compiledMethod equals: classDef type. self assert: CompiledBlock typeOfClass equals: classDef type! Item was changed: + ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledCode (in category 'tests - class type') ----- - ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledCode (in category 'testing - class type') ----- testKindOfSubclassForCompiledCode "CompiledCode and its subclasses are a special case." | classDef | "CompiledMethod is now a subclass of CompiledCode, which is also of type #compiledMethod" classDef := self mockClass: #CompiledCode super: #ByteArray. self assert: #compiledMethod equals: classDef type. self assert: CompiledCode typeOfClass equals: classDef type! Item was changed: + ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledMethod (in category 'tests - class type') ----- - ----- Method: MCClassDefinitionTest>>testKindOfSubclassForCompiledMethod (in category 'testing - class type') ----- testKindOfSubclassForCompiledMethod "CompiledCode and its subclasses are a special case." | classDef | classDef := self mockClass: #CompiledMethod super: #CompiledCode. self assert: #compiledMethod equals: classDef type. self assert: CompiledMethod typeOfClass equals: classDef type! Item was changed: + ----- Method: MCClassDefinitionTest>>testKindOfSubclassForSocketAddress (in category 'tests - class type') ----- - ----- Method: MCClassDefinitionTest>>testKindOfSubclassForSocketAddress (in category 'testing - class type') ----- testKindOfSubclassForSocketAddress "A subclass of ByteArray that is not treated specially" | classDef | classDef := self mockClass: #SocketAddress super: #ByteArray. self assert: #bytes equals: classDef type. self assert: SocketAddress typeOfClass equals: classDef type! Item was changed: + ----- Method: MCClassDefinitionTest>>testLoadAndUnload (in category 'tests') ----- - ----- Method: MCClassDefinitionTest>>testLoadAndUnload (in category 'testing') ----- testLoadAndUnload | d c | d := self mockClass: 'MCMockClassC' super: 'Object'. d load. self assert: (Smalltalk hasClassNamed: 'MCMockClassC'). c := (Smalltalk classNamed: 'MCMockClassC'). self assert: (c isKindOf: Class). self assert: c superclass = Object. self assert: c instVarNames isEmpty. self assert: c classVarNames isEmpty. self assert: c sharedPools isEmpty. self assert: c category = self mockCategoryName. self assert: c organization classComment = (self commentForClass: 'MCMockClassC'). self assert: c organization commentStamp = (self commentStampForClass: 'MCMockClassC'). d unload. self deny: (Smalltalk hasClassNamed: 'MCMockClassC').! Item was changed: + ----- Method: MCEnvironmentLoadTest>>testLoadIntoEnvironment (in category 'tests') ----- - ----- Method: MCEnvironmentLoadTest>>testLoadIntoEnvironment (in category 'testing') ----- testLoadIntoEnvironment [[MCPackageLoader installSnapshot: self mockSnapshot] valueSupplyingAnswers: #(('The pool dictionary*does not exist*automatically created?' true))] on: CurrentEnvironment do: [:e | e resume: environment]. self assert: (environment bindingOf: #MCMockClassA) notNil description: 'Environment has no binding for MCMockClassA'.! Item was changed: + ----- Method: MCFileInTest>>alterInitialState (in category 'private') ----- - ----- Method: MCFileInTest>>alterInitialState (in category 'testing') ----- alterInitialState self mockClassA touchCVar! Item was changed: + ----- Method: MCFileInTest>>assertFileOutFrom:canBeFiledInWith: (in category 'asserting') ----- - ----- Method: MCFileInTest>>assertFileOutFrom:canBeFiledInWith: (in category 'testing') ----- assertFileOutFrom: writerClass canBeFiledInWith: aBlock (writerClass on: stream) writeSnapshot: self mockSnapshot. self alterInitialState. self assertSuccessfulLoadWith: aBlock. self mockPackage unload. self assertSuccessfulLoadWith: aBlock. ! Item was changed: + ----- Method: MCFileInTest>>assertInitializersCalled (in category 'asserting') ----- - ----- Method: MCFileInTest>>assertInitializersCalled (in category 'testing') ----- assertInitializersCalled | cvar | cvar := self mockClassA cVar. self assert: cvar = #initialized! Item was changed: + ----- Method: MCFileInTest>>assertSuccessfulLoadWith: (in category 'asserting') ----- - ----- Method: MCFileInTest>>assertSuccessfulLoadWith: (in category 'testing') ----- assertSuccessfulLoadWith: aBlock stream reset. aBlock value. self assertNoChange. self assertInitializersCalled.! Item was changed: + ----- Method: MCFileInTest>>testStWriter (in category 'tests') ----- - ----- Method: MCFileInTest>>testStWriter (in category 'testing') ----- testStWriter <timeout: 30> "takes a little longer" self assertFileOutFrom: MCStWriter canBeFiledInWith: [stream fileIn]. ! Item was changed: + ----- Method: MCMcmUpdaterTest>>testDefault (in category 'tests') ----- - ----- Method: MCMcmUpdaterTest>>testDefault (in category 'testing') ----- testDefault | defaultMapFromPreference defaultURLFromPreference defaultUpdater | defaultMapFromPreference := MCMcmUpdater updateMapName. defaultURLFromPreference := MCMcmUpdater defaultUpdateURL. defaultUpdater := MCMcmUpdater default. "create and register" self assert: defaultMapFromPreference equals: defaultUpdater updateMapName. self assert: defaultURLFromPreference equals: defaultUpdater repository. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: defaultURLFromPreference) size = 1 ! Item was changed: + ----- Method: MCMcmUpdaterTest>>testRegistryIsBeingSaved (in category 'tests') ----- - ----- Method: MCMcmUpdaterTest>>testRegistryIsBeingSaved (in category 'testing') ----- testRegistryIsBeingSaved "setUp and tearDown save and restore the current state" self assert: MCMcmUpdater registry isNil! Item was changed: + ----- Method: MCMcmUpdaterTest>>testTwoUpdatersForOneRepository (in category 'tests') ----- - ----- Method: MCMcmUpdaterTest>>testTwoUpdatersForOneRepository (in category 'testing') ----- testTwoUpdatersForOneRepository | reg updater1 updater2 | reg := MCMcmUpdater registry. updater1 := MCMcmUpdater updateMapNamed: 'BAR' repository: 'FOO'. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: 'FOO') size = 1. updater2 := MCMcmUpdater updateMapNamed: 'BAZ' repository: 'FOO'. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: 'FOO') size = 2. updater1 unregister. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: 'FOO') size = 1. updater2 unregister. self assert: MCMcmUpdater registry isEmpty. self should: [MCMcmUpdater registry at: 'FOO'] raise: Error. ! Item was changed: + ----- Method: MCMcmUpdaterTest>>testTwoUpdatersInDifferentRepositories (in category 'tests') ----- - ----- Method: MCMcmUpdaterTest>>testTwoUpdatersInDifferentRepositories (in category 'testing') ----- testTwoUpdatersInDifferentRepositories | reg updater1 updater2 | reg := MCMcmUpdater registry. updater1 := MCMcmUpdater updateMapNamed: 'BAR' repository: 'FOO'. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: 'FOO') size = 1. updater2 := MCMcmUpdater updateMapNamed: 'BAZ' repository: 'FOO2'. self assert: MCMcmUpdater registry size = 2. self assert: (MCMcmUpdater registry at: 'FOO') size = 1. self assert: (MCMcmUpdater registry at: 'FOO2') size = 1. updater1 unregister. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: 'FOO2') size = 1. updater2 unregister. self assert: MCMcmUpdater registry isEmpty. self should: [MCMcmUpdater registry at: 'FOO'] raise: Error. self should: [MCMcmUpdater registry at: 'FOO2'] raise: Error. ! Item was changed: + ----- Method: MCMcmUpdaterTest>>testUpdatePreferences (in category 'tests') ----- - ----- Method: MCMcmUpdaterTest>>testUpdatePreferences (in category 'testing') ----- testUpdatePreferences | defaultMapFromPreference defaultURLFromPreference defaultUpdater | defaultMapFromPreference := MCMcmUpdater updateMapName. defaultURLFromPreference := MCMcmUpdater defaultUpdateURL. defaultUpdater := MCMcmUpdater default. "create and register" self assert: defaultMapFromPreference equals: defaultUpdater updateMapName. self assert: defaultURLFromPreference equals: defaultUpdater repository. self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: defaultURLFromPreference) size = 1. [ | newDefault | MCMcmUpdater updateMapName: 'NEWMAP'. "new instance not yet registered" self assert: MCMcmUpdater registry size = 1. self assert: (MCMcmUpdater registry at: defaultURLFromPreference) size = 1. self shouldnt: [MCMcmUpdater registry at: defaultURLFromPreference] raise: Error. self should: [(MCMcmUpdater registry at: defaultURLFromPreference) at: 'NEWMAP'] raise: Error. newDefault := MCMcmUpdater default. "create and register new default updater" self shouldnt: [(MCMcmUpdater registry at: defaultURLFromPreference) at: 'NEWMAP'] raise: Error. self assert: 'NEWMAP' equals: newDefault updateMapName. MCMcmUpdater defaultUpdateURL: 'NEWURL'. self assert: MCMcmUpdater registry size = 1. newDefault := MCMcmUpdater default. "create and register new default updater" self assert: MCMcmUpdater registry size = 2. self shouldnt: [(MCMcmUpdater registry at: 'NEWURL') at: 'NEWMAP'] raise: Error. self assert: 'NEWURL' equals: newDefault repository. self assert: 'NEWMAP' equals: newDefault updateMapName. ] ensure: [ "restore preferences" MCMcmUpdater updateMapName: defaultMapFromPreference. MCMcmUpdater defaultUpdateURL: defaultURLFromPreference ] ! Item was changed: + ----- Method: MCMczInstallerTest>>testInstallFromFile (in category 'tests') ----- - ----- Method: MCMczInstallerTest>>testInstallFromFile (in category 'testing') ----- testInstallFromFile MCMczWriter fileOut: expected on: self fileStream. MczInstaller installFileNamed: self fileName. self assertNoChange.! Item was changed: + ----- Method: MCMczInstallerTest>>testInstallFromStream (in category 'tests') ----- - ----- Method: MCMczInstallerTest>>testInstallFromStream (in category 'testing') ----- testInstallFromStream | stream | stream := RWBinaryOrTextStream on: String new. MCMczWriter fileOut: expected on: stream. MczInstaller installStream: stream reset. self assertNoChange. self assertVersionInfoPresent. ! Item was changed: + ----- Method: MCMethodDefinitionTest>>testCannotLoad (in category 'tests') ----- - ----- Method: MCMethodDefinitionTest>>testCannotLoad (in category 'testing') ----- testCannotLoad | definition | definition := self mockMethod: #kjahs87 class: 'NoSuchClass' source: 'kjahs87 ^self' meta: false. self should: [definition load] raise: Error. self assert: (navigation allImplementorsOf: #kjahs87) isEmpty! Item was changed: + ----- Method: MCMethodDefinitionTest>>testComparison (in category 'tests') ----- - ----- Method: MCMethodDefinitionTest>>testComparison (in category 'testing') ----- testComparison |d1 d2 d3 d4 d5 | d1 := self mockMethod: #one class: 'A' source: '1' meta: false. d2 := self mockMethod: #one class: 'A' source: '2' meta: false. d3 := self mockMethod: #one class: 'A' source: '1' meta: true. d4 := self mockMethod: #two class: 'A' source: '1' meta: false. d5 := self mockMethod: #two class: 'A' source: '1' meta: false. self assert: (d1 isRevisionOf: d2). self deny: (d1 isSameRevisionAs: d2). self deny: (d1 isRevisionOf: d3). self deny: (d1 isRevisionOf: d4). self assert: (d4 isSameRevisionAs: d5).! Item was changed: + ----- Method: MCMethodDefinitionTest>>testLoadAndUnload (in category 'tests') ----- - ----- Method: MCMethodDefinitionTest>>testLoadAndUnload (in category 'testing') ----- testLoadAndUnload |definition| definition := self mockMethod: #one class: 'MCMockClassA' source: 'one ^2' meta: false. self assert: self mockInstanceA one = 1. definition load. self assert: self mockInstanceA one = 2. definition unload. self deny: (self mockInstanceA respondsTo: #one)! Item was changed: + ----- Method: MCMethodDefinitionTest>>testPartiallyRevertOverrideMethod (in category 'tests') ----- - ----- Method: MCMethodDefinitionTest>>testPartiallyRevertOverrideMethod (in category 'testing') ----- testPartiallyRevertOverrideMethod | definition | self class compile: 'override ^ 2' classified: '*foobarbaz'. self class compile: 'override ^ 3' classified: self mockOverrideMethodCategory. self class compile: 'override ^ 4' classified: self mockOverrideMethodCategory. definition := (MethodReference class: self class selector: #override) asMethodDefinition. self assert: definition isOverrideMethod. self assert: self override = 4. definition unload. self assert: self override = 2. self assert: (MethodReference class: self class selector: #override) category = '*foobarbaz'. ! Item was changed: + ----- Method: MCMethodDefinitionTest>>testRevertOldMethod (in category 'tests') ----- - ----- Method: MCMethodDefinitionTest>>testRevertOldMethod (in category 'testing') ----- testRevertOldMethod | definition changeRecord | Object compile: 'yourself ^ self' classified: self mockOverrideMethodCategory. definition := (MethodReference class: Object selector: #yourself) asMethodDefinition. changeRecord := definition scanForPreviousVersions first. self assert: changeRecord notNil. self assert: changeRecord category = 'accessing'. changeRecord fileIn.! Item was changed: + ----- Method: MCMethodDefinitionTest>>testRevertOverrideMethod (in category 'tests') ----- - ----- Method: MCMethodDefinitionTest>>testRevertOverrideMethod (in category 'testing') ----- testRevertOverrideMethod | definition | self class compile: 'override ^ 2' classified: '*foobarbaz-override'. definition := (MethodReference class: self class selector: #override) asMethodDefinition. self assert: definition isOverrideMethod description: 'Method not marked as an override'. self assert: 2 equals: self override description: 'Method not overridden'. definition unload. self assert: 1 equals: self override description: 'Unload didn''t revert method'. self assert: 'mocks' equals: (MethodReference class: self class selector: #override) category description: 'Unload didn''t revert. method classification'. ! Item was changed: + ----- Method: MCOrganizationTest>>testReordering (in category 'tests') ----- - ----- Method: MCOrganizationTest>>testReordering (in category 'testing') ----- testReordering |dec cats newCats | dec := MCOrganizationDefinition categories: #(A B C). cats := #(X Y B Z C A Q). newCats := dec reorderCategories: cats original: #(B C A). self assert: newCats asArray = #(X Y A B C Z Q).! Item was changed: + ----- Method: MCOrganizationTest>>testReorderingWithNoCategoriesInVersion (in category 'tests') ----- - ----- Method: MCOrganizationTest>>testReorderingWithNoCategoriesInVersion (in category 'testing') ----- testReorderingWithNoCategoriesInVersion |dec cats newCats | dec := MCOrganizationDefinition categories: #(). cats := #(X Y B Z C A Q). newCats := dec reorderCategories: cats original: #(). self assert: newCats asArray = cats.! Item was changed: + ----- Method: MCOrganizationTest>>testReorderingWithRemovals (in category 'tests') ----- - ----- Method: MCOrganizationTest>>testReorderingWithRemovals (in category 'testing') ----- testReorderingWithRemovals |dec cats newCats | dec := MCOrganizationDefinition categories: #(A B C). cats := #(X Y B Z C A Q). newCats := dec reorderCategories: cats original: #(Y B C A Q). self assert: newCats asArray = #(X A B C Z).! Item was changed: + ----- Method: MCPatchTest>>testPatchContents (in category 'tests') ----- - ----- Method: MCPatchTest>>testPatchContents (in category 'testing') ----- testPatchContents self assert: patch operations size = 1. self assert: patch operations first isModification. self assert: patch operations first definition selector = #one. ! Item was changed: + ----- Method: MCSerializationTest>>testMcdSerialization (in category 'tests') ----- - ----- Method: MCSerializationTest>>testMcdSerialization (in category 'testing') ----- testMcdSerialization | stream expected actual | <timeout: 30> expected := self mockDiffyVersion. stream := RWBinaryOrTextStream on: String new. MCMcdWriter fileOut: expected on: stream. actual := MCMcdReader versionFromStream: stream reset. self assertVersion: actual matches: expected.! Item was changed: + ----- Method: MCSerializationTest>>testMczSerialization (in category 'tests') ----- - ----- Method: MCSerializationTest>>testMczSerialization (in category 'testing') ----- testMczSerialization <timeout: 30> self assertVersionsMatchWith: MCMczWriter. self assertExtensionProvidedBy: MCMczWriter. self assertVersionInfosMatchWith: MCMczWriter. self assertDependenciesMatchWith: MCMczWriter.! Item was changed: + ----- Method: MCSerializationTest>>testStSerialization (in category 'tests') ----- - ----- Method: MCSerializationTest>>testStSerialization (in category 'testing') ----- testStSerialization self assertSnapshotsMatchWith: MCStWriter.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testAnnotationPane (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testAnnotationPane (in category 'testing') ----- testAnnotationPane | oldPref | oldPref := Preferences annotationPanes. Preferences disable: #annotationPanes. self buildWindow. self assert: (self morphsOfClass: TextMorph) size = 1. Preferences enable: #annotationPanes. self buildWindow. self assert: (self morphsOfClass: TextMorph) size = 2. Preferences setPreference: #annotationPanes toValue: oldPref! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testCategorySelected (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testCategorySelected (in category 'testing') ----- testCategorySelected self clickOnListItem: self mockCategoryName. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self denyAListIncludesAnyOf: self allProtocols. self denyAListIncludesAnyOf: self allMethods. self assertTextIs: ''.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testClassSelected (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testClassSelected (in category 'testing') ----- testClassSelected self selectMockClassA. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self assertAListMatches: self classAProtocols. self denyAListIncludesAnyOf: self allMethods. self assertTextIs: self classADefinitionString.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testClassSideClassSelected (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testClassSideClassSelected (in category 'testing') ----- testClassSideClassSelected self clickOnButton: 'class'. self selectMockClassA. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self assertAListMatches: self classAClassProtocols. self denyAListIncludesAnyOf: self allMethods. self assertTextIs: self classADefinitionString.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testComment (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testComment (in category 'testing') ----- testComment self clickOnButton: '?'. self assertTextIs: ''. self clickOnListItem: self mockCategoryName. self assertTextIs: ''. self clickOnListItem: 'MCMockClassA'. self assertTextIs: self classAComment.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testFourColumns (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testFourColumns (in category 'testing') ----- testFourColumns self assert: self listMorphs size = 4.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testMethodIsCleared (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testMethodIsCleared (in category 'testing') ----- testMethodIsCleared self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockClassA'. self clickOnListItem: 'boolean'. self clickOnListItem: 'falsehood'. self clickOnListItem: '-- all --'. self denyAListHasSelection: 'falsehood'.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testMethodSelected (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testMethodSelected (in category 'testing') ----- testMethodSelected self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockClassA'. self clickOnListItem: 'boolean'. self clickOnListItem: 'falsehood'. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self assertAListMatches: self classAProtocols. self assertAListMatches: self classABooleanMethods. self assertTextIs: self falsehoodMethodSource.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testNoSelection (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testNoSelection (in category 'testing') ----- testNoSelection self assertAListMatches: self allCategories. self denyAListIncludesAnyOf: self definedClasses. self denyAListIncludesAnyOf: self allProtocols. self denyAListIncludesAnyOf: self allMethods. "and if there I need to see the packages scripts (or none)" self assertTextIs: '(package defines no scripts)'.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testProtocolIsCleared (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testProtocolIsCleared (in category 'testing') ----- testProtocolIsCleared self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockASubclass'. self clickOnListItem: 'as yet unclassified'. self clickOnListItem: 'MCMockClassA'. self denyAListHasSelection: 'as yet unclassified'.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testProtocolSelected (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testProtocolSelected (in category 'testing') ----- testProtocolSelected self clickOnListItem: self mockCategoryName. self clickOnListItem: 'MCMockClassA'. self clickOnListItem: 'boolean'. self assertAListMatches: self allCategories. self assertAListMatches: self definedClasses. self assertAListMatches: self classAProtocols. self assertAListMatches: self classABooleanMethods. self assertTextIs: ''. ! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testTextPane (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testTextPane (in category 'testing') ----- testTextPane "This shouldn't raise an exception." self textMorph.! Item was changed: + ----- Method: MCSnapshotBrowserTest>>testThreeButtons (in category 'tests') ----- - ----- Method: MCSnapshotBrowserTest>>testThreeButtons (in category 'testing') ----- testThreeButtons self assertButtonExists: 'instance'. self assertButtonExists: '?'. self assertButtonExists: 'class'.! Item was changed: + ----- Method: MCStWriterTest>>expectedInitializerA (in category 'data') ----- - ----- Method: MCStWriterTest>>expectedInitializerA (in category 'testing') ----- expectedInitializerA ^ 'MCMockClassA initialize'! Item was changed: ----- Method: MCStWriterTest>>expectedMethodDefinitionWithBangs (in category 'data') ----- expectedMethodDefinitionWithBangs ^' + !!MCStWriterTest methodsFor: ''data'' stamp: ''ar 1/4/2010 18:03''!! - !!MCStWriterTest methodsFor: ''testing'' stamp: ''ar 1/4/2010 18:03''!! methodWithBangs ^ '' ^ ReadStream on: ''''MCRevisionInfo packageName: ''''MonticelloCompatibilityTest''''!!!!!!!! MCOrganizationDeclaration categories: #( ''''Tests-Monticello-Mocks'''')!!!!!!!! MCClassDeclaration name: #MCMockClassD superclassName: #Object category: #''''Tests-Monticello-Mocks'''' instVarNames: #() comment: ''''''''!!!!!!!! MCMethodDeclaration className: #MCMockClassD selector: #one category: #''''as yet unclassified'''' timeStamp: ''''cwp 7/8/2003 21:21'''' source: ''''one ^ 1''''!!!!!!!! '''' '' !! !! '! Item was changed: + ----- Method: MCStWriterTest>>methodWithBangs (in category 'data') ----- - ----- Method: MCStWriterTest>>methodWithBangs (in category 'testing') ----- methodWithBangs ^ ' ^ ReadStream on: ''MCRevisionInfo packageName: ''MonticelloCompatibilityTest''!!!! MCOrganizationDeclaration categories: #( ''Tests-Monticello-Mocks'')!!!! MCClassDeclaration name: #MCMockClassD superclassName: #Object category: #''Tests-Monticello-Mocks'' instVarNames: #() comment: ''''!!!! MCMethodDeclaration className: #MCMockClassD selector: #one category: #''as yet unclassified'' timeStamp: ''cwp 7/8/2003 21:21'' source: ''one ^ 1''!!!! '' ' ! Item was changed: + ----- Method: MCStWriterTest>>setUp (in category 'running') ----- - ----- Method: MCStWriterTest>>setUp (in category 'testing') ----- setUp stream := RWBinaryOrTextStream on: String new. writer := MCStWriter on: stream. ! Item was changed: + ----- Method: MCStWriterTest>>tearDown (in category 'running') ----- - ----- Method: MCStWriterTest>>tearDown (in category 'testing') ----- tearDown SystemOrganizer default removeEmptyCategories. super tearDown ! Item was changed: + ----- Method: MCStWriterTest>>testClassDefinitionA (in category 'tests') ----- - ----- Method: MCStWriterTest>>testClassDefinitionA (in category 'testing') ----- testClassDefinitionA writer visitClassDefinition: (self mockClassA asClassDefinition). self assertContentsOf: stream match: self expectedClassDefinitionA. stream reset. 2 timesRepeat: [self assertChunkIsWellFormed: stream nextChunk]! Item was changed: + ----- Method: MCStWriterTest>>testClassDefinitionB (in category 'tests') ----- - ----- Method: MCStWriterTest>>testClassDefinitionB (in category 'testing') ----- testClassDefinitionB writer visitClassDefinition: (self mockClassB asClassDefinition). self assertContentsOf: stream match: self expectedClassDefinitionB. ! Item was changed: + ----- Method: MCStWriterTest>>testClassMethodDefinition (in category 'tests') ----- - ----- Method: MCStWriterTest>>testClassMethodDefinition (in category 'testing') ----- testClassMethodDefinition writer visitMethodDefinition: (MethodReference class: self mockClassA class selector: #one) asMethodDefinition. self assertContentsOf: stream match: self expectedClassMethodDefinition. stream reset. self assert: stream nextChunk isAllSeparators. self assertChunkIsWellFormed: stream nextChunk. self assertMethodChunkIsWellFormed: stream nextChunk. self assert: stream nextChunk isAllSeparators ! Item was changed: + ----- Method: MCStWriterTest>>testInitializerDefinition (in category 'tests') ----- - ----- Method: MCStWriterTest>>testInitializerDefinition (in category 'testing') ----- testInitializerDefinition |chunk lastChunk| writer writeSnapshot: self mockSnapshot. stream reset. [stream atEnd] whileFalse: [chunk := stream nextChunk. chunk isAllSeparators ifFalse: [lastChunk := chunk]]. self assertContentsOf: lastChunk readStream match: self expectedInitializerA! Item was changed: + ----- Method: MCStWriterTest>>testMethodDefinition (in category 'tests') ----- - ----- Method: MCStWriterTest>>testMethodDefinition (in category 'testing') ----- testMethodDefinition writer visitMethodDefinition: (MethodReference class: self mockClassA selector: #one) asMethodDefinition. self assertContentsOf: stream match: self expectedMethodDefinition. stream reset. self assert: stream nextChunk isAllSeparators. self assertChunkIsWellFormed: stream nextChunk. self assertMethodChunkIsWellFormed: stream nextChunk. self assert: stream nextChunk isAllSeparators ! Item was changed: + ----- Method: MCStWriterTest>>testMethodDefinitionWithBangs (in category 'tests') ----- - ----- Method: MCStWriterTest>>testMethodDefinitionWithBangs (in category 'testing') ----- testMethodDefinitionWithBangs writer visitMethodDefinition: (MethodReference class: self class selector: #methodWithBangs) asMethodDefinition. self assertContentsOf: stream match: self expectedMethodDefinitionWithBangs. stream reset. self assert: stream nextChunk isAllSeparators. self assertChunkIsWellFormed: stream nextChunk. self assertMethodChunkIsWellFormed: stream nextChunk. self assert: stream nextChunk isAllSeparators ! Item was changed: + ----- Method: MCStWriterTest>>testOrganizationDefinition (in category 'tests') ----- - ----- Method: MCStWriterTest>>testOrganizationDefinition (in category 'testing') ----- testOrganizationDefinition | definition | definition := MCOrganizationDefinition categories: (self mockPackage packageInfo systemCategories). writer visitOrganizationDefinition: definition. self assertContentsOf: stream match: self expectedOrganizationDefinition. self assertAllChunksAreWellFormed.! Item was changed: + ----- Method: MirrorPrimitiveTests>>expectedFailures (in category 'failures') ----- - ----- Method: MirrorPrimitiveTests>>expectedFailures (in category 'testing') ----- expectedFailures "All versions of Cog provide mirror primitive support. For the interpreter VM, support was added in version 4.7.19. Identify expected failures for older versions of the interpreter VM." ^Smalltalk isRunningCog ifTrue: [#()] ifFalse: [ | ver | [ver := VersionNumber fromString: Smalltalk vm interpreterSourceVersion. ((ver numbers first * 1000) + ver numbers second) >= 4008 ifTrue: [^#() "version 4.7.19 or greater with mirror primitive support"]] on: Warning do: ["primitiveInterpreterSourceVersion not available"]. ^#(testMirrorEqEq testMirrorPerform testMirrorSize) "older interpreter VMs"] ! Item was changed: + ----- Method: PCCByLiteralsTest>>setUp (in category 'running') ----- - ----- Method: PCCByLiteralsTest>>setUp (in category 'tests') ----- setUp super setUp. "disable external calls" (self class selectors select: [:sel | sel beginsWith: 'lDisabled']) do: [:sel | (self class >> sel) literals first at: 4 put: -2]! Item was changed: + ----- Method: SmalltalkImageTest>>testImageName (in category 'tests') ----- - ----- Method: SmalltalkImageTest>>testImageName (in category 'testing') ----- testImageName "Non regression test for http://bugs.squeak.org/view.php?id=7351" | shortImgName fullImgName fullChgName | shortImgName := 'Squeak3.10.2-7179-basic'. fullImgName := Smalltalk fullNameForImageNamed: shortImgName. fullChgName := Smalltalk fullNameForChangesNamed: shortImgName. FileDirectory splitName: fullImgName to: [:path :name | self assert: path = Smalltalk imagePath. self assert: name = 'Squeak3.10.2-7179-basic.image'.]. FileDirectory splitName: fullChgName to: [:path :name | self assert: path = Smalltalk imagePath. self assert: name = 'Squeak3.10.2-7179-basic.changes'.].! Item was changed: + ----- Method: SystemDictionaryTest>>testClassOrTraitNamedReturnsClassForClasses (in category 'tests - classes and traits') ----- - ----- Method: SystemDictionaryTest>>testClassOrTraitNamedReturnsClassForClasses (in category 'testing - classes and traits') ----- testClassOrTraitNamedReturnsClassForClasses self assert: Object == (Smalltalk globals classOrTraitNamed: 'Object'). self assert: Object == (Smalltalk globals classOrTraitNamed: #Object).! Item was changed: + ----- Method: SystemDictionaryTest>>testClassOrTraitNamedReturnsNilForGlobals (in category 'tests - classes and traits') ----- - ----- Method: SystemDictionaryTest>>testClassOrTraitNamedReturnsNilForGlobals (in category 'testing - classes and traits') ----- testClassOrTraitNamedReturnsNilForGlobals self assert: nil = (Smalltalk globals classOrTraitNamed: 'Undeclared'). self assert: nil = (Smalltalk globals classOrTraitNamed: #Undeclared).! |
Free forum by Nabble | Edit this page |