The Trunk: Compiler-ar.115.mcz

Andreas Raab uploaded a new version of Compiler to project The Trunk:
http://source.squeak.org/trunk/Compiler-ar.115.mcz

==================== Summary ====================

Name: Compiler-ar.115
Author: ar
Time: 4 January 2010, 4:27:09 am
UUID: 210eedd3-6a9f-f541-8699-2dbe477bb147
Ancestors: Compiler-ar.114

Making Tests unloadable: Move Compiler-Tests to Tests-Compiler.

=============== Diff against Compiler-ar.114 ===============

Item was changed:
  SystemOrganization addCategory: #'Compiler-Kernel'!
  SystemOrganization addCategory: #'Compiler-ParseNodes'!
  SystemOrganization addCategory: #'Compiler-Support'!
- SystemOrganization addCategory: #'Compiler-Tests'!
  SystemOrganization addCategory: #'Compiler-Syntax'!
  SystemOrganization addCategory: #'Compiler-Exceptions'!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesJAtoJM (in category 'tests') -----
- testDecompilerInClassesJAtoJM
- self decompileClassesSelect: [:cn| cn first = $J and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: ArrayLiteralTest>>tearDown (in category 'initialize-release') -----
- tearDown
- self class removeSelector: #array!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesWAtoWM (in category 'tests') -----
- testDecompilerInClassesWAtoWM
- self decompileClassesSelect: [:cn| cn first = $W and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- 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 removed:
- ----- Method: DecompilerTests>>blockingClasses (in category 'utilities') -----
- blockingClasses
-
-
- ^ #(CompiledMethod)!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesUNtoUZ (in category 'tests') -----
- testDecompilerInClassesUNtoUZ
- self decompileClassesSelect: [:cn| cn first = $U and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest>>supportTestSourceRangeAccessForInjectInto:source:selectionSequence: (in category 'tests') -----
- supportTestSourceRangeAccessForInjectInto: method source: source selectionSequence: selections
- "Test debugger source range selection for inject:into:"
- | evaluationCount sourceMap debugTokenSequence debugCount |
- DebuggerMethodMap voidMapCache.
- evaluationCount := 0.
- sourceMap := method debuggerMap abstractSourceMap.
- debugTokenSequence := selections collect: [:string| Scanner new scanTokens: string].
- debugCount := 0.
- thisContext
- runSimulated: [(1 to: 2)
- withArgs:
- { 0.
- [:sum :each|
- evaluationCount := evaluationCount + 1.
- sum + each]}
- executeMethod: method]
- contextAtEachStep:
- [:ctxt| | range debugTokens |
- (ctxt method == method
- and: ["Exclude the send of #blockCopy: or #closureCopy:copiedValues: and braceWith:with:
-    to create the block, and the #new: and #at:'s for the indirect temp vector.
-   This for compilation without closure bytecodes. (Note that at:put:'s correspond to stores)"
- (ctxt willSend
- and: [(#(closureCopy:copiedValues: blockCopy: new: at: braceWith:with:) includes: ctxt selectorToSendOrSelf) not])
- "Exclude the store of the argument into the home context (for BlueBook blocks)
- and the store of an indirection vector into an initial temp"
- or: [(ctxt willStore
- and: [(ctxt isBlock and: [ctxt pc = ctxt startpc]) not
- and: [(ctxt isBlock not
- and: [(method usesClosureBytecodes and: [ctxt abstractPC = 2])]) not]])
- or: [ctxt willReturn]]]) ifTrue:
- [debugTokens := debugTokenSequence at: (debugCount := debugCount + 1) ifAbsent: [#(bogusToken)].
- self assert: (sourceMap includesKey: ctxt abstractPC).
- range := sourceMap at: ctxt abstractPC ifAbsent: [(1 to: 0)].
- self assert: (Scanner new scanTokens: (source copyFrom: range first to: range last)) = debugTokens]].
- self assert: evaluationCount = 2!

Item was removed:
- ----- 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 removed:
- TestCase subclass: #ArrayLiteralTest
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Compiler-Tests'!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesGNtoGZ (in category 'tests') -----
- testDecompilerInClassesGNtoGZ
- self decompileClassesSelect: [:cn| cn first = $G and: [cn second asUppercase > $M]]!

Item was removed:
- TestCase subclass: #CompilerExceptionsTest
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Compiler-Tests'!

Item was removed:
- ----- Method: ClosureCompilerTest>>supportTestSourceRangeAccessForDecompiledInjectInto:source: (in category 'tests') -----
- supportTestSourceRangeAccessForDecompiledInjectInto: method source: source
- "Test debugger source range selection for inject:into:"
- ^self
- supportTestSourceRangeAccessForInjectInto: method
- source: source
- selectionSequence: #( ':= t1'
- 'do: [:t4 | t3 := t2 value: t3 value: t4]'
- 'value: t3 value: t4'
- ':= t2 value: t3 value: t4'
- ']'
- 'value: t3 value: t4'
- ':= t2 value: t3 value: t4'
- ']'
- '^t3')!

Item was removed:
- TestCase subclass: #MirrorPrimitiveTests
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Compiler-Tests'!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesFAtoFM (in category 'tests') -----
- testDecompilerInClassesFAtoFM
- self decompileClassesSelect: [:cn| cn first = $F and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesSAtoSM (in category 'tests') -----
- testDecompilerInClassesSAtoSM
- self decompileClassesSelect: [:cn| cn first = $S and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: MethodHighlightingTests>>testMethodHighlighting (in category 'tests') -----
- testMethodHighlighting
- | map before after method retpc |
- "Test the highlighting of the asXML method.  Test the highlighting of the return
- statement which should include the whole block supplied to streamContents:."
- "DebuggerMethodMap voidMapCache"
- "DebuggerMethodMap forMethod: MethodHighlightingTests >> #asXML"
- method := MethodHighlightingTests >> #asXML.
- map := DebuggerMethodMap forMethod: method.
- retpc := method endPC.
- before := map rangeForPC: retpc contextIsActiveContext: false.
- map instVarNamed: 'abstractSourceRanges' put: nil.
- after := map rangeForPC: retpc contextIsActiveContext: false.
- self assert: before size > 500.
- self assert: before = after!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesQNtoQZ (in category 'tests') -----
- testDecompilerInClassesQNtoQZ
- self decompileClassesSelect: [:cn| cn first = $Q and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest class>>methodWithCopiedTemps (in category 'code examples') -----
- methodWithCopiedTemps
- | a b c r |
- a := 1.
- b := 2.
- c := 4.
- r := [a + b + c] value.
- b := nil.
- r
-
- "Parser new
- parse: (self class sourceCodeAt: #methodWithCopiedTemps)
- class: self class"
-
- "(Parser new
- encoderClass: EncoderForV3;
- parse: (self class sourceCodeAt: #methodWithCopiedTemps)
- class: self class) generateUsingClosures: #(0 0 0 0)"!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesCNtoCZ (in category 'tests') -----
- testDecompilerInClassesCNtoCZ
- self decompileClassesSelect: [:cn| cn first = $C and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest class>>methodWithOptimizedBlocksA (in category 'code examples') -----
- methodWithOptimizedBlocksA
- | s c |
- s := self isNil
- ifTrue: [| a | a := 'isNil'. a]
- ifFalse: [| a | a := 'notNil'. a].
- c := String new: s size.
- 1 to: s size do:
- [:i| c at: i put: (s at: i)].
- ^c
-
- "Parser new
- parse: (self class sourceCodeAt: #methodWithOptimizedBlocksA)
- class: self class"!

Item was removed:
- ----- Method: ClosureCompilerTest>>testInlineBlockCollectionSD1 (in category 'tests') -----
- testInlineBlockCollectionSD1
- | a1 b1 a2 b2 |
- b1 := OrderedCollection new.
- 1 to: 3 do:
- [:i |
- a1 := i.
- b1 add: [a1]].
- b1 := b1 asArray collect: [:b | b value].
- b2 := OrderedCollection new.
- 1 to: 3 do:
- [:i |
- a2 := i.
- b2 add: [a2]] yourself. "defeat optimization"
- b2 := b2 asArray collect: [:b | b value].
- self assert: b1 = b2!

Item was removed:
- TestCase subclass: #ClosureCompilerTest
- instanceVariableNames: ''
- classVariableNames: 'CmpRR CogRTLOpcodes Jump MoveCqR Nop'
- poolDictionaries: ''
- category: 'Compiler-Tests'!

Item was removed:
- ----- Method: ClosureTests>>setUp (in category 'running') -----
- setUp
- super setUp.
- collection := OrderedCollection new!

Item was removed:
- ----- Method: ClosureCompilerTest>>doTestDebuggerTempAccessWith:with: (in category 'tests') -----
- doTestDebuggerTempAccessWith: one with: two
- "Test debugger access for temps"
- | outerContext local1 remote1 |
- outerContext := thisContext.
- local1 := 3.
- remote1 := 1/2.
- self assert: (Compiler new evaluate: 'one' in: thisContext to: self) == one.
- self assert: (Compiler new evaluate: 'two' in: thisContext to: self) == two.
- self assert: (Compiler new evaluate: 'local1' in: thisContext to: self) == local1.
- self assert: (Compiler new evaluate: 'remote1' in: thisContext to: self) == remote1.
- Compiler new evaluate: 'local1 := -3.0' in: thisContext to: self.
- self assert: local1 = -3.0.
- (1 to: 2) do:
- [:i| | local2 r1 r2 r3 r4 |
- local2 := i * 3.
- remote1 := local2 / 7.
- self assert: thisContext ~~ outerContext.
- self assert: (r1 := Compiler new evaluate: 'one' in: thisContext to: self) == one.
- self assert: (r2 := Compiler new evaluate: 'two' in: thisContext to: self) == two.
- self assert: (r3 := Compiler new evaluate: 'i' in: thisContext to: self) == i.
- self assert: (r4 := Compiler new evaluate: 'local2' in: thisContext to: self) == local2.
- self assert: (r4 := Compiler new evaluate: 'remote1' in: thisContext to: self) == remote1.
- self assert: (r4 := Compiler new evaluate: 'remote1' in: outerContext to: self) == remote1.
- Compiler new evaluate: 'local2 := 15' in: thisContext to: self.
- self assert: local2 = 15.
- Compiler new evaluate: 'local1 := 25' in: thisContext to: self.
- self assert: local1 = 25.
- { r1. r2. r3. r4 } "placate the compiler"].
- self assert: local1 = 25.
- self assert: remote1 = (6/7)!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesBAtoBM (in category 'tests') -----
- testDecompilerInClassesBAtoBM
- self decompileClassesSelect: [:cn| cn first = $B and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesOAtoOM (in category 'tests') -----
- testDecompilerInClassesOAtoOM
- self decompileClassesSelect: [:cn| cn first = $O and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- 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 removed:
- ClosureCompilerTest subclass: #MethodHighlightingTests
- instanceVariableNames: 'creator timeStamp duration tracks'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Compiler-Tests'!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesMNtoMZ (in category 'tests') -----
- testDecompilerInClassesMNtoMZ
- self decompileClassesSelect: [:cn| cn first = $M and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesZNtoZZ (in category 'tests') -----
- testDecompilerInClassesZNtoZZ
- self decompileClassesSelect: [:cn| cn first = $Z and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest>>testInlineBlockCollectionLR3 (in category 'tests') -----
- testInlineBlockCollectionLR3
- | col |
- col := OrderedCollection new.
- 1 to: 11 do: [ :each | | i | i := each. col add: [ i ]. i := i + 1 ].
- self assert: (col collect: [ :each | each value ]) asArray = (2 to: 12) asArray!

Item was removed:
- ----- Method: ClosureCompilerTest>>testInjectIntoDecompiledDebugs (in category 'tests') -----
- testInjectIntoDecompiledDebugs
- "Test various debugs of the decompiled form debug correctly."
- "self new testInjectIntoDecompiledDebugs"
- | source |
- source := (Collection sourceCodeAt: #inject:into:) asString.
- { Encoder.
-   EncoderForV3PlusClosures. EncoderForLongFormV3PlusClosures } do:
- [:encoderClass| | method |
- method := (Parser new
- encoderClass: encoderClass;
- parse: source
- class: Collection)
- generate.
- self supportTestSourceRangeAccessForDecompiledInjectInto: method source: method decompileString]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesLNtoLZ (in category 'tests') -----
- testDecompilerInClassesLNtoLZ
- self decompileClassesSelect: [:cn| cn first = $L and: [cn second asUppercase > $M]]!

Item was removed:
- TestCase subclass: #ClosureTests
- instanceVariableNames: 'collection'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Compiler-Tests'!

Item was removed:
- TestCase subclass: #CompilerTest
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Compiler-Tests'!
-
- !CompilerTest commentStamp: 'nice 12/3/2007 22:15' prior: 0!
- CompilerTest is a holder for SUnit test of Compiler!

Item was removed:
- ----- Method: ClosureCompilerTest>>testSourceRangeAccessForClosureLongFormBytecodeInjectInto (in category 'tests') -----
- testSourceRangeAccessForClosureLongFormBytecodeInjectInto
- "Test debugger source range selection for inject:into: for a version compiled with closures"
- "self new testSourceRangeAccessForClosureLongFormBytecodeInjectInto"
- | source method |
- source := (Collection sourceCodeAt: #inject:into:) asString.
- method := (Parser new
- encoderClass: EncoderForLongFormV3PlusClosures;
- parse: source
- class: Collection)
- generate: (Collection compiledMethodAt: #inject:into:) trailer.
- self supportTestSourceRangeAccessForInjectInto: method source: source!

Item was removed:
- ----- Method: CompilerExceptionsTest>>selectFrom:to: (in category 'emulating') -----
- selectFrom: start to: end
- !

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesYAtoYM (in category 'tests') -----
- testDecompilerInClassesYAtoYM
- self decompileClassesSelect: [:cn| cn first = $Y and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- 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 removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesKAtoKM (in category 'tests') -----
- testDecompilerInClassesKAtoKM
- self decompileClassesSelect: [:cn| cn first = $K and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesXAtoXM (in category 'tests') -----
- testDecompilerInClassesXAtoXM
- self decompileClassesSelect: [:cn| cn first = $X and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: ClosureTests>>evaluateCopyOf: (in category 'utilities') -----
- evaluateCopyOf: aBlock
- aBlock copy value!

Item was removed:
- ----- Method: ClosureCompilerTest class>>methodWithVariousTemps (in category 'code examples') -----
- methodWithVariousTemps
- | classes total totalLength |
- classes := self withAllSuperclasses.
- total := totalLength := 0.
- classes do: [:class| | className |
- className := class name.
- total := total + 1.
- totalLength := totalLength + className size].
- ^total -> totalLength
-
- "Parser new
- parse: (self class sourceCodeAt: #methodWithVariousTemps)
- class: self class"!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesINtoIZ (in category 'tests') -----
- testDecompilerInClassesINtoIZ
- self decompileClassesSelect: [:cn| cn first = $I and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesVNtoVZ (in category 'tests') -----
- testDecompilerInClassesVNtoVZ
- self decompileClassesSelect: [:cn| cn first = $V and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: DecompilerTests>>decompileClassesSelect: (in category 'utilities') -----
- decompileClassesSelect: aBlock
-
- (Smalltalk classNames select: aBlock) do:
- [:cn | | cls |
- cls := Smalltalk at: cn.
- Smalltalk garbageCollect.
- Transcript cr; show: cn.
- cls selectorsDo:
- [:selector | | methodNode oldMethod newMethod oldCodeString newCodeString |
- (self isFailure: cls sel: selector) ifFalse:
- [" to help making progress
- (self
- isStoredProblems: cls theNonMetaClass
- sel: selector
- meta: cls isMeta)
- ifFalse: [ "
- Transcript nextPut: $.; flush.
- self checkDecompileMethod: (cls compiledMethodAt: selector)]]]!

Item was removed:
- ----- Method: CompilerExceptionsTest>>testUnknownSelector (in category 'tests') -----
- testUnknownSelector
- self
- should:
- [self class
- compile: 'griffle self reallyHopeThisIsntImplementedAnywhere'
- notifying: self]
- raise: UnknownSelector!

Item was removed:
- ----- 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 removed:
- ----- Method: ClosureCompilerTest>>testInlineBlockCollectionLR2 (in category 'tests') -----
- testInlineBlockCollectionLR2
- "Test case from Lukas Renggli"
- | col |
- col := OrderedCollection new.
- 1 to: 11 do: [ :each | #(1) do: [:ignored| col add: [ each ]] ].
- self assert: (col collect: [ :each | each value ]) asArray = (1 to: 11) asArray!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesHNtoHZ (in category 'tests') -----
- testDecompilerInClassesHNtoHZ
- self decompileClassesSelect: [:cn| cn first = $H and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest>>testBlockNumberingForInjectInto (in category 'tests') -----
- testBlockNumberingForInjectInto
- "Test that the compiler and CompiledMethod agree on the block numbering of Collection>>inject:into:
- and that temp names for inject:into: are recorded."
- "self new testBlockNumberingForInjectInto"
- | methodNode method tempRefs |
- methodNode := Parser new
- encoderClass: EncoderForV3PlusClosures;
- parse: (Collection sourceCodeAt: #inject:into:)
- class: Collection.
- method := methodNode generate.
- tempRefs := methodNode encoder blockExtentsToTempsMap.
- self assert: tempRefs keys asSet = method startpcsToBlockExtents values asSet.
- self assert: ((tempRefs includesKey: (0 to: 6))
- and: [(tempRefs at: (0 to: 6)) hasEqualElements: #(('thisValue' 1) ('binaryBlock' 2) ('nextValue' (3 1)))]).
- self assert: ((tempRefs includesKey: (2 to: 4))
- and: [(tempRefs at: (2 to: 4)) hasEqualElements: #(('each' 1) ('binaryBlock' 2) ('nextValue' (3 1)))])!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesUAtoUM (in category 'tests') -----
- testDecompilerInClassesUAtoUM
- self decompileClassesSelect: [:cn| cn first = $U and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- 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 removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesGAtoGM (in category 'tests') -----
- testDecompilerInClassesGAtoGM
- self decompileClassesSelect: [:cn| cn first = $G and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- 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 removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesTAtoTM (in category 'tests') -----
- testDecompilerInClassesTAtoTM
- self decompileClassesSelect: [:cn| cn first = $T and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: DecompilerTestFailuresCollector>>failures (in category 'accessing') -----
- failures
- ^failures!

Item was removed:
- ----- Method: ClosureCompilerTest>>testSourceRangeAccessForInjectInto (in category 'tests') -----
- testSourceRangeAccessForInjectInto
- "Test debugger source range selection for inject:into: for the current version of the method"
- "self new testSourceRangeAccessForInjectInto"
- self supportTestSourceRangeAccessForInjectInto: (Collection compiledMethodAt: #inject:into:)
- source: (Collection sourceCodeAt: #inject:into:) asString!

Item was removed:
- ----- Method: MirrorPrimitiveTests>>testMirrorSize (in category 'tests') -----
- testMirrorSize
- | stackpBefore stackpAfter |
- stackpBefore := thisContext stackPtr.
- self assert: (thisContext objectSize: #(1 2 3)) = 3.
- self assert: (thisContext objectSize: '123') = 3.
- self assert: (thisContext objectSize: nil) = 0.
- self assert: (thisContext objectSize: 1) = 0.
- stackpAfter := thisContext stackPtr.
- self assert: stackpBefore = stackpAfter. "Make sure primitives pop all their arguments"!

Item was removed:
- ----- 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 removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesENtoEZ (in category 'tests') -----
- testDecompilerInClassesENtoEZ
- self decompileClassesSelect: [:cn| cn first = $E and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesRNtoRZ (in category 'tests') -----
- testDecompilerInClassesRNtoRZ
- self decompileClassesSelect: [:cn| cn first = $R and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ArrayLiteralTest>>testSymbols (in category 'tests') -----
- testSymbols
- self class compile: 'array ^ #(#nil #true #false #''nil'' #''true'' #''false'')'.
- self assert: self array = {#nil. #true. #false. #nil. #true. #false}.!

Item was removed:
- ----- 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 removed:
- ----- Method: ClosureCompilerTest class>>methodWithCopiedAndPostClosedOverAssignedTemps (in category 'code examples') -----
- methodWithCopiedAndPostClosedOverAssignedTemps
- | blk a b c r1 r2 |
- a := 1.
- b := 2.
- c := 4.
- blk := [a + b + c].
- r1 := blk value.
- b := nil.
- r2 := blk value.
- r1 -> r2
-
- "(Parser new
- encoderClass: EncoderForV3;
- parse: (self class sourceCodeAt: #methodWithCopiedAndPostClosedOverAssignedTemps)
- class: self class) generateUsingClosures: #(0 0 0 0)"!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesDNtoDZ (in category 'tests') -----
- testDecompilerInClassesDNtoDZ
- self decompileClassesSelect: [:cn| cn first = $D and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest>>testInlineBlockCollectionLR1 (in category 'tests') -----
- testInlineBlockCollectionLR1
- "Test case from Lukas Renggli"
- | col |
- col := OrderedCollection new.
- 1 to: 11 do: [ :each | col add: [ each ] ].
- self assert: (col collect: [ :each | each value ]) asArray = (1 to: 11) asArray!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesQAtoQM (in category 'tests') -----
- testDecompilerInClassesQAtoQM
- self decompileClassesSelect: [:cn| cn first = $Q and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: ClosureTests>>testCopyNonLocalReturn (in category 'testing') -----
- testCopyNonLocalReturn
- self
- shouldnt: [self methodWithNonLocalReturn]
- raise: Error!

Item was removed:
- ----- Method: MirrorPrimitiveTests>>expectedFailures (in category 'testing') -----
- expectedFailures
-
- ^#(testMirrorAt testMirrorEqEq testMirrorInstVarAt testMirrorPerform testMirrorSize)!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesCAtoCM (in category 'tests') -----
- testDecompilerInClassesCAtoCM
- self decompileClassesSelect: [:cn| cn first = $C and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesPAtoPM (in category 'tests') -----
- testDecompilerInClassesPAtoPM
- self decompileClassesSelect: [:cn| cn first = $P and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: CompilerExceptionsTest>>select (in category 'emulating') -----
- select
- !

Item was removed:
- ----- Method: ClosureCompilerTest>>testSourceRangeAccessForBlueBookInjectInto (in category 'tests') -----
- testSourceRangeAccessForBlueBookInjectInto
- "Test debugger source range selection for inject:into: for a version compiled with closures"
- "self new testSourceRangeAccessForBlueBookInjectInto"
- | source method |
- source := (Collection sourceCodeAt: #inject:into:) asString.
- method := (Parser new
- encoderClass: EncoderForV3;
- parse: source
- class: Collection)
- generate: (Collection compiledMethodAt: #inject:into:) trailer.
- self supportTestSourceRangeAccessForInjectInto: method source: source!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesANtoAZ (in category 'tests') -----
- testDecompilerInClassesANtoAZ
- self decompileClassesSelect: [:cn| cn first = $A and: [cn second asUppercase > $M]]!

Item was removed:
- ----- 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 removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesNNtoNZ (in category 'tests') -----
- testDecompilerInClassesNNtoNZ
- self decompileClassesSelect: [:cn| cn first = $N and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest>>testBlockNumbering (in category 'tests') -----
- testBlockNumbering
- "Test that the compiler and CompiledMethod agree on the block numbering of a substantial doit."
- "self new testBlockNumbering"
- | methodNode method tempRefs |
- methodNode :=
- Parser new
- encoderClass: EncoderForV3PlusClosures;
- parse: 'foo
- | numCopiedValuesCounts |
- numCopiedValuesCounts := Dictionary new.
- 0 to: 32 do: [:i| numCopiedValuesCounts at: i put: 0].
- Transcript clear.
- Smalltalk allClasses remove: GeniePlugin; do:
- [:c|
- {c. c class} do:
- [:b|
- Transcript nextPut: b name first; endEntry.
- b selectorsAndMethodsDo:
- [:s :m| | pn |
- m isQuick not ifTrue:
- [pn := b parserClass new
- encoderClass: EncoderForV3PlusClosures;
- parse: (b sourceCodeAt: s)
- class: b.
- pn generate.
- [pn accept: nil]
- on: MessageNotUnderstood
- do: [:ex| | msg numCopied |
- msg := ex message.
- (msg selector == #visitBlockNode:
- and: [(msg argument instVarNamed: ''optimized'') not]) ifTrue:
- [numCopied := (msg argument computeCopiedValues: pn) size.
- numCopiedValuesCounts
- at: numCopied
- put: (numCopiedValuesCounts at: numCopied) + 1].
- msg setSelector: #==.
- ex resume: nil]]]]].
- numCopiedValuesCounts'
- class: Object.
- method := methodNode generate.
- tempRefs := methodNode encoder blockExtentsToTempsMap.
- self assert: tempRefs keys asSet = method startpcsToBlockExtents values asSet!

Item was removed:
- ----- Method: MirrorPrimitiveTests>>testMirrorClass (in category 'tests') -----
- testMirrorClass
- | stackpBefore stackpAfter |
- stackpBefore := thisContext stackPtr.
- self assert: (thisContext objectClass: Array new) = Array.
- self assert: (thisContext objectClass: 1) = 1 class.
- self assert: (thisContext objectClass: ProtoObject new) = ProtoObject.
- stackpAfter := thisContext stackPtr.
- self assert: stackpBefore = stackpAfter "Make sure primitives pop all their arguments"!

Item was removed:
- ----- Method: MethodHighlightingTests>>asXML (in category 'tests') -----
- asXML
- "self new asXML"
- "Convert the master index into external XML representation"
-
- ^String streamContents:[:s| | writer |
- writer := self xmlWriter on: s.
- writer xmlDeclaration: '1.0'.
- writer startTag: 'recording'; endTag.
- writer tag: 'creator' pcData: creator.
- writer tag: 'timestamp' pcData: timeStamp.
- writer tag: 'duration' pcData: duration.
- writer startTag: 'tracks'; endTag.
- tracks do:[:tdata|
- writer startTag: 'track'; attribute: 'type' value: tdata value; endTag.
- writer pcData: tdata key.
- writer endTag: 'track'.
- ].
- writer endTag: 'tracks'.
- writer endTag: 'recording'.
- ].
- !

Item was removed:
- ----- Method: MirrorPrimitiveTests>>testMirrorInstVarAt (in category 'tests') -----
- testMirrorInstVarAt
- | stackpBefore stackpAfter array point |
- stackpBefore := thisContext stackPtr.
- array := { 1. 2. 3 }.
- point := Point x: 1 y: 2.
- self assert: (thisContext object: array instVarAt: 1) = 1.
- self assert: (thisContext object: point instVarAt: 2) = 2.
- thisContext object: array instVarAt: 2 put: #two.
- self assert: array = #(1 #two 3).
- thisContext object: point instVarAt: 1 put: 1/2.
- self assert: point = (Point x: 1 / 2 y: 2).
- stackpAfter := thisContext stackPtr.
- self assert: stackpBefore = stackpAfter. "Make sure primitives pop all their arguments"
- self should: [thisContext object: array instVarAt: 4] raise: Error.
- self should: [thisContext object: point instVarAt: 3] raise: Error!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesMAtoMM (in category 'tests') -----
- testDecompilerInClassesMAtoMM
- self decompileClassesSelect: [:cn| cn first = $M and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesZAtoZM (in category 'tests') -----
- testDecompilerInClassesZAtoZM
- self decompileClassesSelect: [:cn| cn first = $Z and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest>>supportTestSourceRangeAccessForInjectInto:source: (in category 'tests') -----
- supportTestSourceRangeAccessForInjectInto: method source: source
- "Test debugger source range selection for inject:into:"
- ^self
- supportTestSourceRangeAccessForInjectInto: method
- source: source
- selectionSequence: #( ':= thisValue'
- 'do: [:each | nextValue := binaryBlock value: nextValue value: each]'
- 'value: nextValue value: each'
- ':= binaryBlock value: nextValue value: each'
- 'nextValue := binaryBlock value: nextValue value: each'
- 'value: nextValue value: each'
- ':= binaryBlock value: nextValue value: each'
- 'nextValue := binaryBlock value: nextValue value: each'
- '^nextValue')!

Item was removed:
- ----- Method: CompilerExceptionsTest>>selectionInterval (in category 'emulating') -----
- selectionInterval
- ^ 1 to: 0!

Item was removed:
- ----- Method: ArrayLiteralTest>>testReservedIdentifiers (in category 'tests') -----
- testReservedIdentifiers
- self class compile: 'array ^ #(nil true false)'.
- self assert: self array = {nil. true. false}.!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesLAtoLM (in category 'tests') -----
- testDecompilerInClassesLAtoLM
- self decompileClassesSelect: [:cn| cn first = $L and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesXNtoXZ (in category 'tests') -----
- testDecompilerInClassesXNtoXZ
- self decompileClassesSelect: [:cn| cn first = $X and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest>>closureCases (in category 'source') -----
- closureCases
- ^#(
- '| n |
- n := 1.
- ^n + n'
-
- '| i |
- i := 0.
- [i := i + 1.
-  i <= 10] whileTrue.
- ^i'
-
- '[:c :s| | mn |
- mn := Compiler new
- compile: (c sourceCodeAt: s)
- in: c
- notifying: nil
- ifFail: [self halt].
- mn generate: #(0 0 0 0).
- {mn blockExtentsToTempsMap.
-   mn encoder schematicTempNames}]
- value: AbstractInstructionTests
- value: #runBinaryConditionalJumps:'
-
- 'inject: thisValue into: binaryBlock
- | nextValue |
- nextValue := thisValue.
- self do: [:each | nextValue := binaryBlock value: nextValue value: each].
- ^nextValue'
-
- 'runBinaryConditionalJumps: assertPrintBar
- "CogIA32CompilerTests new runBinaryConditionalJumps: false"
- | mask reg1 reg2 reg3 |
- mask := 1 << self processor bitsInWord - 1.
- self concreteCompilerClass dataRegistersWithAccessorsDo:
- [:n :get :set|
- n = 0 ifTrue: [reg1 := get].
- n = 1 ifTrue: [reg2 := set].
- n = 2 ifTrue: [reg3 := set]].
- #( (JumpAbove > unsigned) (JumpBelowOrEqual <= unsigned)
- (JumpBelow < unsigned) (JumpAboveOrEqual >= unsigned)
- (JumpGreater > signed) (JumpLessOrEqual <= signed)
- (JumpLess < signed) (JumpGreaterOrEqual >= signed)
- (JumpZero = signed) (JumpNonZero ~= signed)) do:
- [:triple|
- [:opName :relation :signednessOrResult| | opcode jumpNotTaken jumpTaken nop memory bogus |
- self resetGen.
- opcode := CogRTLOpcodes classPool at: opName.
- self gen: CmpRR operand: 2 operand: 1.
- jumpTaken := self gen: opcode.
- self gen: MoveCqR operand: 0 operand: 0.
- jumpNotTaken := self gen: Jump.
- jumpTaken jmpTarget: (self gen: MoveCqR operand: 1 operand: 0).
- jumpNotTaken jmpTarget: (nop := self gen: Nop).
- memory := self generateInstructions.
- bogus := false.
- self pairs: (-2 to: 2)  do:
- [:a :b| | taken |
- self processor
- reset;
- perform: reg2 with: a signedIntToLong;
- perform: reg3 with: b signedIntToLong.
- [self processor singleStepIn: memory.
- self processor pc ~= nop address] whileTrue.
- taken := (self processor perform: reg1) = 1.
- assertPrintBar
- ifTrue:
- [self assert: taken = (signednessOrResult == #unsigned
- ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)]
- ifFalse: [a perform: relation with: b])]
- ifFalse:
- [Transcript
- nextPutAll: reg2; nextPut: $(; print: a; nextPutAll: '') ''; nextPutAll: relation; space;
- nextPutAll: reg3; nextPut: $(; print: b; nextPutAll: '') = '';
- print: taken; cr; flush.
- taken = (signednessOrResult == #unsigned
- ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)]
- ifFalse: [a perform: relation with: b]) ifFalse:
- [bogus := true]]].
- bogus ifTrue:
- [self processor printRegistersOn: Transcript.
- Transcript show: (self processor disassembleInstructionAt: jumpTaken address In: memory); cr]]
- valueWithArguments: triple]'
-
- 'mapFromBlockStartsIn: aMethod toTempVarsFrom: schematicTempNamesString constructor: aDecompilerConstructor
- | map |
- map := aMethod
- mapFromBlockKeys: aMethod startpcsToBlockExtents keys asSortedCollection
- toSchematicTemps: schematicTempNamesString.
- map keysAndValuesDo:
- [:startpc :tempNameTupleVector| | subMap tempVector numTemps |
- subMap := Dictionary new.
- "Find how many temp slots there are (direct & indirect temp vectors)
- and for each indirect temp vector find how big it is."
- tempNameTupleVector do:
- [:tuple|
- tuple last isArray
- ifTrue:
- [subMap at: tuple last first put: tuple last last.
- numTemps := tuple last first]
- ifFalse:
- [numTemps := tuple last]].
- "create the temp vector for this scope level."
- tempVector := Array new: numTemps.
- "fill it in with any indirect temp vectors"
- subMap keysAndValuesDo:
- [:index :size|
- tempVector at: index put: (Array new: size)].
- "fill it in with temp nodes."
- tempNameTupleVector do:
- [:tuple| | itv |
- tuple last isArray
- ifTrue:
- [itv := tempVector at: tuple last first.
- itv at: tuple last last
- put: (aDecompilerConstructor
- codeTemp: tuple last last - 1
- named: tuple first)]
- ifFalse:
- [tempVector
- at: tuple last
- put: (aDecompilerConstructor
- codeTemp: tuple last - 1
- named: tuple first)]].
- "replace any indirect temp vectors with proper RemoteTempVectorNodes"
- subMap keysAndValuesDo:
- [:index :size|
- tempVector
- at: index
- put: (aDecompilerConstructor
- codeRemoteTemp: index
- remoteTemps: (tempVector at: index))].
- "and update the entry in the map"
- map at: startpc put: tempVector].
- ^map'
-
-  'gnuifyFrom: inFileStream to: outFileStream
-
- "convert interp.c to use GNU features"
-
- | inData beforeInterpret inInterpret inInterpretVars beforePrimitiveResponse inPrimitiveResponse |
-
- inData := inFileStream upToEnd withSqueakLineEndings.
- inFileStream close.
-
- "print a header"
- outFileStream
- nextPutAll: ''/* This file has been post-processed for GNU C */'';
- cr; cr; cr.
-
- beforeInterpret := true.    "whether we are before the beginning of interpret()"
- inInterpret := false.     "whether we are in the middle of interpret"
- inInterpretVars := false.    "whether we are in the variables of interpret"
- beforePrimitiveResponse := true.  "whether we are before the beginning of primitiveResponse()"
- inPrimitiveResponse := false.   "whether we are inside of primitiveResponse"
- ''Gnuifying''
- displayProgressAt: Sensor cursorPoint
- from: 1 to: (inData occurrencesOf: Character cr)
- during:
- [:bar | | lineNumber |
- lineNumber := 0.
- inData linesDo:
- [ :inLine | | outLine extraOutLine caseLabel |
- bar value: (lineNumber := lineNumber + 1).
- outLine := inLine. "print out one line for each input line; by default, print out the line that was input, but some rules modify it"
- extraOutLine := nil.   "occasionally print a second output line..."
- beforeInterpret ifTrue: [
- inLine = ''#include "sq.h"'' ifTrue: [
- outLine := ''#include "sqGnu.h"'' ].
- inLine = ''interpret(void) {'' ifTrue: [
- "reached the beginning of interpret"
- beforeInterpret := false.
- inInterpret := true.
- inInterpretVars := true ] ]
- ifFalse: [
- inInterpretVars ifTrue: [
- (inLine findString: ''register struct foo * foo = &fum;'') > 0 ifTrue: [
- outLine := ''register struct foo * foo FOO_REG = &fum;'' ].
- (inLine findString: '' localIP;'') > 0 ifTrue: [
- outLine := ''    char* localIP IP_REG;'' ].
- (inLine findString: '' localFP;'') > 0 ifTrue: [
- outLine := ''    char* localFP FP_REG;'' ].
- (inLine findString: '' localSP;'') > 0 ifTrue: [
- outLine := ''    char* localSP SP_REG;'' ].
- (inLine findString: '' currentBytecode;'') > 0 ifTrue: [
- outLine := ''    sqInt currentBytecode CB_REG;'' ].
- inLine isEmpty ifTrue: [
- "reached end of variables"
- inInterpretVars := false.
- outLine := ''    JUMP_TABLE;''.
- extraOutLine := inLine ] ]
- ifFalse: [
- inInterpret ifTrue: [
- "working inside interpret(); translate the switch statement"
- (inLine beginsWith: '' case '') ifTrue: [
- caseLabel := (inLine findTokens: '' :'') second.
- outLine := '' CASE('', caseLabel, '')'' ].
- inLine = '' break;'' ifTrue: [
- outLine := '' BREAK;'' ].
- inLine = ''}'' ifTrue: [
- "all finished with interpret()"
- inInterpret := false ] ]
- ifFalse: [
- beforePrimitiveResponse ifTrue: [
- (inLine beginsWith: ''primitiveResponse('') ifTrue: [
- "into primitiveResponse we go"
- beforePrimitiveResponse := false.
- inPrimitiveResponse := true.
- extraOutLine := ''    PRIM_TABLE;'' ] ]
- ifFalse: [
- inPrimitiveResponse ifTrue: [
- inLine = '' switch (primitiveIndex) {'' ifTrue: [
- extraOutLine := outLine.
- outLine := '' PRIM_DISPATCH;'' ].
- inLine = '' switch (GIV(primitiveIndex)) {'' ifTrue: [
- extraOutLine := outLine.
- outLine := '' PRIM_DISPATCH;'' ].
- (inLine beginsWith: '' case '') ifTrue: [
- caseLabel := (inLine findTokens: '' :'') second.
- outLine := '' CASE('', caseLabel, '')'' ].
- inLine = ''}'' ifTrue: [
- inPrimitiveResponse := false ] ]
- ] ] ] ].
-
- outFileStream nextPutAll: outLine; cr.
- extraOutLine ifNotNil: [
- outFileStream nextPutAll: extraOutLine; cr ]]].
-
- outFileStream close' )!

Item was removed:
- ----- 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 removed:
- ----- Method: ClosureCompilerTest>>testMethodAndNodeTempNames (in category 'tests') -----
- testMethodAndNodeTempNames
- "self new testMethodAndNodeTempNames"
- "Test that BytecodeAgnosticMethodNode>>blockExtentsToTempRefs answers the same
- structure as CompiledMethod>>blockExtentsToTempRefs when the method has been
- copied with the appropriate temps.  This tests whether doit methods are debuggable
- since they carry their own temps."
- self closureCases do:
- [:source| | mn om m mbe obe |
- mn := source first isLetter
- ifTrue:
- [self class compilerClass new
- compile: source
- in: self class
- notifying: nil
- ifFail: [self error: 'compilation error']]
- ifFalse:
- [self class compilerClass new
- compileNoPattern: source
- in: self class
- context: nil
- notifying: nil
- ifFail: [self error: 'compilation error']].
- m := (om := mn generate) copyWithTempsFromMethodNode: mn.
- self assert: m holdsTempNames.
- self assert: m endPC = om endPC.
- mbe := m blockExtentsToTempsMap.
- obe := mn blockExtentsToTempsMap.
- self assert: mbe keys asSet = obe keys asSet.
- (mbe keys intersection: obe keys) do:
- [:interval|
- self assert: (mbe at: interval) = (obe at: interval)]]!

Item was removed:
- ----- Method: CompilerExceptionsTest>>griffle (in category 'as yet unclassified') -----
- griffle | goo |!

Item was removed:
- ----- 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 removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesJNtoJZ (in category 'tests') -----
- testDecompilerInClassesJNtoJZ
- self decompileClassesSelect: [:cn| cn first = $J and: [cn second asUppercase > $M]]!

Item was removed:
- TestCase subclass: #ScannerTest
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Compiler-Tests'!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesWNtoWZ (in category 'tests') -----
- testDecompilerInClassesWNtoWZ
- self decompileClassesSelect: [:cn| cn first = $W and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest>>testDecompiledDoitMethodTempNames (in category 'tests') -----
- testDecompiledDoitMethodTempNames
- "self new testDecompiledDoitMethodTempNames"
- "Test that a decompiled doit that has been copied with temps decompiles to the input"
- | removeComments |
- removeComments := [:n| n comment: nil].
- self closureCases do:
- [:source| | mns m mps mnps |
- "Need to compare an ungenerated tree with the generated method's methodNode
- because generating code alters the tree when it introduces remote temp vectors."
- mns := #(first last) collect:
- [:ignored|
- source first isLetter
- ifTrue:
- [self class compilerClass new
- compile: source
- in: self class
- notifying: nil
- ifFail: [self error: 'compilation error']]
- ifFalse:
- [self class compilerClass new
- compileNoPattern: source
- in: self class
- context: nil
- notifying: nil
- ifFail: [self error: 'compilation error']]].
- m := (mns last generateWithTempNames).
- removeComments value: mns first.
- mns first nodesDo: removeComments.
- self assert: (mnps := mns first printString) = (mps := m methodNode printString)]!

Item was removed:
- ----- Method: ClosureCompilerTest>>testTempNameAccessForInjectInto (in category 'tests') -----
- testTempNameAccessForInjectInto
- "self new testTempNameAccessForInjectInto"
- | methodNode method evaluationCount block debuggerMap |
- methodNode := Parser new
- encoderClass: EncoderForV3PlusClosures;
- parse: (Collection sourceCodeAt: #inject:into:)
- class: Collection.
- method := methodNode generate.
- debuggerMap := DebuggerMethodMap forMethod: method methodNode: methodNode.
- evaluationCount := 0.
- block := [:prev :each| | theContext tempNames |
- evaluationCount := evaluationCount + 1.
- theContext := thisContext sender.
- tempNames := debuggerMap tempNamesForContext: theContext.
- self assert: (tempNames hasEqualElements: tempNames).
- #('thisValue' 'each' 'binaryBlock' 'nextValue')
- with: { 0. each. block. prev}
- do: [:tempName :value|
- self assert: (debuggerMap namedTempAt: (tempNames indexOf: tempName) in: theContext) == value.
- tempName ~= 'each' ifTrue:
- [self assert: (debuggerMap namedTempAt: (tempNames indexOf: tempName) in: theContext home) == value]]].
- (1 to: 10) withArgs: { 0. block } executeMethod: method.
- self assert: evaluationCount = 10!

Item was removed:
- ----- Method: MirrorPrimitiveTests>>testMirrorEqEq (in category 'tests') -----
- testMirrorEqEq
- | stackpBefore stackpAfter |
- stackpBefore := thisContext stackPtr.
- self assert: (thisContext object: Array new eqeq: Array new) == false.
- self assert: (thisContext object: Array eqeq: Array) == true.
- stackpAfter := thisContext stackPtr.
- self assert: stackpBefore = stackpAfter "Make sure primitives pop all their arguments"!

Item was removed:
- ----- Method: MirrorPrimitiveTests>>testMirrorPerform (in category 'tests') -----
- testMirrorPerform
- | stackpBefore stackpAfter anInterval |
- stackpBefore := thisContext stackPtr.
- anInterval := 1 to: 2.
- self assert: (thisContext object: anInterval perform:# species withArguments: #() inClass: Interval) == Array.
- self assert: (thisContext object: anInterval perform:# species withArguments: #() inClass: Interval superclass) == Interval.
- self should: [thisContext object: anInterval perform:# species withArguments: #() inClass: Point]
- raise: Error.
- self should: [thisContext object: anInterval perform:# species withArguments: OrderedCollection new inClass: Interval]
- raise: Error.
- stackpAfter := thisContext stackPtr.
- self assert: stackpBefore = stackpAfter "Make sure primitives pop all their arguments"!

Item was removed:
- ----- Method: ClosureCompilerTest>>testDebuggerTempAccess (in category 'tests') -----
- testDebuggerTempAccess
- self doTestDebuggerTempAccessWith: 1 with: 2!

Item was removed:
- ----- Method: DecompilerTests>>checkDecompileMethod: (in category 'utilities') -----
- checkDecompileMethod: oldMethod
-
- | cls selector oldMethodNode methodNode newMethod oldCodeString newCodeString |
- cls := oldMethod methodClass.
- selector := oldMethod selector.
- oldMethodNode := cls decompilerClass new
- decompile: selector
- in: cls
- method: oldMethod.
- [oldMethodNode properties includesKey: #warning] whileTrue:
- [oldMethodNode properties removeKey: #warning].
- oldCodeString := oldMethodNode decompileString.
- methodNode := [cls compilerClass new
- compile: oldCodeString
- in: cls
- notifying: nil
- ifFail: []]
- on: SyntaxErrorNotification
- do: [:ex|
- ex errorMessage = 'Cannot store into' ifTrue:
- [ex return: #badStore].
- ex pass].
- "Ignore cannot store into block arg errors; they're not our issue."
- methodNode ~~ #badStore ifTrue:
- [newMethod := methodNode generate.
- newCodeString := (cls decompilerClass new
- decompile: selector
- in: cls
- method: newMethod) decompileString.
- "(StringHolder new textContents:
- (TextDiffBuilder buildDisplayPatchFrom: oldCodeString to: newCodeString))
- openLabel: 'Decompilation Differences for ', cls name,'>>',selector"
- "(StringHolder new textContents:
- (TextDiffBuilder buildDisplayPatchFrom: oldMethod abstractSymbolic to: newMethod abstractSymbolic))
- openLabel: 'Bytecode Differences for ', cls name,'>>',selector"
- self assert: oldCodeString = newCodeString
- description: cls name asString, ' ', selector asString
- resumable: true]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesIAtoIM (in category 'tests') -----
- testDecompilerInClassesIAtoIM
- self decompileClassesSelect: [:cn| cn first = $I and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesVAtoVM (in category 'tests') -----
- testDecompilerInClassesVAtoVM
- self decompileClassesSelect: [:cn| cn first = $V and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest>>supportTestSourceRangeAccessForDecompiledNoBytecodeInjectInto:source: (in category 'tests') -----
- supportTestSourceRangeAccessForDecompiledNoBytecodeInjectInto: method source: source
- "Test debugger source range selection for inject:into:"
- ^self
- supportTestSourceRangeAccessForInjectInto: method
- source: source
- selectionSequence: #( 'at: 1 put: t1'
- 'do: [:t4 | t3 at: 1 put: (t2 value: (t3 at: 1) value: t4)]'
- 'value: (t3 at: 1) value: t4'
- 'at: 1 put: (t2 value: (t3 at: 1) value: t4)'
- ']'
- 'value: (t3 at: 1) value: t4'
- 'at: 1 put: (t2 value: (t3 at: 1) value: t4)'
- ']'
- '^t3 at: 1')!

Item was removed:
- ----- 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 removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesHAtoHM (in category 'tests') -----
- testDecompilerInClassesHAtoHM
- self decompileClassesSelect: [:cn| cn first = $H and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesTNtoTZ (in category 'tests') -----
- testDecompilerInClassesTNtoTZ
- self decompileClassesSelect: [:cn| cn first = $T and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesFNtoFZ (in category 'tests') -----
- testDecompilerInClassesFNtoFZ
- self decompileClassesSelect: [:cn| cn first = $F and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesSNtoSZ (in category 'tests') -----
- testDecompilerInClassesSNtoSZ
- self decompileClassesSelect: [:cn| cn first = $S and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: CompilerExceptionsTest>>testUndeclaredVariable (in category 'tests') -----
- testUndeclaredVariable
- self
- should:
- [self class
- compile: 'griffle ^ goo'
- notifying: self]
- raise: UndeclaredVariable!

Item was removed:
- ----- Method: ClosureCompilerTest>>testInlineBlockCollectionEM1 (in category 'tests') -----
- testInlineBlockCollectionEM1
- | a1 b1 i1 a2 b2 i2 we wb |
- b1 := OrderedCollection new.
- i1 := 1.
- [a1 := i1.
- i1 <= 3] whileTrue:
- [b1 add: [a1].
- i1 := i1 + 1].
- b1 := b1 asArray collect: [:b | b value].
- b2 := OrderedCollection new.
- i2 := 1.
- we := [a2 := i2. i2 <= 3].
- wb := [b2 add: [a2]. i2 := i2 + 1].
- we whileTrue: wb. "defeat optimization"
- b2 := b2 asArray collect: [:b | b value].
- self assert: b1 = b2!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesEAtoEM (in category 'tests') -----
- testDecompilerInClassesEAtoEM
- self decompileClassesSelect: [:cn| cn first = $E and: [cn second asUppercase <= $M]]!

Item was removed:
- LongTestCase subclass: #DecompilerTests
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Compiler-Tests'!
-
- !DecompilerTests commentStamp: 'sd 9/26/2004 13:24' prior: 0!
- Apparently the decompiler does not really work totally.
- Here are a bunch of methods that can help improving the decompiler:
- - blockingClasses return class for which it is impossible to decompile methods
- - failures are problems that lead to a DNU
- - decompilerDiscrepancies are the results of running decompileTestHelper..as you see the pattern
- is quite present.!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesRAtoRM (in category 'tests') -----
- testDecompilerInClassesRAtoRM
- self decompileClassesSelect: [:cn| cn first = $R and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- 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 removed:
- DecompilerTests subclass: #DecompilerTestFailuresCollector
- instanceVariableNames: 'failures'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Compiler-Tests'!
-
- !DecompilerTestFailuresCollector commentStamp: '<historical>' prior: 0!
- (| dtfc |
- dtfc := DecompilerTestFailuresCollector new.
- (dtfc class superclass organization listAtCategoryNamed: #tests) do:
- [:s| dtfc perform: s].
- dtfc failures)
-
- (Transcript nextPut: ${.
- self do: [:mr| Transcript print: mr actualClass; nextPut: $.; space; store: mr methodSymbol; nextPut: $.; cr; flush].
- Transcript nextPut: $}; flush)
-
- eem 7/1/2009 16:13
- {AdditionalMethodState. #keysAndValuesDo:.
- AdditionalMethodState. #propertyKeysAndValuesDo:.
- AdditionalMethodState. #at:ifAbsent:.
- AdditionalMethodState. #removeKey:ifAbsent:.
- AdditionalMethodState. #at:ifAbsentPut:.
- AdditionalMethodState. #setMethod:.
- AdditionalMethodState. #at:put:.
- AdditionalMethodState. #pragmas.
- AdditionalMethodState. #includesProperty:.
- AdditionalMethodState. #properties.
- AdditionalMethodState. #hasLiteralSuchThat:.
- AdditionalMethodState. #propertyValueAt:ifAbsent:.
- AdditionalMethodState. #hasLiteralThorough:.
- Array. #hasLiteralSuchThat:.
- BitBltSimulation. #initDither8Lookup.
- BlockNode. #sizeCodeExceptLast:.
- BlockNode. #emitCodeExceptLast:encoder:.
- Categorizer. #changeFromCategorySpecs:.
- Categorizer. #elementCategoryDict.
- CColorPicker. #colors:.
- CCustomDrawListCostume. #drawListOn:in:.
- ChangeList. #browseCurrentVersionsOfSelections.
- ClosureTests. #testToDoInsideTemp.
- Cogit. #computeMaximumSizes.
- Cogit. #outputInstructionsAt:.
- Cogit. #generateMapAt:start:.
- CogVMSimulator. #printFrameThing:at:.
- CogVMSimulator. #str:n:cmp:.
- CoInterpreter. #validStackPageBaseFrames.
- CoInterpreter. #markAndTraceTraceLog.
- CoInterpreter. #mapTraceLog.
- CoInterpreter. #checkStackIntegrity.
- CoInterpreter. #mapStackPages.
- CoInterpreter. #updateStackZoneReferencesToCompiledCodePreCompaction.
- CoInterpreter. #ceActivateFailingPrimitiveMethod:.
- CoInterpreterStackPages. #initializeStack:numSlots:pageSize:stackLimitOffset:stackPageHeadroom:.
- CompiledMethod. #=.
- CompiledMethod. #getPreambleFrom:at:.
- CompiledMethod. #hasLiteralThorough:.
- CompiledMethod. #hasLiteralSuchThat:.
- CPopUpMenuCostume. #drawMenu:on:in:.
- CroquetParticipant. #dropFiles:.
- CTextParagraph. #selectionRectsFrom:to:.
- CWheelWidgetCostume. #drawOn:in:.
- Dictionary. #scanFor:.
- Float. #printPaddedWith:to:.
- FMSound. #mixSampleCount:into:startingAt:leftVol:rightVol:.
- Form. #transformColors:.
- FTPClient. #getDataInto:.
- GIFReadWriter. #nextImageWithPlugin.
- GraphMorph. #drawDataOn:.
- GZipReadStream. #on:from:to:.
- HTTPServiceDispatcher. #errorReportFor:stack:on:.
- HttpUrl. #checkAuthorization:retry:.
- Integer. #benchSwitch:.
- Interpreter. #primitiveClosureValueWithArgs.
- Interpreter. #primitivePerformAt:.
- Interpreter. #primitiveDoPrimitiveWithArgs.
- Interpreter. #primitiveNewMethod.
- InterpreterStackPages. #initializeStack:numSlots:pageSize:stackLimitOffset:stackPageHeadroom:.
- JPEGReadWriter. #decodeBlockInto:component:dcTable:acTable:.
- KeyedIdentitySet. #scanFor:.
- KeyedSet. #scanFor:.
- LargeIntegersPlugin. #isNormalized:.
- LargeIntegersPlugin. #cBytesCopyFrom:to:len:.
- LargeIntegersPlugin. #cDigitMultiply:len:with:len:into:.
- LiteralDictionary. #scanFor:.
- LoopedSampledSound. #mixSampleCount:into:startingAt:leftVol:rightVol:.
- MethodDictionary. #scanFor:.
- MP4BoxInfoParser. #parseMP4BoxOutput:.
- MP4BoxNHMLTrack. #computeDTSDeltas.
- MultiByteBinaryOrTextStream. #next:.
- MultiByteFileStream. #next:.
- MViewPane. #reconstructEnabledDocuments.
- MViewPane. #reconstructOpenDocuments.
- MViewPane. #reconstructSelectionList.
- NewParagraph. #selectionRectsFrom:to:.
- Object. #instanceFields.
- OldSocket. #getResponseNoLF.
- PasteUpMorph. #dropFiles:.
- PlotMorphGrid. #bestStep:.
- PluckedSound. #reset.
- PluggableDictionary. #scanFor:.
- PluggableSet. #scanFor:.
- PluggableTabButtonMorph. #calculateArcLengths.
- PluggableTabButtonMorph. #drawTabOn:.
- PNGReadWriter. #copyPixelsGray:.
- PNMReadWriter. #readPlainRGB.
- PNMReadWriter. #readBWreverse:.
- PNMReadWriter. #nextPutRGB:.
- PNMReadWriter. #nextPutBW:reverse:.
- PopUpMenu. #readKeyboard.
- QFloorFan. #initialize.
- QMinimalForum. #demoDesksUnused.
- QNetVidReorderingBuffer. #popFramesForCTS:.
- QNetVidTrackStreamer. #sampleIndexWithCTS:.
- QServiceProvider. #statusReport.
- QServicesPane. #forumMenuInto:.
- QUserListItem. #drawOn:in:.
- QVMProfiler. #computeHistograms:.
- QVMProfiler. #selectSymbolsInRange.
- QwaqParticipantUI. #onDropFiles:.
- RelativeInstructionPrinter. #print:.
- RemoteHandMorph. #appendNewDataToReceiveBuffer.
- SchizophrenicClosureFormatStackInterpreter. #primitiveClosureValueWithArgs.
- Set. #do:.
- Set. #scanFor:.
- SHParserST80. #isBinary.
- ShootoutMall. #processVisitors.
- ShortIntegerArray. #writeOn:.
- SparseLargeArray. #analyzeSpaceSaving.
- StackInterpreter. #validStackPageBaseFrames.
- StackInterpreter. #divorceAllFrames.
- StackInterpreter. #checkStackIntegrity.
- StackInterpreter. #primitiveDoPrimitiveWithArgs.
- StackInterpreter. #reverseDisplayFrom:to:.
- StackInterpreter. #printOop:.
- StackInterpreter. #mapStackPages.
- StackInterpreter. #primitiveNewMethod.
- StackInterpreter. #primitiveClosureValueWithArgs.
- StrikeFontSet. #displayStringR2L:on:from:to:at:kern:.
- String. #howManyMatch:.
- Text. #asHtmlFragmentTextStyle:useBreaks:.
- TextURL. #actOnClickFor:.
- TFractalTerrain. #heightAt:.
- TFractalTerrain. #makeFaces.
- TFractalTerrain. #makeVertices.
- TFractalTerrain. #makeTextureUV.
- TFractalTerrain. #makeVertexNormals.
- TFrame. #computeUnionSphere.
- TMethod. #emitCCommentOn:.
- TRFBStreamOutput. #handleRequest:.
- TTCFontReader. #processCharacterMappingTable:.
- TTContourConstruction. #segmentsDo:.
- TTensor. #projectionIntegrate:.
- TTFontReader. #processHorizontalMetricsTable:length:.
- TTFontReader. #processCharacterMappingTable:.
- TWaves. #step.
- Vector. #copyFrom:.
- Vector. #asVector3.
- VectorColor. #copyFrom:.
- WeakKeyDictionary. #scanForNil:.
- WeakKeyDictionary. #scanFor:.
- WeakSet. #scanFor:.
- WeakSet. #scanForLoadedSymbol:.
- }!

Item was removed:
- ----- Method: CompilerExceptionsTest>>testUndefinedVariable (in category 'tests') -----
- testUndefinedVariable
- self
- should:
- [self class
- compile: 'griffle | goo | ^ goo'
- notifying: self]
- raise: UndefinedVariable!

Item was removed:
- ----- Method: DecompilerTests>>isFailure:sel: (in category 'utilities') -----
- isFailure: cls sel: selector
- "self new isKnowProblem: PNMReaderWriter sel: #nextImage"
- "#((PNMReadWriter nextImage)) includes: {PNMReadWriter
- name asSymbol . #nextImage}."
- ^(#(#DoIt #DoItIn:) includes: selector)
-   or: [self decompilerFailures includes: {cls name asSymbol. selector}]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesDAtoDM (in category 'tests') -----
- testDecompilerInClassesDAtoDM
- self decompileClassesSelect: [:cn| cn first = $D and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: MirrorPrimitiveTests>>testMirrorAt (in category 'tests') -----
- testMirrorAt
- | stackpBefore stackpAfter array byteArray |
- stackpBefore := thisContext stackPtr.
- array := { 1. 2. 3 }.
- byteArray := ByteArray with: 1 with: 2 with: 3.
- self assert: (thisContext object: array basicAt: 1) = 1.
- self assert: (thisContext object: byteArray basicAt: 2) = 2.
- thisContext object: array basicAt: 2 put: #two.
- self assert: array = #(1 #two 3).
- thisContext object: byteArray basicAt: 2 put: 222.
- self assert: byteArray asArray = #(1 222 3).
- stackpAfter := thisContext stackPtr.
- self assert: stackpBefore = stackpAfter. "Make sure primitives pop all their arguments"
- self should: [thisContext object: array basicAt: 4] raise: Error.
- self should: [thisContext object: byteArray basicAt: 0] raise: Error.
- self should: [thisContext object: byteArray basicAt: 1 put: -1] raise: Error!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesPNtoPZ (in category 'tests') -----
- testDecompilerInClassesPNtoPZ
- self decompileClassesSelect: [:cn| cn first = $P and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest>>testSourceRangeAccessForBlueBookLongFormInjectInto (in category 'tests') -----
- testSourceRangeAccessForBlueBookLongFormInjectInto
- "Test debugger source range selection for inject:into: for a version compiled with closures"
- "self new testSourceRangeAccessForBlueBookLongFormInjectInto"
- | source method |
- source := (Collection sourceCodeAt: #inject:into:) asString.
- method := (Parser new
- encoderClass: EncoderForLongFormV3;
- parse: source
- class: Collection)
- generate: (Collection compiledMethodAt: #inject:into:) trailer.
- self supportTestSourceRangeAccessForInjectInto: method source: source!

Item was removed:
- ----- Method: CompilerExceptionsTest>>unusedVariableSource (in category 'private') -----
- unusedVariableSource
- ^ 'griffle
- | goo |
- ^ nil'!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesBNtoBZ (in category 'tests') -----
- testDecompilerInClassesBNtoBZ
- self decompileClassesSelect: [:cn| cn first = $B and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesONtoOZ (in category 'tests') -----
- testDecompilerInClassesONtoOZ
- self decompileClassesSelect: [:cn| cn first = $O and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ClosureCompilerTest>>testSourceRangeAccessForClosureBytecodeInjectInto (in category 'tests') -----
- testSourceRangeAccessForClosureBytecodeInjectInto
- "Test debugger source range selection for inject:into: for a version compiled with closures"
- "self new testSourceRangeAccessForClosureBytecodeInjectInto"
- | source method |
- source := (Collection sourceCodeAt: #inject:into:) asString.
- method := (Parser new
- encoderClass: EncoderForV3PlusClosures;
- parse: source
- class: Collection)
- generate: (Collection compiledMethodAt: #inject:into:) trailer.
- self supportTestSourceRangeAccessForInjectInto: method source: source!

Item was removed:
- ----- 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 removed:
- ----- Method: ClosureCompilerTest class>>methodWithCopiedAndAssignedTemps (in category 'code examples') -----
- methodWithCopiedAndAssignedTemps
- | blk "0w" a "0w" b "0w" c "0w" t "0w" r1 "0w" r2 "0w" |
- a := 1. "1w"
- b := 2. "1w"
- c := 4. "1w"
- t := 0. "1w"
- blk "5w" := ["2" t  "3w" := t "3r" + a "3r" + b "3r" + c "3r" ] "4".
- r1 "5w" := blk "5r" value.
- b "5w" := -100.
- r2 "5w" := blk "5r" value.
- ^r1 "5r" -> r2 "5r" -> t "5r"
-
- "a: main(read(),write(0,1)), block(read(3),write()) => copy; no writes follow read
- b: main(read(),write(0,1,5)), block(read(3),write()) => remote; write follows contained read
- blk: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5
- c: main(read(),write(0,1)), block(read(3),write()) => copy; no writes follow read
- r1: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5
- r2: main(read(5),write(0,5)), block(read(),write()) => no copy in blocks < 5
- t: main(read(5),write(0,1)), block(read(3),write(3)) => remote; read follows contained write"
-
-
- "(Parser new
- encoderClass: EncoderForV3;
- parse: (self class sourceCodeAt: #methodWithCopiedAndAssignedTemps)
- class: self class) generateUsingClosures: #(0 0 0 0)"!

Item was removed:
- ----- Method: CompilerExceptionsTest>>text (in category 'emulating') -----
- text
- ^ self unusedVariableSource!

Item was removed:
- TestCase subclass: #ContextCompilationTest
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Compiler-Tests'!

Item was removed:
- ----- Method: ClosureCompilerTest>>testInjectIntoDecompilations (in category 'tests') -----
- testInjectIntoDecompilations
- "Test various compilations decompile to the same code for a method sufficiently
- simple that this is possible and sufficiently complex that the code generated
- varies between the compilations."
- "self new testInjectIntoDecompilations"
- | source |
- source := (Collection sourceCodeAt: #inject:into:) asString.
- { Encoder.
-   EncoderForV3. EncoderForLongFormV3.
-   EncoderForV3PlusClosures. EncoderForLongFormV3PlusClosures } do:
- [:encoderClass| | method |
- method := (Parser new
- encoderClass: encoderClass;
- parse: source
- class: Collection)
- generate.
- self assert: (Scanner new scanTokens: method decompileString)
- = #(inject: t1 into: t2
- | t3 |
- t3 ':=' t1 .
- self do: [ ':t4' | t3 ':=' t2 value: t3 value: t4 ] .
- ^ t3)]!

Item was removed:
- ----- Method: CompilerExceptionsTest>>testUnusedVariable (in category 'tests') -----
- testUnusedVariable
- self
- should:
- [self class
- compile: self unusedVariableSource
- notifying: self]
- raise: UnusedVariable!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesAAtoAM (in category 'tests') -----
- testDecompilerInClassesAAtoAM
- self decompileClassesSelect: [:cn| cn first = $A and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesNAtoNM (in category 'tests') -----
- testDecompilerInClassesNAtoNM
- self decompileClassesSelect: [:cn| cn first = $N and: [cn second asUppercase <= $M]]!

Item was removed:
- ----- Method: DecompilerTestFailuresCollector>>assert:description:resumable: (in category 'accessing') -----
- assert: aBoolean description: aString resumable: resumableBoolean
- aBoolean ifFalse:
- [failures isNil ifTrue:
- [failures := OrderedCollection new].
- failures addLast: (thisContext sender tempAt: 1) methodReference]!

Item was removed:
- ----- Method: ClosureTests>>assertValues: (in category 'utilities') -----
- assertValues: anArray
- | values |
- values := collection collect: [ :each | each value ].
- self
- assert: anArray asArray = values asArray
- description: 'Expected: ' , anArray asArray printString ,
- ', but got ' , values asArray printString!

Item was removed:
- ----- Method: ContextCompilationTest>>testVariablesAndOffsetsDo (in category 'tests') -----
- testVariablesAndOffsetsDo
-
- "ContextCompilationTest new testVariablesAndOffsetsDo"
- | contextClasses |
- contextClasses := ContextPart withAllSuperclasses, ContextPart allSubclasses asArray.
- contextClasses do:
- [:class|
- class variablesAndOffsetsDo:
- [:var :offset|
- self assert: offset < 0.
- self assert: (class instVarNameForIndex: offset negated) == var]].
-
- InstructionStream withAllSuperclasses, InstructionStream allSubclasses asArray do:
- [:class|
- (contextClasses includes: class) ifFalse:
- [class variablesAndOffsetsDo:
- [:var :offset|
- (InstructionStream instVarNames includes: var) ifFalse:
- [self assert: offset > 0.
- self assert: (class instVarNameForIndex: offset) == var]]]]!

Item was removed:
- ----- Method: ScannerTest>>testLiteralSymbols (in category 'testing') -----
- testLiteralSymbols
-
- self assert: ('*+-/\~=<>&@%,|' allSatisfy: [:char | Scanner isLiteralSymbol: (Symbol with: char)])
- description: 'single letter binary symbols can be printed without string quotes'.
-
- self assert: (#('x' 'x:' 'x:y:' 'from:to:by:' 'yourself') allSatisfy: [:str | Scanner isLiteralSymbol: str asSymbol])
- description: 'valid ascii selector symbols can be printed without string quotes'.
-
- ((32 to: 126) collect: [:ascii | Character value: ascii]) ,
- #(':x:yourself' '::' 'x:yourself' '123' 'x0:1:2:' 'x.y.z' '1abc' 'a1b0c2' ' x' 'x ' '+x-y' '||' '--' '++' '+-' '+/-' '-/+' '<|>' '#x' '()' '[]' '{}' '')
- do: [:str |
- self assert: (Compiler evaluate: str asSymbol printString) = str asSymbol
- description: 'in all case, a Symbol must be printed in an interpretable fashion']!

Item was removed:
- ----- Method: ClosureCompilerTest class>>methodWithOptimizedBlocks (in category 'code examples') -----
- methodWithOptimizedBlocks
- | s c |
- s := self isNil
- ifTrue: [| a | a := 'isNil'. a]
- ifFalse: [| b | b := 'notNil'. b].
- c := String new: s size.
- 1 to: s size do:
- [:i| c at: i put: (s at: i)].
- ^c
-
- "Parser new
- parse: (self class sourceCodeAt: #methodWithOptimizedBlocks)
- class: self class"!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesYNtoYZ (in category 'tests') -----
- testDecompilerInClassesYNtoYZ
- self decompileClassesSelect: [:cn| cn first = $Y and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: DecompilerTests>>decompilerFailures (in category 'utilities') -----
- decompilerFailures
- "here is the list of failures: DNU resulting in trying to decompile the following methods"
-
- ^ #((BalloonEngineSimulation circleCosTable "-0.3826834323650903 => -0.38268343236509 or -0.3826834323650902")
- (BalloonEngineSimulation circleSinTable "-0.3826834323650903 => -0.38268343236509 or -0.3826834323650902")
- (GeniePlugin primSameClassAbsoluteStrokeDistanceMyPoints:otherPoints:myVectors:otherVectors:mySquaredLengths:otherSquaredLengths:myAngles:otherAngles:maxSizeAndReferenceFlag:rowBase:rowInsertRemove:rowInsertRemoveCount: "Cannot compile -- stack including temps is too deep")
- (QPickable2D pick:) "foo ifTrue: [^bar] ifFalse: [^baz]. ^huh?"
- (QUsersPane userEntryCompare:to:) "foo ifTrue: [^bar] ifFalse: [^baz]. ^huh?"
- (TShaderProgram vertexStrings) "foo ifTrue: []. => foo. => ."
- (TShaderProgram fragmentStrings) "foo ifTrue: []. => foo. => ."
- (TWindow zoomWindow:) "foo ifTrue: [^bar] ifFalse: [^baz]. ^huh?"
-
- "(PNMReadWriter nextImage) (Collection #ifEmpty:ifNotEmpty:) (Collection #ifEmpty:) (Collection #ifNotEmpty:ifEmpty:) (Text #alignmentAt:ifAbsent:) (ObjectWithDocumentation propertyAt:ifAbsent:)")!

Item was removed:
- ----- Method: ClosureTests>>methodWithNonLocalReturn (in category 'utilities') -----
- methodWithNonLocalReturn
- self evaluateCopyOf: [^ self].
- self signalFailure: 'Should never reach here'!

Item was removed:
- ----- Method: DecompilerTests>>testDecompilerInClassesKNtoKZ (in category 'tests') -----
- testDecompilerInClassesKNtoKZ
- self decompileClassesSelect: [:cn| cn first = $K and: [cn second asUppercase > $M]]!

Item was removed:
- ----- Method: ClosureTests>>methodArgument: (in category 'testing') -----
- methodArgument: anObject
- ^ [ anObject ]
- !