[squeak-dev] The Trunk: Tests-fbs.262.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Nov 5 23:11:24 UTC 2013


Frank Shearar uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-fbs.262.mcz

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

Name: Tests-fbs.262
Author: fbs
Time: 5 November 2013, 11:11:11.449 pm
UUID: a2f38f3a-e82e-a244-a13b-54fe7c22d6ab
Ancestors: Tests-fbs.261

More #shouldnt:raise: Error removals.

A lot of the time one line says "shouldnt: [foo := bar baz] raise: Error" which makes as much sense as "foo := bar baz" only it's less readable.

=============== Diff against Tests-fbs.261 ===============

Item was changed:
  ----- Method: BitBltClipBugs>>testDrawingWayOutside (in category 'as yet unclassified') -----
  testDrawingWayOutside
  	| f1 bb f2 |
  	f1 := Form extent: 100 at 100 depth: 1.
  	f2 := Form extent: 100 at 100 depth: 1.
  	bb := BitBlt toForm: f1.
  	bb combinationRule: 3.
  	bb sourceForm: f2.
  	bb destOrigin: SmallInteger maxVal squared asPoint.
  	bb width: 100; height: 100.
+ 	
+ 	"This should not throw an exception:"
+ 	bb copyBits.
- 	self shouldnt:[bb copyBits] raise: Error.
  !

Item was changed:
  ----- Method: BitBltClipBugs>>testDrawingWayOutside2 (in category 'as yet unclassified') -----
  testDrawingWayOutside2
  	| f1 bb f2 |
  	f1 := Form extent: 100 at 100 depth: 1.
  	f2 := Form extent: 100 at 100 depth: 1.
  	bb := BitBlt toForm: f1.
  	bb combinationRule: 3.
  	bb sourceForm: f2.
  	bb destOrigin: 0 at 0.
  	bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared.
+ 	
+ 	"This should not throw an exception:"
+ 	bb copyBits.!
- 	self shouldnt:[bb copyBits] raise: Error.!

Item was changed:
  ----- Method: BitBltClipBugs>>testDrawingWayOutside3 (in category 'as yet unclassified') -----
  testDrawingWayOutside3
  	| f1 bb f2 |
  	f1 := Form extent: 100 at 100 depth: 1.
  	f2 := Form extent: 100 at 100 depth: 1.
  	bb := BitBlt toForm: f1.
  	bb combinationRule: 3.
  	bb sourceForm: f2.
  	bb destOrigin: SmallInteger maxVal squared asPoint.
  	bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared.
+ 	
+ 	"This should not throw an exception:"
+ 	bb copyBits.
- 	self shouldnt:[bb copyBits] raise: Error.
  !

Item was changed:
  ----- Method: BitBltClipBugs>>testDrawingWayOutside4 (in category 'as yet unclassified') -----
  testDrawingWayOutside4
  	| f1 bb f2 |
  	f1 := Form extent: 100 at 100 depth: 1.
  	f2 := Form extent: 100 at 100 depth: 1.
  	bb := BitBlt toForm: f1.
  	bb combinationRule: 3.
  	bb sourceForm: f2.
  	bb destOrigin: SmallInteger maxVal squared asPoint.
  	bb width: 100; height: 100.
  	bb sourceOrigin: SmallInteger maxVal squared asPoint.
+ 	
+ 	"This should not throw an exception:"
+ 	bb copyBits.
- 	self shouldnt:[bb copyBits] raise: Error.
  !

Item was changed:
  ----- Method: BitBltClipBugs>>testDrawingWayOutside5 (in category 'as yet unclassified') -----
  testDrawingWayOutside5
  	| f1 bb f2 |
  	f1 := Form extent: 100 at 100 depth: 1.
  	f2 := Form extent: 100 at 100 depth: 1.
  	bb := BitBlt toForm: f1.
  	bb combinationRule: 3.
  	bb sourceForm: f2.
  	bb destOrigin: 0 at 0.
  	bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared.
  	bb sourceOrigin: SmallInteger maxVal squared asPoint.
