The Trunk: Tests-eem.439.mcz

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]!