[Pkg] The Trunk: KernelTests-eem.335.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Mar 14 22:39:39 UTC 2018


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

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

Name: KernelTests-eem.335
Author: eem
Time: 14 March 2018, 3:39:26.80156 pm
UUID: f9d625c9-3103-46da-b5a4-5a4119c5bd29
Ancestors: KernelTests-eem.334

Have the literal location tests also check references in blocks.

=============== Diff against KernelTests-eem.334 ===============

Item was changed:
  ----- Method: LiteralRefLocatorTest>>testFindLiteralsInBytecode (in category 'tests') -----
  testFindLiteralsInBytecode
  	"Create a method referencing integers, characters, special selectors and nil, true & false.
  	 Compile it and check that the objects are found."
  	| source primary secondary binarySpecials integers characters |
  	binarySpecials := Smalltalk specialSelectors select: [:s| s isSymbol and: [s isBinary]].
  	"-65536 to 65535 in powers of two"
  	integers := ((16 to: 1 by: -1) collect: [:power| (2 raisedTo: power) negated]),
  				((0 to: 16) collect: [:power| (2 raisedTo: power) - 1]).
  	"some printable characters; alas none have code > 255"
  	characters := (0 to: 65535)
  					select: [:n| (n between: 132 and: 160) not "these have no glyph in typical fonts"
  								and: [(Character value: n) shouldBePrintedAsLiteral]]
  					thenCollect: [:n| Character value: n].
  	[characters size > 32] whileTrue:
  		[characters := (1 to: characters size by: 2) collect: [:i| characters at: i]].
