Posted by
commits-2 on
May 26, 2021; 4:23pm
URL: https://forum.world.st/FFI-FFI-CallbacksTests-mt-1-mcz-tp5130021.html
Marcel Taeumel uploaded a new version of FFI-CallbacksTests to project FFI:
http://source.squeak.org/FFI/FFI-CallbacksTests-mt.1.mcz==================== Summary ====================
Name: FFI-CallbacksTests-mt.1
Author: mt
Time: 26 May 2021, 6:23:09.127788 pm
UUID: ca368808-aa20-a94f-8756-cb35faf36504
Ancestors:
Adds some tests around callbacks using qsort and bsearch from the C standard library.
Complements (and depends on): FFI-Kernel-mt.171 FFI-Callbacks-mt.19 FFI-Tests-mt.50
==================== Snapshot ====================
SystemOrganization addCategory: #'FFI-CallbacksTests'!
TestCase subclass: #FFICallbackTests
instanceVariableNames: 'lib externalObjects'
classVariableNames: ''
poolDictionaries: ''
category: 'FFI-CallbacksTests'!
----- Method: FFICallbackTests>>expectedFailures (in category 'failures') -----
expectedFailures
^ #(
test02SortArrayOfDoublesRaw "Checked on 32-bit. Coercing checks are too aggressive or just wrong."
test04SortArrayOfIntegersRaw "See above."
)!
----- Method: FFICallbackTests>>performTest (in category 'running') -----
performTest
"Tests should opt-in to have more control."
| prior1 prior2 |
prior1 := ExternalType useArrayClasses.
prior2 := ExternalData extraSizeChecks.
[ExternalType useArrayClasses: false.
ExternalData extraSizeChecks: true.
super performTest]
ensure: [
ExternalType useArrayClasses: prior1.
ExternalData extraSizeChecks: prior2].!
----- Method: FFICallbackTests>>setUp (in category 'running') -----
setUp
super setUp.
lib := CStandardLibrary default.
externalObjects := OrderedCollection new.!
----- Method: FFICallbackTests>>tearDown (in category 'running') -----
tearDown
externalObjects do: [:ea | ea free].
super tearDown.!
----- Method: FFICallbackTests>>test01SortArrayOfDoubles (in category 'tests') -----
test01SortArrayOfDoubles
| array unsorted sorted |
unsorted := #(0.8332389864879751 0.5043604970280617 0.36114975224430435 0.8103526363890933 0.7802893776251926 0.5329258270112472 0.23437693854303543 0.509741853444245 0.0275989539897884 0.548561613276074).
sorted := #(0.0275989539897884 0.23437693854303543 0.36114975224430435 0.5043604970280617 0.509741853444245 0.5329258270112472 0.548561613276074 0.7802893776251926 0.8103526363890933 0.8332389864879751).
array := ExternalType double allocate: 10.
1 to: array size do: [:index |
array at: index put: (unsorted at: index)].
self deny: (sorted hasEqualElements: array).
lib
qsort: array
compare: [:a :b | (a - b) sign].
self assert: (sorted hasEqualElements: array).!
----- Method: FFICallbackTests>>test02SortArrayOfDoublesRaw (in category 'tests') -----
test02SortArrayOfDoublesRaw
ExternalType useArrayClassesDuring: [self test01SortArrayOfDoubles].!
----- Method: FFICallbackTests>>test03SortArrayOfIntegers (in category 'tests') -----
test03SortArrayOfIntegers
| array unsorted sorted |
unsorted := #(3036962509 3319035228 2533963671 3440375993 2159145233 2156551592 3216768444 3368770086 3413300624 2615411192).
sorted := #(2156551592 2159145233 2533963671 2615411192 3036962509 3216768444 3319035228 3368770086 3413300624 3440375993).
array := ExternalType int64_t allocate: 10.
1 to: array size do: [:index |
array at: index put: (unsorted at: index)].
self deny: (sorted hasEqualElements: array).
lib
qsort: array
compare: [:a :b | (a - b) sign].
self assert: (sorted hasEqualElements: array).!
----- Method: FFICallbackTests>>test04SortArrayOfIntegersRaw (in category 'tests') -----
test04SortArrayOfIntegersRaw
ExternalType useArrayClassesDuring: [self test03SortArrayOfIntegers].!
----- Method: FFICallbackTests>>test05SortArrayOfPointers (in category 'tests') -----
test05SortArrayOfPointers
"Fill an array with pointers to atomics. Then sort that array. Note that #value reads from and #value: writes into the first element from ExternalData."
| type array unsorted sorted |
type := ExternalType int32_t.
array := type asPointerType allocate: 10.
unsorted := #(10 9 1 5 4 3 7 6 2 8).
sorted := #(1 2 3 4 5 6 7 8 9 10).
1 to: array size do: [:index |
array
at: index
put: ((externalObjects add: type allocateExternal)
value: (unsorted at: index);
yourself)].
self deny: (sorted hasEqualElements: (array collect: #value)).
lib
qsort: array
compare: [:a :b | (a value - b value) sign].
self assert: (sorted hasEqualElements: (array collect: #value)).!
----- Method: FFICallbackTests>>test06SortArrayOfStructs (in category 'tests') -----
test06SortArrayOfStructs
| array unsorted sorted compare |
unsorted := {58@43 . 99@90 . 63@34 . 19@67 . 99@18 . 57@52 . 5@28 . 68@46 . 49@20 . 90@32}.
sorted := {5@28 . 19@67 . 49@20 . 57@52 . 58@43 . 63@34 . 68@46 . 90@32 . 99@18 . 99@90}.
compare := [:pt1 :pt2 |
pt1 = pt2 ifTrue: [0] ifFalse: [
(pt1 x <= pt2 x and: [pt1 x ~= pt2 x or: [pt1 y <= pt2 y]])
ifTrue: [-1] ifFalse: [1]]].
array := FFITestPoint2 allocate: 10.
1 to: array size do: [:index |
array at: index put: (FFITestPoint2 fromPoint: (unsorted at: index))].
self deny: (sorted hasEqualElements: (array collect: #asPoint)).
lib
qsort: array
compare: [:ffiPt1 :ffiPt2 | compare value: ffiPt1 asPoint value: ffiPt2 asPoint].
self assert: (sorted hasEqualElements: (array collect: #asPoint)).!
----- Method: FFICallbackTests>>test07FindFirst (in category 'tests') -----
test07FindFirst
| array key sorted result |
array := ExternalType int32_t allocateExternal: 10.
externalObjects add: array.
key := ExternalType int32_t allocateExternal.
externalObjects add: key.
sorted := #(10 22 23 23 39 44 56 57 67 79).
1 to: array size do: [:index |
array at: index put: (sorted at: index)].
key value: (sorted at: 7).
result := lib bsearch: key in: array compare: [:a :b | (a - b) sign].
self deny: result isNull.
self assert: key value equals: result value.
self deny: (key ffiIdentical: result).
self assert: ((array from: 7 to: 7) ffiIdentical: result).
key value: 111.
self deny: (sorted includes: key value).
result := lib bsearch: key in: array compare: [:a :b | (a - b) sign].
self assert: result isNull.!