FFI: FFI-Tests-mt.40.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

FFI: FFI-Tests-mt.40.mcz

commits-2
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. ]]].!