+ 	
+ 	#(('' '') ('^[' ']')) do: "And the locators should work whether in a block or not"
+ 		[:pFixes|
+ 		source := ByteString streamContents:
+ 					[:s| | binaries |
+ 					binaries := binarySpecials readStream.
+ 					s nextPutAll: 'exampleMethod'; crtab; nextPutAll: pFixes first.
+ 					integers
+ 						do: [:n| s print: n]
+ 						separatedBy:
+ 							[binaries atEnd ifTrue: [binaries reset].
+ 							 s space; nextPutAll: binaries next; space].
+ 					s nextPut: $.; crtab.
+ 					s nextPut: ${; space.
+ 					characters
+ 						do: [:c| s print: c]
+ 						separatedBy: [s nextPut: $.; space].
+ 					s space; nextPut: $}; nextPut: $.; crtab.
+ 					s nextPutAll: 'true ifTrue: [^nil] ifFalse: [^false]'; nextPutAll: pFixes last].
+ 		primary := CompiledCode classPool at: #PrimaryBytecodeSetEncoderClass.
+ 		secondary := CompiledCode classPool at: #SecondaryBytecodeSetEncoderClass.
+ 		{ primary. secondary } do:
+ 			[:encoderClass| | method |
+ 			method := (Parser new
+ 								encoderClass: encoderClass;
+ 								parse: source class: self class)
+ 							generate: CompiledMethodTrailer empty.
- 	source := ByteString streamContents:
- 				[:s| | binaries |
- 				binaries := binarySpecials readStream.
- 				s nextPutAll: 'exampleMethod'; crtab.
- 				integers
- 					do: [:n| s print: n]
- 					separatedBy:
- 						[binaries atEnd ifTrue: [binaries reset].
- 						 s space; nextPutAll: binaries next; space].
- 				s nextPut: $.; crtab.
- 				s nextPut: ${; space.
- 				characters
- 					do: [:c| s print: c]
- 					separatedBy: [s nextPut: $.; space].
- 				s space; nextPut: $}; nextPut: $.; crtab.
- 				s nextPutAll: 'true ifTrue: [^nil] ifFalse: [^false]'].
- 	primary := CompiledCode classPool at: #PrimaryBytecodeSetEncoderClass.
- 	secondary := CompiledCode classPool at: #SecondaryBytecodeSetEncoderClass.
- 	{ primary. secondary } do:
- 		[:encoderClass| | method |
- 		method := (Parser new
- 							encoderClass: encoderClass;
- 							parse: source class: self class)
- 						generate: CompiledMethodTrailer empty.
- 		binarySpecials, integers, characters, #(nil false true) do:
- 			[:literal|
- 			self assert: (method
- 							refersTo: literal
- 							primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal)
- 							secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal)
- 							thorough: false).
- 			(encoderClass scanBlockOrNilForLiteral: literal)
- 				ifNil: [self assert: (method hasLiteral: literal)]
- 				ifNotNil: [:scanBlock| self assert: (method scanFor: scanBlock)]].
- 
- 		"Now test for false positives..."
- 		integers, characters, #(nil false true) do:
- 			[:literal| | simpleSource simpleMethod |
- 			simpleSource := ByteString streamContents:
- 								[:s| s nextPutAll: 'exampleMethod'; crtab; print: literal; nextPutAll: ' class'].
- 			simpleMethod := (Parser new
- 									encoderClass: encoderClass;
- 									parse: simpleSource class: self class)
- 								generate: CompiledMethodTrailer empty.
  			binarySpecials, integers, characters, #(nil false true) do:
+ 				[:literal|
+ 				self assert: (method
+ 								refersTo: literal
+ 								primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal)
+ 								secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal)
+ 								thorough: false).
+ 				(encoderClass scanBlockOrNilForLiteral: literal)
+ 					ifNil: [self assert: (method hasLiteral: literal)]
+ 					ifNotNil: [:scanBlock|
+ 							self assert: ((method scanFor: scanBlock)
+ 										or: [method literals anySatisfy: [:l| l isCompiledCode and: [l scanFor: scanBlock]]])]].
+ 
+ 			"Now test for false positives..."
+ 			integers, characters, #(nil false true) do:
+ 				[:literal| | simpleSource simpleMethod |
+ 				simpleSource := ByteString streamContents:
+ 									[:s| s nextPutAll: 'exampleMethod'; crtab; nextPutAll: pFixes first; print: literal; nextPutAll: ' class'; nextPutAll: pFixes last].
+ 				simpleMethod := (Parser new
+ 										encoderClass: encoderClass;
+ 										parse: simpleSource class: self class)
+ 									generate: CompiledMethodTrailer empty.
+ 				binarySpecials, integers, characters, #(nil false true) do:
+ 					[:anyLiteral|
+ 					anyLiteral == literal
+ 						ifTrue:
+ 							[self assert: (simpleMethod
+ 											refersTo: anyLiteral
+ 											primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: anyLiteral)
+ 											secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: anyLiteral)
+ 											thorough: false).
+ 							(encoderClass scanBlockOrNilForLiteral: anyLiteral)
+ 								ifNil: [self assert: (simpleMethod hasLiteral: anyLiteral)]
+ 								ifNotNil: [:scanBlock|
+ 										self assert: ((simpleMethod scanFor: scanBlock)
+ 										or: [simpleMethod literals anySatisfy: [:l| l isCompiledCode and: [l scanFor: scanBlock]]])]]
+ 						ifFalse:
+ 							[self deny: (simpleMethod
+ 											refersTo: anyLiteral
+ 											primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: anyLiteral)
+ 											secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: anyLiteral)
+ 											thorough: false).
+ 							(encoderClass scanBlockOrNilForLiteral: anyLiteral)
+ 								ifNil: [self deny: (simpleMethod hasLiteral: anyLiteral)]
+ 								ifNotNil: [:scanBlock|
+ 										self deny: ((simpleMethod scanFor: scanBlock)
+ 										or: [simpleMethod literals anySatisfy: [:l| l isCompiledCode and: [l scanFor: scanBlock]]])]]]]]]!
- 				[:anyLiteral|
- 				anyLiteral == literal
- 					ifTrue:
- 						[self assert: (simpleMethod
- 										refersTo: anyLiteral
- 										primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: anyLiteral)
- 										secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: anyLiteral)
- 										thorough: false).
- 						(encoderClass scanBlockOrNilForLiteral: anyLiteral)
- 							ifNil: [self assert: (simpleMethod hasLiteral: anyLiteral)]
- 							ifNotNil: [:scanBlock| self assert: (simpleMethod scanFor: scanBlock)]]
- 					ifFalse:
- 						[self deny: (simpleMethod
- 										refersTo: anyLiteral
- 										primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: anyLiteral)
- 										secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: anyLiteral)
- 										thorough: false).
- 						(encoderClass scanBlockOrNilForLiteral: anyLiteral)
- 							ifNil: [self deny: (simpleMethod hasLiteral: anyLiteral)]
- 							ifNotNil: [:scanBlock| self deny: (simpleMethod scanFor: scanBlock)]]]]]!

