[squeak-dev] The Trunk: Tests-nice.431.mcz

commits at source.squeak.org commits at source.squeak.org
Fri May 8 22:35:52 UTC 2020


Nicolas Cellier uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-nice.431.mcz

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

Name: Tests-nice.431
Author: nice
Time: 9 May 2020, 12:35:50.637736 am
UUID: 4d5f4fe0-59f8-4ec7-9d55-9239d58d99e1
Ancestors: Tests-mt.430, Tests-ct.429

Merge Tests-ct.429 and fix it after my refactoring of Parser corrections.

=============== Diff against Tests-mt.430 ===============

Item was changed:
  TestCase subclass: #CompilerExceptionsTest
+ 	instanceVariableNames: 'text 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 := 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>>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 removed:
- ----- Method: CompilerExceptionsTest>>select (in category 'emulating') -----
- select
- 	!

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

Item was added:
+ ----- Method: CompilerExceptionsTest>>selectIntervalInvisibly: (in category 'emulating') -----
+ selectIntervalInvisibly: anInterval
+ 
+ 	selectionInterval := anInterval!

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

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 at -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: []].!



More information about the Squeak-dev mailing list