The Inbox: Tests-ct.429.mcz

Christoph Thiede uploaded a new version of Tests to project The Inbox:
http://source.squeak.org/inbox/Tests-ct.429.mcz

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

Name: Tests-ct.429
Author: ct
Time: 22 March 2020, 8:19:10.72456 pm
UUID: 5337340d-652e-744e-ba7e-9ae42bce2751
Ancestors: Tests-cmm.428

Extends tests for parser notifications and tests bugs that were fixed in Morphic-ct.1640 & Compiler-ct.423. Also tests cancel button that was added in Compiler-ct.422.

Depends on Regex-Core-ct.56.

Please review! I see it as a desirable goal to test as much of things like this that caused various bugs in the past. However, it was hard for me to find an appropriate trade-off between maximizing the test coverage and keeping the tests readable, not too prescriptive.

=============== Diff against Tests-cmm.428 ===============

Item was changed:
  TestCase subclass: #CompilerExceptionsTest
+ instanceVariableNames: 'text nextSelectionInterval selectionInterval originalText previousSelection originalSelection tearDowns'
- instanceVariableNames: 'text'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'Tests-Compiler'!

Item was added:
+ ----- Method: CompilerExceptionsTest>>assertCanceled (in category 'assertions') -----
+ assertCanceled
+
+ self
+ assertText: originalText;
+ assertSelection: previousSelection.!

Item was added:
+ ----- Method: CompilerExceptionsTest>>assertSelection: (in category 'assertions') -----
+ assertSelection: selectionMatch
+
+ selectionMatch isBlock ifTrue: [
+ ^ self assertSelection: selectionMatch value].
+ ^ self
+ assert: selectionMatch
+ equals: (selectionMatch isInterval
+ ifTrue: [self selectionInterval]
+ ifFalse: [self selection])!

Item was added:
+ ----- Method: CompilerExceptionsTest>>assertSucceeded (in category 'assertions') -----
+ assertSucceeded
+
+ ^ self assertSucceeded: originalText!

Item was added:
+ ----- Method: CompilerExceptionsTest>>assertSucceeded: (in category 'assertions') -----
+ assertSucceeded: textMatch
+
+ self
+ assertText: textMatch;
+ assertSelection: originalSelection.!