Item was changed:
  ----- Method: LiteralRefLocatorTest>>testThoroughFindLiteralsInBytecode (in category 'tests') -----
  testThoroughFindLiteralsInBytecode
  	"Create a method referencing integers, characters, special selectors and nil, true & false.
  	 Compile it and check that the objects are found."
  	| literals problem primary secondary |
  	literals := #(-1 0 1 $0 $1 1.0 #[1 2 3 4] 'one' #one nil true false NaN).
  	problem := Float bindingOf: #NaN.
  	primary := CompiledCode classPool at: #PrimaryBytecodeSetEncoderClass.
  	secondary := CompiledCode classPool at: #SecondaryBytecodeSetEncoderClass.
  	{ primary. secondary } do:
  		[:encoderClass| | method |
+ 		#(('' '') ('^[' ']')) do: "And the locators should work whether in a block or not"
+ 			[:pFixes|
+ 			"NaN's binding should still be found even though (Float bindingOf: #NaN) ~= (Float bindingOf: #NaN)"
+ 			method := (Parser new
+ 								encoderClass: encoderClass;
+ 								parse: 'foo ', pFixes first, '^NaN', pFixes last class: Float)
+ 							generate: CompiledMethodTrailer empty.
- 		"NaN's binding should still be found even though (Float bindingOf: #NaN) ~= (Float bindingOf: #NaN)"
- 		method := (Parser new
- 							encoderClass: encoderClass;
- 							parse: 'foo ^NaN' class: Float)
- 						generate: CompiledMethodTrailer empty.
- 		[:literal|
- 		 self assert: (method
- 						refersTo: literal
- 						primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal)
- 						secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal)
- 						thorough: false).
- 		 self assert: (method
- 						refersTo: literal
- 						primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal)
- 						secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal)
- 						thorough: true)] value: problem.
- 
- 		"All the literals should be found in a thorough search, but not otherwise"
- 		method := (Parser new
- 							encoderClass: encoderClass;
- 							parse: 'foo ^', literals storeString class: Float)
- 						generate: CompiledMethodTrailer empty.
- 		literals, {problem. problem key} do:
  			[:literal|
+ 			 self assert: (method
- 			self deny: (method
  							refersTo: literal
  							primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal)
  							secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal)
  							thorough: false).
+ 			 self assert: (method
- 			self assert: (method
  							refersTo: literal
  							primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal)
  							secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal)
+ 							thorough: true)] value: problem.
- 							thorough: true)].
  
+ 			"All the literals should be found in a thorough search, but not otherwise"
+ 			method := (Parser new
+ 								encoderClass: encoderClass;
+ 								parse: 'foo ', pFixes first, '^', literals storeString, pFixes last class: Float)
+ 							generate: CompiledMethodTrailer empty.
+ 			literals, {problem. problem key} do:
+ 				[:literal|
+ 				self deny: (method
+ 								refersTo: literal
+ 								primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal)
+ 								secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal)
+ 								thorough: false).
+ 				self assert: (method
+ 								refersTo: literal
+ 								primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal)
+ 								secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal)
+ 								thorough: true)]].
+ 
  		"Likewise if in a pragma"
  		method := (Parser new
  							encoderClass: encoderClass;
  							parse: 'foo <pragma: ', literals storeString, ' with: ', problem key storeString, '>' class: Float)
  						generate: CompiledMethodTrailer empty.
  		literals, {problem. problem key} do:
  			[:literal|
  			self deny: (method
  							refersTo: literal
  							primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal)
  							secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal)
  							thorough: false).
  			self assert: (method
  							refersTo: literal
  							primaryBytecodeScanner: (primary scanBlockOrNilForLiteral: literal)
  							secondaryBytecodeScanner: (secondary scanBlockOrNilForLiteral: literal)
  							thorough: true)]]!



More information about the Packages mailing list