[squeak-dev] FFI: FFI-Tests-mt.40.mcz

commits at source.squeak.org commits at source.squeak.org
Sun May 16 11:03:45 UTC 2021


Marcel Taeumel uploaded a new version of FFI-Tests to project FFI:
http://source.squeak.org/FFI/FFI-Tests-mt.40.mcz

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

Name: FFI-Tests-mt.40
Author: mt
Time: 16 May 2021, 1:03:43.340551 pm
UUID: ba595b70-5e3c-5f4e-ac74-7d780815f6c6
Ancestors: FFI-Tests-mt.39

Complements FFI-Kernel-mt.153

Tests for global variables pass now. :-)

=============== Diff against FFI-Tests-mt.39 ===============

Item was changed:
  ----- Method: FFIAllocateExternalTests>>checkAllocate: (in category 'running') -----
  checkAllocate: externalObject
  
  	| type handle |
  	self assert: externalObject notNil.
- 	(externalObject isExternalObject)
- 		ifFalse: [
- 			externalObjects remove: externalObject. "skip free"
- 			^ self "atomics are fine"].
  
  	type := externalObject externalType.
  	handle := externalObject getHandle.
  	
- 	(type isAtomic and: [type isVoid not]) ifTrue: [
- 		self deny: handle isExternalAddress.
- 		self deny: handle isInternalMemory.
- 		self deny: handle isNil.
- 		^ self].
- 
  	self deny: externalObject isNull.
  	self deny: handle isNull.
  	self deny: handle isNil.
  	
  	self assert: type isPointerType.
+ 	self assert: handle isExternalAddress.!
- 	self assert: handle isExternalAddress.
- 	
- 	self deny: handle isInternalMemory.!

Item was changed:
  ----- Method: FFIAllocateExternalTests>>checkFree: (in category 'running') -----
  checkFree: externalObject
  
  	| type handle |
  	type := externalObject externalType.
  	handle := externalObject getHandle.
  
  	self assert: externalObject isNull.
  	
  	(type isTypeAlias and: [type isAtomic]) ifTrue: [
  		self assert: handle isNil.
  		^ self].
  	
  	self assert: type isPointerType.	
  	self assert: handle isExternalAddress.
- 	self deny: handle isInternalMemory.
  	self assert: handle isNull.!

Item was changed:
  ----- Method: FFIAllocateExternalTests>>expectedFailures (in category 'failures') -----
  expectedFailures
  
+ 	^ super expectedFailures
- 	^ (super expectedFailures
  	
  	copyWithoutAll: #(
  		test04LinkedList "Storing pointers works fine."
- 	)), #(
- 		test03GlobalVariable "Atomic values in an alias container will be fetched immediately. Hmm..."
  	)!

Item was removed:
- ----- Method: FFIAllocateExternalTests>>test03GlobalVariable (in category 'tests') -----
- test03GlobalVariable
- 	"If you happen to have to address to a global variable you can use a type alias."
- 	| global |
- 	global := self allocate: FFITestAliasForInt32.
- 	self assert: global getHandle isExternalAddress.
- 	self assert: global externalType isPointerType.
- 	self assert: 0 equals: global value.
- 	global value: 42.
- 	self assert: 42 equals: global value.!

Item was changed:
  ----- Method: FFIAllocateTests>>checkAllocate: (in category 'running') -----
  checkAllocate: externalObject
  
  	| type handle |
  	self assert: externalObject notNil.
- 	(externalObject isExternalObject)
- 		ifFalse: [
- 			externalObjects remove: externalObject. "skip free"
- 			^ self "pure atomics are fine"].
  
  	type := externalObject externalType.
  	handle := externalObject getHandle.
  	
- 	(type isAtomic and: [type isVoid not]) ifTrue: [
- 		self deny: handle isExternalAddress.
- 		self deny: handle isInternalMemory.
- 		self deny: handle isNil.
- 		^ self].
- 
  	self deny: externalObject isNull.
  	self deny: handle isNull.
  	self deny: handle isNil.
  	
  	self deny: type isPointerType.
+ 	self deny: handle isExternalAddress.!
- 	self deny: handle isExternalAddress.
- 	
- 	self assert: handle isInternalMemory.!

Item was changed:
  ----- Method: FFIAllocateTests>>tearDown (in category 'running') -----
  tearDown
  
  	externalObjects do: [:externalObject |
+ 		externalObjects isExternalObject "i.e. not a RawBitsArray"
+ 			ifTrue: [
+ 				externalObject free.
+ 				self checkFree: externalObject]].!
- 		externalObject free.
- 		self checkFree: externalObject].!

Item was changed:
  ----- Method: FFIAllocateTests>>test01AllocateAtomics (in category 'tests - atomics') -----
  test01AllocateAtomics
  	
  	self should: [(self allocate: ExternalType void)] raise: Error.
+ 	self assert: false equals: (self allocate: ExternalType bool) value.
- 	self assert: false equals: (self allocate: ExternalType bool).
  
+ 	self assert: 0 equals: (self allocate: ExternalType int8_t "sbyte") value.
+ 	self assert: 0 equals: (self allocate: ExternalType uint8_t "byte") value.
- 	self assert: 0 equals: (self allocate: ExternalType int8_t "sbyte").
- 	self assert: 0 equals: (self allocate: ExternalType uint8_t "byte").
  
+ 	self assert: 0 equals: (self allocate: ExternalType uint16_t "ushort") value.
+ 	self assert: 0 equals: (self allocate: ExternalType int16_t "short") value.
- 	self assert: 0 equals: (self allocate: ExternalType uint16_t "ushort").
- 	self assert: 0 equals: (self allocate: ExternalType int16_t "short").
  
