Eliot Miranda uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-eem.439.mcz

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

Name: Tests-eem.439
Author: eem
Time: 9 October 2020, 11:57:19.079562 am
UUID: 4adcc427-4201-414c-8d97-596fb182c656
Ancestors: Tests-eem.438

Add a test for the compiler bug surfaced by

foo
	^[{thisContext method method. thisContext home method}] value

=============== Diff against Tests-eem.438 ===============

Item was added:
+ ----- Method: CompilerTest class>>compileMethodToUseFullBlocks: (in category 'private - test support') -----
+ compileMethodToUseFullBlocks: selector
+ 	| method encoderClass |
+ 	method := self >> selector.
+ 	encoderClass := {CompiledCode primaryBytecodeSetEncoderClass. CompiledCode secondaryBytecodeSetEncoderClass} select:
+ 							[:class| class supportsFullBlocks].
+ 	self compileCue: ((CompilationCue
+ 							source: method getSource
+ 							class: self
+ 							environment: self environment
+ 							requestor: nil)
+ 						encoderClass: EncoderForSistaV1;
+ 						methodTrailer: method trailer;
+ 						yourself)
+ 		environment: self environment
+ 		classified: (self whichCategoryIncludesSelector: selector)
+ 		withStamp: method timeStamp
+ 		notifying: nil
+ 		logSource: false
+ 
+ 	"self compileMethodToUseFullBlocks: #foo"!

Item was added:
+ ----- Method: CompilerTest>>foo (in category 'private') -----
+ foo
+ 	^[{thisContext method method. thisContext home method}] value!

Item was changed:
+ ----- Method: CompilerTest>>testEvaluationOfInlinedToDo (in category 'tests - code generation') -----
- ----- Method: CompilerTest>>testEvaluationOfInlinedToDo (in category 'tests') -----
  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>>testToDoModifiesTheLimit (in category 'tests - code generation') -----
- ----- Method: CompilerTest>>testToDoModifiesTheLimit (in category 'tests') -----
  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 added:
+ ----- Method: CompilerTest>>testValidFullBlockMethod (in category 'tests - code generation') -----
+ testValidFullBlockMethod
+ 	| fooMethod |
+ 	fooMethod := self class >> #foo.
+ 	fooMethod encoderClass supportsFullBlocks ifFalse:
+ 		[self class compileMethodToUseFullBlocks: #foo.
+ 		 fooMethod := self class >> #foo].
+ 	self assert: fooMethod encoderClass supportsFullBlocks.
+ 	self assert: ((fooMethod literalAt: 1) isCompiledCode and: [(fooMethod literalAt: 1) isCompiledBlock]).
+ 	self assert: (fooMethod literalAt: 1) method == fooMethod.
+ 	"And if it looks safe to do so, actually run foo and check its result"
+ 	(CompiledCode primaryBytecodeSetEncoderClass supportsFullBlocks
+ 	or: [CompiledCode secondaryBytecodeSetEncoderClass supportsFullBlocks]) ifTrue:
+ 		[self assert: {fooMethod. fooMethod } equals: self foo]!