Item was added:
+ ----- Method: CompilerExceptionsTest>>assertText: (in category 'assertions') -----
+ assertText: textMatch
+
+ text isBlock ifTrue: [
+ ^ self assertText: text value].
+ ^ (textMatch respondsTo: #matches:)
+ ifTrue: [
+ self assert: [textMatch matches: text]]
+ ifFalse: [
+ self assert: textMatch equals: text]!

Item was changed:
  ----- Method: CompilerExceptionsTest>>compile: (in category 'private') -----
  compile: sourceString
 
+ | result |
+ originalText := text := sourceString.
+ previousSelection := originalSelection := 1 to: text size + 1.
+ selectionInterval := nextSelectionInterval := nil.
+ result := self class
- text := sourceString.
- self class
  compileSilently: text
  classified: 'generated'
+ notifying: self.
+ result ifNil: [^ self].
+ selectionInterval := originalSelection.!
- notifying: self!

Item was removed:
- ----- Method: CompilerExceptionsTest>>compiling:shouldRaise: (in category 'private') -----
- compiling: sourceCode shouldRaise: exceptionClass
-
- self should: [ self compile: sourceCode ] raise: exceptionClass!

Item was added:
+ ----- Method: CompilerExceptionsTest>>compiling:shouldRaise:andSelect:testing: (in category 'private') -----
+ compiling: sourceCode shouldRaise: exceptionClass andSelect: selectionMatch testing: tests
+
+ | referenceTest |
+ referenceTest := [] -> [].
+ (tests copyWithFirst: referenceTest) associationsDo: [:test |
+ self
+ should: [self compile: sourceCode]
+ raise: exceptionClass
+ thenDo: [:exception |
+ self assertSelection: selectionMatch.
+ previousSelection := self selectionInterval.
+ (self handlerBlockFor: test key) cull: exception].
+ (self testBlockFor: test value) value].!

Item was added:
+ ----- Method: CompilerExceptionsTest>>correctFrom:to:with: (in category 'emulating') -----
+ correctFrom: start to: stop with: aString
+
+ | delta userSelection |
+ userSelection := self selectionInterval.
+ text := (text first: start - 1) , aString , (text allButFirst: stop).
+ delta := aString size - (stop - start + 1).
+ self
+ selectInvisiblyFrom: userSelection first + (userSelection first > start ifFalse: [ 0 ] ifTrue: [ delta ])
+ to: userSelection last + (userSelection last > start ifFalse: [ 0 ] ifTrue: [ delta ]).!

Item was added:
+ ----- Method: CompilerExceptionsTest>>deselect (in category 'emulating') -----
+ deselect
+
+ selectionInterval := nextSelectionInterval.!

Item was added:
+ ----- Method: CompilerExceptionsTest>>handlerBlockFor: (in category 'private') -----
+ handlerBlockFor: message
+
+ ^ message isBlock
+ ifTrue: [message]
+ ifFalse: [[:ex | [ex pass] valueSupplyingAnswer: message]]!

Item was added:
+ ----- Method: CompilerExceptionsTest>>nextTokenFrom:direction: (in category 'emulating') -----
+ nextTokenFrom: start direction: dir
+ "simple token-finder for compiler automated corrections"
+ | loc str |
+ loc := start + dir.
+ str := self text.
+ [(loc between: 1 and: str size) and: [(str at: loc) isSeparator]]
+ whileTrue: [loc := loc + dir].
+ ^ loc!

Item was changed:
  ----- Method: CompilerExceptionsTest>>select (in category 'emulating') -----
  select
+
+ selectionInterval := nextSelectionInterval.!
- !

Item was changed:
  ----- Method: CompilerExceptionsTest>>selectFrom:to: (in category 'emulating') -----
  selectFrom: start to: end
+
+ nextSelectionInterval := start to: end.!
- !

Item was added:
+ ----- Method: CompilerExceptionsTest>>selectInvisiblyFrom:to: (in category 'emulating') -----
+ selectInvisiblyFrom: start to: end
+
+ ^ self
+ selectFrom: start to: end;
+ select!

Item was added:
+ ----- Method: CompilerExceptionsTest>>selection (in category 'private') -----
+ selection
+
+ ^ text copyFrom: self selectionInterval start to: self selectionInterval stop!

Item was changed:
  ----- Method: CompilerExceptionsTest>>selectionInterval (in category 'emulating') -----
  selectionInterval
+
+ ^ selectionInterval ifNil: [1 to: self text size]!
- ^ 1 to: 0!

Item was changed:
  ----- Method: CompilerExceptionsTest>>setUp (in category 'running') -----
  setUp
 
+ super setUp.
+ tearDowns := OrderedCollection new.
+ Symbol hasInterned: self unknownSelector ifTrue: [:symbol |
+ tearDowns add: [Symbol intern: symbol]].
+ Symbol extern: self unknownSelector.!
- self removeGeneratedMethods!

Item was added:
+ ----- Method: CompilerExceptionsTest>>should:raise:thenDo: (in category 'assertions') -----
+ should: aBlock raise: anExceptionalEvent thenDo: aHandlerBlock
+
+ | raised result |
+ raised := false.
+ result := aBlock
+ on: anExceptionalEvent
+ do: [:ex |
+ raised := true.
+ aHandlerBlock cull: ex].
+ self assert: raised description: ('aBlock should have raised {1}' translated format: {anExceptionalEvent}).
+ ^ result!

Item was changed:
  ----- Method: CompilerExceptionsTest>>tearDown (in category 'running') -----
  tearDown
 
+ self removeGeneratedMethods.
+ Symbol extern: self unknownSelector.
+ tearDowns do: #value.
+ super tearDown.!
- self removeGeneratedMethods!

Item was changed:
  ----- Method: CompilerExceptionsTest>>testAmbiguousSelector (in category 'tests') -----
  testAmbiguousSelector
 
+ self
- self
  compiling: 'griffle ^1--1'
+ shouldRaise: AmbiguousSelector
+ andSelect: '--'
+ testing: {
+ [:ex | ex resume] -> [self assertCanceled].
+ [:ex | ex resume: '-- '] -> 'griffle ^1-- 1' }.
+ self
- shouldRaise: AmbiguousSelector;
  compiling: 'griffle ^1@-1'
+ shouldRaise: AmbiguousSelector
+ andSelect: '@-'
+ testing: {
+ [:ex | ex resume] -> [self assertCanceled].
+ [:ex | ex resume: '@ -'] -> 'griffle ^1@ -1' }.
+ self
- shouldRaise: AmbiguousSelector;
  compiling: 'griffle ^1+-1'
+ shouldRaise: AmbiguousSelector
+ andSelect: '+-'
+ testing: {
+ [:ex | ex resume] -> [self assertCanceled].
+ [:ex | ex resume: '+- '] -> ['griffle ^1+- 1'] }.!
- shouldRaise: AmbiguousSelector !

Item was added:
+ ----- Method: CompilerExceptionsTest>>testBlockFor: (in category 'private') -----
+ testBlockFor: test
+
+ ^ test isBlock
+ ifTrue: [test]
+ ifFalse: [[self assertSucceeded: test]]!

Item was changed:
  ----- Method: CompilerExceptionsTest>>testUndeclaredVariable (in category 'tests') -----
  testUndeclaredVariable
 
  self
  compiling: 'griffle ^ goo'
+ shouldRaise: UndeclaredVariable
+ andSelect: 'goo'
+ testing: {
+ false -> [self assertCanceled] }.
+ self
- shouldRaise: UndeclaredVariable;
  compiling: 'griffle ^ [ goo ] value'
+ shouldRaise: UndeclaredVariable
+ andSelect: 'goo'
+ testing: {
+ false -> [self assertCanceled] }.
+ self
+ compiling: 'griffle goo := 42'
+ shouldRaise: UndeclaredVariable
+ andSelect: 'goo'
+ testing: {
+ false -> [self assertCanceled].
+ 'declare method temp' -> 'griffle | goo |\goo := 42' withCRs }.
+ self
+ compiling: 'griffle ^ [ goo := 42 ] value'
+ shouldRaise: UndeclaredVariable
+ andSelect: 'goo'
+ testing: {
+ false -> [self assertCanceled].
+ 'declare method temp' -> 'griffle | goo |\^ [ goo := 42 ] value' withCRs.
+ 'declare block-local temp' -> 'griffle ^ [ | goo | goo := 42 ] value' withCRs }.!
- shouldRaise: UndeclaredVariable!

Item was changed:
  ----- Method: CompilerExceptionsTest>>testUndefinedVariable (in category 'tests') -----
  testUndefinedVariable
 
  self
  compiling: 'griffle | goo | ^ goo'
+ shouldRaise: UndefinedVariable
+ andSelect: [(text allRangesOfRegexMatches: '(?<=\^ )goo') first]
+ testing: {
+ true -> [self assertSucceeded].
+ false -> [self assertCanceled] }.
+ self
- shouldRaise: UndefinedVariable;
  compiling: 'griffle [ | goo | ^ goo ] value'
+ shouldRaise: UndefinedVariable
+ andSelect: [(text allRangesOfRegexMatches: '(?<=\^ )goo') first]
+ testing: {
+ true -> [self assertSucceeded].
+ false -> [self assertCanceled] }.!
- shouldRaise: UndefinedVariable!

Item was changed:
  ----- Method: CompilerExceptionsTest>>testUnknownSelector (in category 'tests') -----
  testUnknownSelector
+
-
  self
+ compiling: 'griffle self ' , self unknownSelector
+ shouldRaise: UnknownSelector
+ andSelect: self unknownSelector
+ testing: {
+ false -> [self assertCanceled].
+ 'yourself' -> [self assertSucceeded: 'griffle self yourself'].
+ self unknownSelector -> [
+ self assertSucceeded.
+ self assert: (Symbol hasInterned: self unknownSelector ifTrue: [:symbol |]).
+ Symbol extern: self unknownSelector] }.
+ self
+ compiling: 'griffle [ self ' , self unknownSelector , ' ] value'
+ shouldRaise: UnknownSelector
+ andSelect: self unknownSelector
+ testing: {
+ false -> [self assertCanceled].
+ 'yourself' -> [self assertSucceeded: 'griffle [ self yourself ] value'].
+ self unknownSelector -> [
+ self assertSucceeded.
+ self assert: (Symbol hasInterned: self unknownSelector ifTrue: [:symbol |])] }.!
- compiling: 'griffle self reallyHopeThisIsntImplementedAnywhere'
- shouldRaise: UnknownSelector;
- compiling: 'griffle [ self reallyHopeThisIsntImplementedAnywhere ] value'
- shouldRaise: UnknownSelector!

Item was changed:
  ----- Method: CompilerExceptionsTest>>testUnusedVariable (in category 'tests') -----
  testUnusedVariable
 
  self
  compiling: 'griffle | goo | ^nil'
+ shouldRaise: UnusedVariable
+ andSelect: [self text]
+ testing: {
+ [:ex | ex resume] -> [self assertCanceled].
+ false -> [self assertSucceeded].
+ true -> [self assertSucceeded: 'griffle\s*\^nil' asRegex] }.
+ self
- shouldRaise: UnusedVariable;
  compiling: 'griffle ^[ | goo | ]'
+ shouldRaise: UnusedVariable
+ andSelect: [self text]
+ testing: {
+ [:ex | ex resume] -> [self assertCanceled].
+ false -> [self assertSucceeded].
+ true -> [self assertSucceeded: 'griffle \^\[\s*\]' asRegex] }.!
- shouldRaise: UnusedVariable!

Item was added:
+ ----- Method: CompilerExceptionsTest>>unknownSelector (in category 'private') -----
+ unknownSelector
+
+ ^ 'yourrsellff'!

Item was added:
+ ----- Method: Symbol class>>extern: (in category '*Tests-release') -----
+ extern: aStringOrSymbol
+
+ {NewSymbols. SymbolTable} do: [:table |
+ table remove: aStringOrSymbol ifAbsent: []].!