+ 	self assert: 0 equals: (self allocate: ExternalType uint32_t "ulong") value.
+ 	self assert: 0 equals: (self allocate: ExternalType int32_t "long") value.
- 	self assert: 0 equals: (self allocate: ExternalType uint32_t "ulong").
- 	self assert: 0 equals: (self allocate: ExternalType int32_t "long").
  
+ 	self assert: 0 equals: (self allocate: ExternalType uint64_t "ulonglong") value.
+ 	self assert: 0 equals: (self allocate: ExternalType int64_t "longlong") value.
- 	self assert: 0 equals: (self allocate: ExternalType uint64_t "ulonglong").
- 	self assert: 0 equals: (self allocate: ExternalType int64_t "longlong").
  
+ 	self assert: Character null equals: (self allocate: ExternalType schar) value.
+ 	self assert: Character null equals: (self allocate: ExternalType char) value.
- 	self assert: Character null equals: (self allocate: ExternalType schar).
- 	self assert: Character null equals: (self allocate: ExternalType char).
  
+ 	self assert: 0.0 equals: (self allocate: ExternalType float) value.
+ 	self assert: 0.0 equals: (self allocate: ExternalType double) value.!
- 	self assert: 0.0 equals: (self allocate: ExternalType float).
- 	self assert: 0.0 equals: (self allocate: ExternalType double).!

Item was changed:
  ----- Method: FFIAllocateTests>>test02ArrayCopyFromTo (in category 'tests - array') -----
  test02ArrayCopyFromTo
  	"Copy a portion of an array into a new array."
  
  	| points copy |
  	points := self allocate: FFITestPoint2 size: 5.
  	
  	copy := points copyFrom: 2 to: 3.
+ 	self deny: copy getHandle isExternalAddress.
- 	self assert: copy getHandle isInternalMemory.
  	
  	"We need a writer to modify internal memory."
  	copy withIndexDo: [:point :index | point setX: index+1 setY: index+1].
  	self deny: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]).
  	copy writer withIndexDo: [:point :index | point setX: index+1 setY: index+1].
  	self assert: { 2 at 2 . 3 at 3 } equals: (copy collect: [:each | each asPoint]).
  
  	"Check that we did not touch the original."
  	self
  		assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 }
  		equals: (points collect: [:each | each asPoint]).!

Item was changed:
  ----- Method: FFIAllocateTests>>test03GlobalVariable (in category 'tests') -----
  test03GlobalVariable
  	"If you happen to have to address to a global variable you can use a type alias or just external data for it. See ExternalObject class >> #fromHandle:."
+ 
+ 	| global alias |
- 	| global |
  	global := self allocate: FFITestAliasForInt32.
+ 	self deny: global isFFIArray.
  	self assert: 0 equals: global value.
+ 	
+ 	alias := global class fromHandle: global getHandle.
+ 	self assert: 0 equals: alias value.
+ 	
+ 	alias value: 42.
+ 	self assert: 42 equals: alias value.
- 	global value: 42.
  	self assert: 42 equals: global value.!

Item was changed:
  ----- Method: FFIAllocateTests>>test04GlobalVariableInArray (in category 'tests') -----
  test04GlobalVariableInArray
  	"If you happen to have to address to a global variable you can use a type alias or just external data for it. See ExternalObject class >> #fromHandle:."
+ 
+ 	| global alias |
+ 	global := self allocate: ExternalType int32_t.
- 	| global |
- 	global := self allocate: ExternalType int32_t size: 1.
  	self assert: global isFFIArray.
  	self assert: 0 equals: global value.
+ 
+ 	alias := global class fromHandle: global getHandle.
+ 	alias setContentType: global contentType.
+ 	self assert: 0 equals: alias value.
+ 	
+ 	alias value: 42.
+ 	self assert: 42 equals: alias value.
- 	global value: 42.
  	self assert: 42 equals: global value.!

Item was changed:
  ----- Method: FFIAllocateTests>>test10ArrayClasses (in category 'tests - array') -----
  test10ArrayClasses
  	"For integer and float types, allocate arrays and check for specific array classes. Then construct a conventional byte array for an external data structure. A copy should also convert into a specific array class with the same contents."
  	
  	ExternalType useArrayClassesDuring: [
  		
  	ExternalType atomicTypes do: [:contentType |
  		(contentType isIntegerType
  			or: [contentType isFloatType]
  			or: [contentType isCharType]) ifTrue: [
  				| array arrayType data copy |
  				array := self allocate: contentType size: 5.
  				arrayType := array externalType.
  
  				self assert: array isFFIArray.
  				self assert: 5 equals: array size.
  				self assert: array byteSize equals: arrayType byteSize.
  				
  				contentType = ExternalType signedChar ifFalse: [
  					self flag: #discuss. "mt: What is signedChar even for?"
  					self assert: contentType equals: array contentType].
  
  				self deny: array isNull.
  				self deny: (array isKindOf: ExternalData).
  				self assert: array equals: array getHandle.
  				
+ 				self shouldnt: [array at: 1 put: contentType allocate first] raise: Error.
- 				self shouldnt: [array at: 1 put: contentType allocate] raise: Error.
  				self shouldnt: [array zeroMemory] raise: Error.
  				self should: [array setContentType: ExternalType byte] raise: Error.
  				self should: [array setSize: 42] raise: Error.
  
  				data := ExternalData
  					fromHandle: (ByteArray new: arrayType byteSize)
  					type: arrayType.
  				copy := data copy. "From external data into raw-bits array."
  				self deny: array equals: data.			
  				self assert: array equals: copy. ]]].!



More information about the Squeak-dev mailing list