Posted by
commits-2 on
May 16, 2021; 11:03am
URL: https://forum.world.st/FFI-FFI-Tests-mt-40-mcz-tp5129738.html
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@2 . 3@3 } equals: (copy collect: [:each | each asPoint]).
copy writer withIndexDo: [:point :index | point setX: index+1 setY: index+1].
self assert: { 2@2 . 3@3 } equals: (copy collect: [:each | each asPoint]).
"Check that we did not touch the original."
self
assert: { 0@0 . 0@0 . 0@0 . 0@0 . 0@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. ]]].!