+ 	
+ 	"This should not throw an exception:"
+ 	bb copyBits.!
- 	self shouldnt:[bb copyBits] raise: Error.!

Item was changed:
  ----- Method: BitBltClipBugs>>testDrawingWayOutside6 (in category 'as yet unclassified') -----
  testDrawingWayOutside6
  	| f1 bb f2 |
  	f1 := Form extent: 100 at 100 depth: 1.
  	f2 := Form extent: 100 at 100 depth: 1.
  	bb := BitBlt toForm: f1.
  	bb combinationRule: 3.
  	bb sourceForm: f2.
  	bb destOrigin: SmallInteger maxVal squared asPoint.
  	bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared.
  	bb sourceOrigin: SmallInteger maxVal squared asPoint.
+ 	
+ 	"This should not throw an exception:"
+ 	bb copyBits.
- 	self shouldnt:[bb copyBits] raise: Error.
  !

Item was changed:
  ----- Method: BitBltClipBugs>>testFillingWayOutside (in category 'as yet unclassified') -----
  testFillingWayOutside
  	| f1 bb |
  	f1 := Form extent: 100 at 100 depth: 1.
  	bb := BitBlt toForm: f1.
  	bb combinationRule: 3.
  	bb fillColor: Color black.
  	bb destOrigin: SmallInteger maxVal squared asPoint.
  	bb width: 100; height: 100.
+ 	
+ 	"This should not throw an exception:"
+ 	bb copyBits.
- 	self shouldnt:[bb copyBits] raise: Error.
  !

Item was changed:
  ----- Method: BitBltClipBugs>>testFillingWayOutside2 (in category 'as yet unclassified') -----
  testFillingWayOutside2
  	| f1 bb |
  	f1 := Form extent: 100 at 100 depth: 1.
  	bb := BitBlt toForm: f1.
  	bb combinationRule: 3.
  	bb fillColor: Color black.
  	bb destOrigin: 0 at 0.
  	bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared.
+ 	
+ 	"This should not throw an exception:"
+ 	bb copyBits.!
- 	self shouldnt:[bb copyBits] raise: Error.!

Item was changed:
  ----- Method: BitBltClipBugs>>testFillingWayOutside3 (in category 'as yet unclassified') -----
  testFillingWayOutside3
  	| f1 bb |
  	f1 := Form extent: 100 at 100 depth: 1.
  	bb := BitBlt toForm: f1.
  	bb combinationRule: 3.
  	bb fillColor: Color black.
  	bb destOrigin: SmallInteger maxVal squared asPoint.
  	bb width: SmallInteger maxVal squared; height: SmallInteger maxVal squared.
+ 	
+ 	"This should not throw an exception:"
+ 	bb copyBits.
- 	self shouldnt:[bb copyBits] raise: Error.
  !

Item was changed:
  ----- Method: ClosureCompilerTest>>testBlockDoitDecompilation (in category 'tests') -----
  testBlockDoitDecompilation
  	"Tests that decompile of a doit block with remote vars executes correcly"
  	"Tests that decompilation of a Block, when 'method' of block is equivalent to that compiled by a DoIt, preserves the temp names "
  	
  	|blockSourceStream methodNode compiledMethod block decompiledBlock|
  	blockSourceStream := '|x y| [:a :b | x := a. y := b. x + y]' readStream.
  	methodNode := nil class evaluatorClass new 
  			compileNoPattern: blockSourceStream in: nil class notifying: nil ifFail: [nil]..
  	compiledMethod := methodNode generateWithTempNames.
  	block := nil withArgs: #() executeMethod: compiledMethod.
  	
+ 	decompiledBlock := block decompile.
- 	self shouldnt: [decompiledBlock := block decompile] raise: Error.
  	self assert: '{[:a :b | 
  x := a.
  	y := b.
  	x + y]}' equals: decompiledBlock printString
  !

Item was changed:
  ----- Method: ClosureTests>>testCopyNonLocalReturn (in category 'testing') -----
  testCopyNonLocalReturn
+ 	"This should not fail."
+ 	self methodWithNonLocalReturn!
- 	self
- 		shouldnt: [self methodWithNonLocalReturn]
- 		raise: Error!

