FFI: FFI-CallbacksTests-mt.1.mcz

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.!