Item was changed:
  ----- Method: CompilerTest>>testMaxLiterals (in category 'limits') -----
  testMaxLiterals
  	"Document the maximum number of literals in a compiled method"
  
  	| maxLiterals stringThatCanBeCompiled stringWithOneTooManyLiterals |
  	maxLiterals := 249.
  	stringThatCanBeCompiled := '{ ', (String streamContents: [:strm |
  					1 to: maxLiterals do: [:e | strm nextPutAll: '''', e asString, '''', ' . ']]), '}'.
  	stringWithOneTooManyLiterals := '{ ', (String streamContents: [:strm |
  					1 to: maxLiterals + 1 do: [:e | strm nextPutAll: '''', e asString, '''', ' . ']]), '}'.
+ 	self assert: ((1 to: 249) asArray collect: #printString) equals: (Compiler evaluate: stringThatCanBeCompiled logged: false).
- 	self shouldnt: [Compiler evaluate: stringThatCanBeCompiled logged: false] raise: Error.
  	self should: (Compiler evaluate: stringThatCanBeCompiled logged: false) size = maxLiterals.
  	
  	"If the following test fails, it means that the limit has been raised or eliminated,
  	and this test should be updated to reflect the improvement."
  	self should: [Compiler evaluate: stringWithOneTooManyLiterals logged: false] raise: Error.
  !

Item was changed:
  ----- Method: CompilerTest>>testMaxLiteralsWithClassReferenceInClosure (in category 'limits') -----
  testMaxLiteralsWithClassReferenceInClosure
  	"Document the maximum number of literals in a compiled method. A class
  	reference in a closure reduces the maximum literals."
  
  	| maxLiterals stringThatCanBeCompiled stringWithOneTooManyLiterals |
  	maxLiterals := 244.
  	stringThatCanBeCompiled := '[ DateAndTime now. Date today. Time ]. { ',
  			(String streamContents: [:strm |
  					1 to: maxLiterals do: [:e | strm nextPutAll: '''', e asString, '''', ' . ']]), '}'.
  	stringWithOneTooManyLiterals := '[ DateAndTime now. Date today. Time ]. { ',
  			(String streamContents: [:strm |
  					1 to: maxLiterals + 1 do: [:e | strm nextPutAll: '''', e asString, '''', ' . ']]), '}'.
+ 	self assert: maxLiterals equals: (Compiler evaluate: stringThatCanBeCompiled logged: false) size.
- 	self shouldnt: [Compiler evaluate: stringThatCanBeCompiled logged: false] raise: Error.
- 	self should: (Compiler evaluate: stringThatCanBeCompiled logged: false) size = maxLiterals.
  	
  	"If the following test fails, it means that the limit has been raised or eliminated,
  	and this test should be updated to reflect the improvement."
  	self should: [Compiler evaluate: stringWithOneTooManyLiterals logged: false] raise: Error.
  !

Item was changed:
  ----- Method: CompilerTest>>testToDoModifiesTheLimit (in category 'testing') -----
  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:
- 		shouldnt:
  			[ | n |
  			n := 2.
  			1 to: n do: [:i | (n := n+1)>10 ifTrue: [self error: 'Should not get here']].
+ 			n] value.
- 			n]
- 		raise: Error.
- 
  	self
+ 		assert: 4
+ 		equals:
- 		assert: 
  			[ | n |
  			n := 2.
- 			1 to: n do: [:i | (n := n+1)>10 ifTrue: [self error: 'Should not get here']].
- 			n] value = 4.
- 	self
- 		assert: 
- 			[ | n |
- 			n := 2.
  			1 to: n by: 1 do: [:i | (n := n+1)>10 ifTrue: [self error: 'Should not get here']].
+ 			n] value.
- 			n] value = 4.
  	self
+ 		assert: 4
+ 		equals:
- 		assert: 
  			[ | 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.!
- 			n] value = 4!

Item was changed:
  ----- Method: DecompilerTests>>testDecompileAnswerToDoLoop (in category 'tests') -----
  testDecompileAnswerToDoLoop
  	"This is a non regression test for Compiler-nice.224."
  	"DecompilerTests new testDecompileAnswerToDoLoop"
  	| sourceCode mn decompiledCode  |
  	sourceCode := '^nil to: 3 do: [:i| i class]'.
+ 	mn := self class newCompiler compileNoPattern: sourceCode in: self class notifying: nil ifFail: [self error: 'failed'].
+ 	decompiledCode := mn generateWithTempNames decompileWithTemps asString.
+ 	
- 	self
- 		shouldnt: [mn := self class newCompiler compileNoPattern: sourceCode in: self class notifying: nil ifFail: [self error: 'failed']]
- 		raise: Error.
- 	self
- 		shouldnt: [decompiledCode := mn generateWithTempNames decompileWithTemps asString]
- 		raise: Error.
  	"This to avoid getting fooled by changes in decompilation due to code formatting preferences."
  	decompiledCode := decompiledCode copyReplaceAll: {Character cr. Character tab. Character tab } with: ' '.
  	decompiledCode := decompiledCode copyReplaceAll: '^ ' with: '^'.
  	decompiledCode := decompiledCode copyReplaceAll: ' |' with: '|'.
  	self
  		assert: (decompiledCode endsWith: sourceCode)
  		description: 'decompilation should match source'.!

Item was changed:
  ----- Method: DecompilerTests>>testDecompileLoopWithMovingLimit (in category 'tests') -----
  testDecompileLoopWithMovingLimit
  	"This is a non regression test for http://bugs.squeak.org/view.php?id=7093"
  	
  	| decompiledCode sourceCode |
  	sourceCode := 'loopWithMovingLimit
  	"This loop might be decompiled as a to:do: but should not because it does modify its limit"
  	| n i |
  	n := 4.
  	i := 1.
  	[i <= n] whileTrue: [
  		n := n - 1.
  		i := i + 1].
  	^n'.
+ 	self class compile: sourceCode.
+ 	self assert: (self class includesSelector: #loopWithMovingLimit).
+ 	self assert: 2 equals: (self perform: #loopWithMovingLimit).
+ 	decompiledCode := self class decompile: #loopWithMovingLimit.
+ 	self class compile: decompiledCode decompileString.
  	self
+ 		assert: 2
+ 		equals: (self perform: #loopWithMovingLimit)
- 		shouldnt: [self class compile: sourceCode]
- 		raise: Error.
- 	self assert: (self perform: #loopWithMovingLimit) = 2.
- 	self
- 		shouldnt: [decompiledCode := self class decompile: #loopWithMovingLimit]
- 		raise: Error.
- 	self
- 		shouldnt: [self class compile: decompiledCode decompileString]
- 		raise: Error.
- 	self
- 		assert: (self perform: #loopWithMovingLimit) = 2
  		description: 'result from decompiledCode should not differ from sourceCode'.!

Item was changed:
  ----- Method: DecompilerTests>>testDecompileUnreachableParameter (in category 'failing decompile tests') -----
  testDecompileUnreachableParameter
  	"The call to #value: is unreachable because both blocks in the #ifTrue:ifFalse: send force a return."
+ 	[self value: (true ifTrue: [^true] ifFalse: [^false])] decompile.!
- 	self shouldnt: [[self value: (true ifTrue: [^true] ifFalse: [^false])] decompile] raise: Error.!

Item was changed:
  ----- Method: DecompilerTests>>testRemoteTemp (in category 'tests') -----
  testRemoteTemp
  	| aBlock |
  	aBlock := Compiler evaluate: '| x y |  [:a :b | x := a. y := b. x+y]'.
+ 	
+ 	"This should not fail."
+ 	aBlock decompile
- 	self shouldnt: [aBlock decompile] raise: Error
  	!

Item was changed:
  ----- Method: ExpandedSourceFileArrayTest>>testSourcePointerFromFileIndexAndPosition (in category 'testing') -----
  testSourcePointerFromFileIndexAndPosition
  	"Test valid input ranges"
  
  	| sf |
  	sf := ExpandedSourceFileArray new.
+ 	
  	self should: [sf sourcePointerFromFileIndex: 0 andPosition: 0] raise: Error.
- 	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 0] raise: Error.
- 	self shouldnt: [sf sourcePointerFromFileIndex: 2 andPosition: 0] raise: Error.
  	self should: [sf sourcePointerFromFileIndex: 0 andPosition: 3] raise: Error.
  	self should: [sf sourcePointerFromFileIndex: 1 andPosition: -1] raise: Error.
- 	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF] raise: Error.
- 	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 16r2000000] raise: Error.
  	self should: [sf sourcePointerFromFileIndex: 3 andPosition: 0] raise: Error.
  	self should: [sf sourcePointerFromFileIndex: 4 andPosition: 0] raise: Error.
+ 
+ 	self assert: 16r1000000 equals: (sf sourcePointerFromFileIndex: 1 andPosition: 0).
+ 	self assert: 16r1000013 equals: (sf sourcePointerFromFileIndex: 1 andPosition: 16r13).
+ 	self assert: 16r1FFFFFF equals: (sf sourcePointerFromFileIndex: 1 andPosition: 16rFFFFFF).
+ 	self assert: 16r2000000 equals: (sf sourcePointerFromFileIndex: 2 andPosition: 0).
+ 	self assert: 16r2000013 equals: (sf sourcePointerFromFileIndex: 2 andPosition: 16r13).
+ 	self assert: 16r2FFFFFF equals: (sf sourcePointerFromFileIndex: 2 andPosition: 16rFFFFFF).
+ 	self assert: 16r3000000 equals: (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000000).
+ 	self assert: 16r3000013 equals: (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000013).
+ 	self assert: 16r3FFFFFF equals: (sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF).
+ 	self assert: 16r4000000 equals: (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000000).
+ 	self assert: 16r4000013 equals: (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000013).
+ 	self assert: 16r4FFFFFF equals: (sf sourcePointerFromFileIndex: 2 andPosition: 16r1FFFFFF).
+ 	self assert: 16r5000000 equals: (sf sourcePointerFromFileIndex: 1 andPosition: 16r2000000).!
- 	
- 	self assert: 16r1000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 0).
- 	self assert: 16r1000013 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r13).
- 	self assert: 16r1FFFFFF = (sf sourcePointerFromFileIndex: 1 andPosition: 16rFFFFFF).
- 	self assert: 16r2000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 0).
- 	self assert: 16r2000013 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r13).
- 	self assert: 16r2FFFFFF = (sf sourcePointerFromFileIndex: 2 andPosition: 16rFFFFFF).
- 	self assert: 16r3000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000000).
- 	self assert: 16r3000013 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000013).
- 	self assert: 16r3FFFFFF = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF).
- 	self assert: 16r4000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000000).
- 	self assert: 16r4000013 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000013).
- 	self assert: 16r4FFFFFF = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1FFFFFF)
- !

Item was changed:
  ----- Method: HandBugs>>testTargetPoint (in category 'as yet unclassified') -----
  testTargetPoint
  "self new testTargetPoint"
  "self run: #testTargetPoint"
  
+ 	"This should not throw an exception."
+ 	ActiveHand targetPoint
- self shouldnt: [ ActiveHand targetPoint ] raise: Error .
  
  !

Item was changed:
  ----- Method: ImageSegmentTest>>testImageSegmentsShouldBeWritableToaFile (in category 'as yet unclassified') -----
  testImageSegmentsShouldBeWritableToaFile
+ 	"This should not throw an exception"
+ 	ImageSegment new
- 	self shouldnt: [
- 		ImageSegment new
  		copyFromRoots: (Array with: TestCase) sizeHint: 100;
  		extract;
  		writeToFile: 'TestCase';
+ 		yourself.
+ 		
+ 		"TODO: write assertions showing that something meaningful actually happened."!
- 		yourself] raise: Error.!

Item was changed:
  ----- Method: LangEnvBugs>>testIsFontAvailable (in category 'as yet unclassified') -----
  testIsFontAvailable
  	"self new testIsFontAvailable"
  	"self run: #testIsFontAvailable"
  	| oldPref |
- 
  	oldPref := Preferences valueOfPreference: #tinyDisplay.
+ 	Preferences restoreFontsAfter: [
+ 		[Preferences enable: #tinyDisplay.
+ 		"This should not throw an exception."
+ 		(LanguageEnvironment localeID: 'en' ) isFontAvailable]
+ 			ensure: [Preferences setPreference: #tinyDisplay toValue: oldPref]].!
- 	Preferences restoreFontsAfter:[
- 	[Preferences enable: #tinyDisplay .
- 	self 
- 		shouldnt:[(LanguageEnvironment localeID: 'en' ) isFontAvailable] 
- 		raise: Error.
- 	] ensure: [Preferences setPreference: #tinyDisplay toValue: oldPref].
- 	].!

Item was changed:
  ----- Method: MCSerializationTest>>assertExtensionProvidedBy: (in category 'asserting') -----
  assertExtensionProvidedBy: aClass
+ 	"This shouldn't raise an exception."
+ 	aClass readerClass extension.!
- 	self shouldnt: [aClass readerClass extension] raise: Exception.!

Item was changed:
  ----- Method: MCSnapshotBrowserTest>>testTextPane (in category 'testing') -----
  testTextPane
+ 	"This shouldn't raise an exception."
+ 	self textMorph.!
- 	self shouldnt: [self textMorph] raise: Exception.!

Item was changed:
  ----- Method: MCWorkingCopyTest>>testDoubleRepeatedMerge (in category 'tests') -----
  testDoubleRepeatedMerge
  	| base motherA1 motherA2 motherB1 motherB2 inst |
  	<timeout: 30> "takes a little longer"
  	base := self snapshot.
  	self change: #a toReturn: 'a1'.
  	motherA1 :=  self snapshot.
  	self change: #c toReturn: 'c1'.
  	motherA2 :=  self snapshot.	
  	
  	self load: base.
  	self change: #b toReturn: 'b1'.
  	motherB1 :=  self snapshot.
  	self change: #d toReturn: 'd1'.
  	motherB2 :=  self snapshot.
  	
  	self load: base.
  	self merge: motherA1.
  	self merge: motherB1.
  	self change: #a toReturn: 'a2'.
  	self change: #b toReturn: 'b2'.
  	self snapshot.
  
+ 	self merge: motherA2.
+ 	self merge: motherB2.
- 	self shouldnt: [self merge: motherA2] raise: Error.
- 	self shouldnt: [self merge: motherB2] raise: Error.
  	
  	inst := self mockInstanceA.
  	self assert: inst a = 'a2'.
  	self assert: inst b = 'b2'.
  	self assert: inst c = 'c1'.
  	self assert: inst d = 'd1'.
  	!

Item was changed:
  ----- Method: MCWorkingCopyTest>>testRedundantMerge (in category 'tests') -----
  testRedundantMerge
  	| base |
  	base :=  self snapshot.
  	self merge: base.
+ 	
+ 	"This shouldn't throw an exception"
+ 	self merge: base.!
- 	self shouldnt: [self merge: base] raise: Error.!

Item was changed:
  ----- Method: MCWorkingCopyTest>>testRepeatedMerge (in category 'tests') -----
  testRepeatedMerge
  	| base mother1 mother2 inst |
  	<timeout: 30> "takes a little longer"
  	base :=  self snapshot.
  	self change: #one toReturn: 2.
  	mother1 :=  self snapshot.
  	self change: #two toReturn: 3.
  	mother2 :=  self snapshot.	
  	
  	self load: base.
  	self change: #truth toReturn: false.
  	self snapshot.
  
  	inst := self mockInstanceA.
  	self assert: inst one = 1.
  	self assert: inst two = 2.	
  
  	self merge: mother1.
  	self assert: inst one = 2.
  	self assert: inst two = 2.	
  	
  	self change: #one toReturn: 7.
  	self assert: inst one = 7.
  	self assert: inst two = 2.
  	
+ 	"This shouldn't raise an exception"
+ 	self merge: mother2.
- 	self shouldnt: [self merge: mother2] raise: Error.
  	self assert: inst one = 7.
  	self assert: inst two = 3.!

Item was changed:
  ----- Method: PrimCallControllerAbstractTest>>testSwitchPrimCallOffOn (in category 'tests') -----
  testSwitchPrimCallOffOn
  	| res |
  	pcc disableCallInMethod: self realExternalCallOrPrimitiveFailedSelector class: self class.
  	self
  		should: [self perform: self realExternalCallOrPrimitiveFailedSelector]
  		raise: TestResult error.
  	pcc enableCallInMethod: self realExternalCallOrPrimitiveFailedSelector class: self class.
+ 	res := self perform: self realExternalCallOrPrimitiveFailedSelector.
- 	self
- 		shouldnt: [res := self perform: self realExternalCallOrPrimitiveFailedSelector]
- 		raise: TestResult error.
  	self assert: res isString!

Item was changed:
  ----- Method: StandardSourceFileArrayTest>>testSourcePointerFromFileIndexAndPosition (in category 'testing') -----
  testSourcePointerFromFileIndexAndPosition
  	"Test valid input ranges"
  
  	| sf |
  	sf := StandardSourceFileArray new.
  	self should: [sf sourcePointerFromFileIndex: 0 andPosition: 0] raise: Error.
- 	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 0] raise: Error.
- 	self shouldnt: [sf sourcePointerFromFileIndex: 2 andPosition: 0] raise: Error.
  	self should: [sf sourcePointerFromFileIndex: 0 andPosition: 3] raise: Error.
  	self should: [sf sourcePointerFromFileIndex: 1 andPosition: -1] raise: Error.
- 	self shouldnt: [sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF] raise: Error.
  	self should: [sf sourcePointerFromFileIndex: 1 andPosition: 16r2000000] raise: Error.
  	self should: [sf sourcePointerFromFileIndex: 3 andPosition: 0] raise: Error.
  	self should: [sf sourcePointerFromFileIndex: 4 andPosition: 0] raise: Error.
  	
+ 	self assert: 16r1000000 equals: (sf sourcePointerFromFileIndex: 1 andPosition: 0).
+ 	self assert: 16r1000013 equals: (sf sourcePointerFromFileIndex: 1 andPosition: 16r13).
+ 	self assert: 16r1FFFFFF equals: (sf sourcePointerFromFileIndex: 1 andPosition: 16rFFFFFF).
+ 	self assert: 16r2000000 equals: (sf sourcePointerFromFileIndex: 2 andPosition: 0).
+ 	self assert: 16r2000013 equals: (sf sourcePointerFromFileIndex: 2 andPosition: 16r13).
+ 	self assert: 16r2FFFFFF equals: (sf sourcePointerFromFileIndex: 2 andPosition: 16rFFFFFF).
+ 	self assert: 16r3000000 equals: (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000000).
+ 	self assert: 16r3000013 equals: (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000013).
+ 	self assert: 16r3FFFFFF equals: (sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF).
+ 	self assert: 16r4000000 equals: (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000000).
+ 	self assert: 16r4000013 equals: (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000013).
+ 	self assert: 16r4FFFFFF equals: (sf sourcePointerFromFileIndex: 2 andPosition: 16r1FFFFFF).!
- 	self assert: 16r1000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 0).
- 	self assert: 16r1000013 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r13).
- 	self assert: 16r1FFFFFF = (sf sourcePointerFromFileIndex: 1 andPosition: 16rFFFFFF).
- 	self assert: 16r2000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 0).
- 	self assert: 16r2000013 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r13).
- 	self assert: 16r2FFFFFF = (sf sourcePointerFromFileIndex: 2 andPosition: 16rFFFFFF).
- 	self assert: 16r3000000 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000000).
- 	self assert: 16r3000013 = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1000013).
- 	self assert: 16r3FFFFFF = (sf sourcePointerFromFileIndex: 1 andPosition: 16r1FFFFFF).
- 	self assert: 16r4000000 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000000).
- 	self assert: 16r4000013 = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1000013).
- 	self assert: 16r4FFFFFF = (sf sourcePointerFromFileIndex: 2 andPosition: 16r1FFFFFF)
- !



More information about the Squeak-dev mailing list