[squeak-dev] FFI: FFI-Tests-mt.32.mczcommits at source.squeak.org commits at source.squeak.orgFri May 14 13:03:37 UTC 2021
Marcel Taeumel uploaded a new version of FFI-Tests to project FFI: http://source.squeak.org/FFI/FFI-Tests-mt.32.mcz ==================== Summary ==================== Name: FFI-Tests-mt.32 Author: mt Time: 14 May 2021, 3:03:36.29576 pm UUID: b806028d-7859-7f44-8485-b5958de811ed Ancestors: FFI-Tests-mt.31 Re-designs and expands all FFI tests. We now have about 400 tests for the type system, type-based allocation, and FFI plugin calls. =============== Diff against FFI-Tests-mt.31 =============== Item was removed: - TestCase subclass: #ExternalStructureTests - instanceVariableNames: 'heapObject' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Tests'! Item was removed: - ----- Method: ExternalStructureTests>>tearDown (in category 'running') ----- - tearDown - - heapObject ifNotNil: [heapObject free].! Item was removed: - ----- Method: ExternalStructureTests>>test01AccessingUnion (in category 'tests') ----- - test01AccessingUnion - - | ufi | - ufi := FFITestUfi new. - ufi i1: 2. - self assert: 2 equals: ufi i1. - ufi f1: 1.0. - self assert: 1.0 equals: ufi f1. - self assert: 1.0 asIEEE32BitWord equals: ufi i1. - ufi i1: 2.0 asIEEE32BitWord. - self assert: 2.0 equals: ufi f1.! Item was removed: - ----- Method: ExternalStructureTests>>test01CopyStructure (in category 'tests - external structure') ----- - test01CopyStructure - - | original copy | - original := FFITestPoint2 new. - original setX: 1 setY: 2. - - copy := original copy. - self assert: original getHandle ~~ copy getHandle. - - copy setX: 3 setY: 4. - self assert: 1 at 2 equals: original asPoint. - self assert: 3 at 4 equals: copy asPoint.! Item was removed: - ----- Method: ExternalStructureTests>>test01FromToInternal (in category 'tests - external data') ----- - test01FromToInternal - "Access a sub-range in the external data. Internal memory will be copied if not accessed through a read-writer." - - | points portion | - points := FFITestPoint2 allocate: 5. - portion := points from: 2 to: 3. - self assert: portion getHandle isInternalMemory. - - portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self "Forgot to use a read-writer..." - assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } - equals: (points collect: [:each | each asPoint]). - - portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self "Forgot to use a read-writer early enough..." - assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } - equals: (points collect: [:each | each asPoint]). - - portion := points writer from: 2 to: 3. - portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self - assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } - equals: (points collect: [:each | each asPoint]). - - points zeroMemory. - portion := points reader from: 2 to: 3. - portion writer withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self "Both #reader and #writer used. No worries." - assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } - equals: (points collect: [:each | each asPoint]).! Item was removed: - ----- Method: ExternalStructureTests>>test02AccessingStructure (in category 'tests') ----- - test02AccessingStructure - - | pt | - pt := FFITestPoint2 new. - pt x: 10; y: 20. - self assert: 10 equals: pt x. - self assert: 20 equals: pt y.! Item was removed: - ----- Method: ExternalStructureTests>>test02CopyStructureFromExternal (in category 'tests - external structure') ----- - test02CopyStructureFromExternal - - | original copy | - original := heapObject := FFITestPoint2 allocateExternal. - original setX: 1 setY: 2. - - copy := original copy. - self assert: copy getHandle isInternalMemory. - - copy setX: 3 setY: 4. - self assert: 1 at 2 equals: original asPoint. - self assert: 3 at 4 equals: copy asPoint.! Item was removed: - ----- Method: ExternalStructureTests>>test02FromToExternal (in category 'tests - external data') ----- - test02FromToExternal - "Access a sub-range in the external data. External memory will not be copied." - - | points portion | - points := heapObject := FFITestPoint2 allocateExternal: 5. - - portion := points from: 2 to: 3. - self assert: portion getHandle isExternalAddress. - - portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. - self - assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } - equals: (points collect: [:each | each asPoint]).! Item was removed: - ----- Method: ExternalStructureTests>>test03AccessingExternalData (in category 'tests') ----- - test03AccessingExternalData - - | somePoints firstPoint | - somePoints := FFITestPoint2 allocate: 5. - self assert: 5 equals: somePoints size. - firstPoint := somePoints at: 1. - self assert: 0 at 0 equals: firstPoint asPoint. - firstPoint setX: 2 setY: 3. - self assert: 2 at 3 equals: firstPoint asPoint.! Item was removed: - ----- Method: ExternalStructureTests>>test03CopyFromExternalToInternal (in category 'tests - external data') ----- - test03CopyFromExternalToInternal - - | points copy | - points := FFITestPoint2 allocateExternal: 5. - self assert: points getHandle isExternalAddress. - - copy := points copyFrom: 2 to: 3. - 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 external memory." - 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 removed: - ----- Method: ExternalStructureTests>>test03LinkedList (in category 'tests - external structure') ----- - test03LinkedList - - | link1 link2 link3 | - [ link1 := FFITestLink allocateExternal. - link2 := FFITestLink allocateExternal. - link3 := FFITestLink allocateExternal. - link1 next: link2. link2 prev: link1. - link2 next: link3. link3 prev: link2. - link3 next: link1. link1 prev: link3. - self assert: link1 next = link2. - self assert: link2 next = link3. - self assert: link3 next = link1. - - self assert: link3 prev = link2. - self assert: link2 prev = link1. - self assert: link1 prev = link3. - - ] ensure: [ - link1 free. - link2 free. - link3 free. - ]! Item was removed: - ----- Method: ExternalStructureTests>>test04AccessingInternalMemory (in category 'tests') ----- - test04AccessingInternalMemory - "Check whether we can use a ByteArrayWriter to fill structures." - - | composite | - composite := FFITestSUfdUdSi2 allocate. - - self assert: composite ~~ composite writer. - - self assert: 0.0 equals: composite ufd1 f1. - composite ufd1 f1: 3.5. - self deny: 3.5 equals: composite ufd1 f1. - composite writer ufd1 f1: 3.5. - self assert: 3.5 equals: composite ufd1 f1. - - self assert: 0 equals: composite udSii2 sii1 i1. - composite udSii2 sii1 i1: 42. - self deny: 42 equals: composite udSii2 sii1 i1. - composite writer udSii2 sii1 i1: 42. - self assert: 42 equals: composite udSii2 sii1 i1.! Item was removed: - ----- Method: ExternalStructureTests>>test04CopyFromInternalToInternal (in category 'tests - external data') ----- - test04CopyFromInternalToInternal - - | points copy | - points := FFITestPoint2 allocate: 5. - self assert: points getHandle isInternalMemory. - - copy := points copyFrom: 2 to: 3. - 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 removed: - ----- Method: ExternalStructureTests>>test05AccessingExternalMemory (in category 'tests') ----- - test05AccessingExternalMemory - "Check whether we will stick to the ExternalAddress to fill structures." - - | composite | - composite := heapObject := FFITestSUfdUdSi2 allocateExternal. - - self assert: composite == composite writer. - - self assert: 0.0 equals: composite ufd1 f1. - composite ufd1 f1: 3.5. - self assert: 3.5 equals: composite ufd1 f1. - - self assert: 0 equals: composite udSii2 sii1 i1. - composite udSii2 sii1 i1: 42. - self assert: 42 equals: composite udSii2 sii1 i1.! Item was removed: - ----- Method: ExternalStructureTests>>test05ReadCString (in category 'tests - external data') ----- - test05ReadCString - - | data | - ExternalData allowDetectForUnknownSizeDuring: [ - data := ExternalData fromHandle: #[65 66 67 0] type: ExternalType char. - self assert: 'ABC' equals: data fromCString. - data := ExternalData fromHandle: #[65 66 67 0 68 69 70 0 0] type: ExternalType char. - self assert:#('ABC' 'DEF') equals: data fromCStrings].! Item was removed: - ----- Method: ExternalStructureTests>>test06AccessingTypeAliasForAtomic (in category 'tests') ----- - test06AccessingTypeAliasForAtomic - - | char | - char := FFITestCharAlias new. - self assert: 0 equals: char value asInteger. - char value: $A. - self assert: $A equals: char value. - char zeroMemory. - self assert: 0 equals: char value asInteger.! Item was removed: - ----- Method: ExternalStructureTests>>test07AccessingArrays (in category 'tests') ----- - test07AccessingArrays - - | data | - data := FFITestSdA5i allocate. - self assert: data a5i2 first equals: 0. - data writer a5i2 at: 1 put: 42. - self assert: data a5i2 first equals: 42. - - data := heapObject := FFITestSdA5i allocateExternal. - self assert: data a5i2 first equals: 0. - data a5i2 at: 1 put: 42. - self assert: data a5i2 first equals: 42.! Item was changed: TestCase subclass: #ExternalTypeTests instanceVariableNames: 'heapObject' classVariableNames: '' + poolDictionaries: '' - poolDictionaries: 'ExternalType' category: 'FFI-Tests'! Item was added: + ----- Method: ExternalTypeTests>>classesForStructures (in category 'running') ----- + classesForStructures + "Answer a list of struct classes to be used when testing struct types." + + ^ { + FFITestPoint2. + FFITestSdi. + FFITestUfd. + FFITestCompoundStruct. + }! Item was added: + ----- Method: ExternalTypeTests>>classesForTypeAliases (in category 'running') ----- + classesForTypeAliases + "Answer a list of type-alias classes to be used when testing types for type aliases." + + ^ { + FFITestAliasForChar. "alias to atomic" + FFITestAliasForInt32. "alias to atomic" + FFITestAliasForSdi. "alias to struct" + }! Item was added: + ----- Method: ExternalTypeTests>>expectedFailures (in category 'failures') ----- + expectedFailures + + ^ #( + testIsArrayType "Fails because compiledSpec does not yet encode that maybe because of extra information that needs to be stored in an extra instVar." + testByteSizeArrayType "(see above)" + testSizeArrayType "(see above)" + )! Item was added: + ----- Method: ExternalTypeTests>>specsForTypeAliasForPointer (in category 'running') ----- + specsForTypeAliasForPointer + "Answer a list of type-alias classes to be used when testing types for type aliases." + + ^ { + FFITestAliasForInt32Pointer . ExternalType int32_t asPointerType . + FFITestAliasForVoidPointer . ExternalType void asPointerType . + FFITestAliasForSdiPointer . FFITestSdi externalType asPointerType + }! Item was added: + ----- Method: ExternalTypeTests>>testAliasForArray (in category 'tests - type aliases') ----- + testAliasForArray + + | type originalType | + type := FFITestAliasForInt32Array externalType. + originalType := ExternalType int32_t asArrayType: 5. + + self + assert: type isArrayType; + assert: type isTypeAlias; + + deny: type isAtomic; + deny: type isPointerType; + deny: type isStructureType. + + self + assert: originalType + identical: type originalType; + + assert: originalType byteSize + equals: type byteSize; + assert: originalType byteAlignment + equals: type byteAlignment. + + self + "The alias has its own referentClass." + assert: FFITestAliasForInt32Array identical: type referentClass; + assert: nil "array of atomics" identical: originalType referentClass.! Item was added: + ----- Method: ExternalTypeTests>>testAliasForArrayByName (in category 'tests - type aliases') ----- + testAliasForArrayByName + + | type | + type := FFITestAliasForInt32Array externalType. + self + assert: type + identical: (ExternalType typeNamed: type typeName); + assert: type asPointerType + identical: (ExternalType typeNamed: type asPointerType typeName).! Item was added: + ----- Method: ExternalTypeTests>>testAliasForArrayPointer (in category 'tests - type aliases') ----- + testAliasForArrayPointer + "Not supported. User void* for n-dimensional arrays." + + | type originalType | + type := FFITestAliasForInt32ArrayPointer externalType. + originalType := ExternalType void asPointerType. + + self + assert: type isTypeAlias; + assert: type isPointerType. + + self + assert: originalType + identical: type originalType.! Item was added: + ----- Method: ExternalTypeTests>>testAliasForArrayPointerByName (in category 'tests - type aliases') ----- + testAliasForArrayPointerByName + + | type | + type := FFITestAliasForInt32ArrayPointer externalType. + self + assert: type + identical: (ExternalType typeNamed: type typeName); + assert: type asPointerType + identical: (ExternalType typeNamed: type asPointerType typeName).! Item was added: + ----- Method: ExternalTypeTests>>testAliasForAtomic (in category 'tests - type aliases') ----- + testAliasForAtomic + + | type originalType | + type := FFITestAliasForInt32 externalType. + originalType := ExternalType int32_t. + + self + assert: type isAtomic; "alias means alias =)" + assert: type isTypeAlias; + + deny: type isPointerType; + deny: type isStructureType; + deny: type isArrayType. + + self + assert: originalType + identical: type originalType; + + assert: originalType byteSize + equals: type byteSize; + assert: originalType byteAlignment + equals: type byteAlignment. + + self + "The alias has its own referentClass." + assert: FFITestAliasForInt32 identical: type referentClass; + assert: nil identical: originalType referentClass.! Item was added: + ----- Method: ExternalTypeTests>>testAliasForAtomicByName (in category 'tests - type aliases') ----- + testAliasForAtomicByName + + | type | + type := FFITestAliasForInt32 externalType. + self + assert: type + identical: (ExternalType typeNamed: type typeName); + assert: type asPointerType + identical: (ExternalType typeNamed: type asPointerType typeName).! Item was added: + ----- Method: ExternalTypeTests>>testAliasForPointer (in category 'tests - type aliases') ----- + testAliasForPointer + + self specsForTypeAliasForPointer groupsDo: [:aliasClass :originalPointerType | + | pointerType type originalType | + pointerType := aliasClass externalType. + + self + assert: pointerType isTypeAlias; + assert: pointerType isPointerType; + + deny: pointerType isAtomic; + deny: pointerType isStructureType; + deny: pointerType isArrayType. + + "Note that it should be possible to access the original type." + self + assert: originalPointerType + identical: pointerType originalType. + + "Check whether specs are equal to the original type's specs." + self + assert: originalPointerType byteSize + equals: pointerType byteSize; + assert: originalPointerType byteAlignment + equals: pointerType byteAlignment. + + "Note that the non-pointer type of the alias is virtually a copy." + type := pointerType "e.g. IntPr" asNonPointerType. "e.g. int ... but w/ different referentClass and referencedType" + + self + deny: type isTypeAlias; + assert: type isTypeAliasReferenced; + deny: type isPointerType; + assert: [type isAtomic "... but for something non-pointer-ish" + or: [type isStructureType + or: [type isArrayType]]]. + + originalType := originalPointerType "e.g. int*" asNonPointerType. "e.g. int" + self deny: originalType equals: type. + self deny: originalPointerType equals: pointerType. + + "Check whether specs of non-pointer type are equal + to the original type's non-pointer type specs." + self + assert: originalType headerWord + equals: type headerWord; + assert: originalType byteSize + equals: type byteSize; + assert: originalType byteAlignment + equals: type byteAlignment. + + self + "The alias has its own referentClass." + assert: aliasClass equals: pointerType referentClass; + assert: aliasClass equals: type referentClass; + deny: aliasClass equals: originalPointerType referentClass; + deny: aliasClass equals: originalType referentClass; + + "You can go back and forth in the type alias" + assert: pointerType identical: type asPointerType; + assert: type identical: pointerType asNonPointerType].! Item was added: + ----- Method: ExternalTypeTests>>testAliasForPointerByName (in category 'tests - type aliases') ----- + testAliasForPointerByName + + self specsForTypeAliasForPointer groupsDo: [:aliasClass :originalPointerType | + | pointerType type | + pointerType := aliasClass externalType asPointerType. + type := pointerType asNonPointerType. + self + assert: pointerType + identical: (ExternalType typeNamed: pointerType typeName); + assert: type + identical: (ExternalType typeNamed: type typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testAliasForStruct (in category 'tests - type aliases') ----- + testAliasForStruct + + | type originalType | + type := FFITestAliasForSdi externalType. + originalType := FFITestSdi externalType. + + self + assert: type isStructureType; + assert: type isTypeAlias; + + deny: type isAtomic; + deny: type isPointerType; + deny: type isArrayType. + + self + assert: originalType + identical: type originalType; + + assert: originalType byteSize + equals: type byteSize; + assert: originalType byteAlignment + equals: type byteAlignment. + + self + "The alias has its own referentClass." + assert: FFITestAliasForSdi identical: type referentClass; + assert: FFITestSdi identical: originalType referentClass.! Item was added: + ----- Method: ExternalTypeTests>>testAliasForStructByName (in category 'tests - type aliases') ----- + testAliasForStructByName + + | type | + type := FFITestAliasForSdi externalType. + self + assert: type + identical: (ExternalType typeNamed: type typeName); + assert: type asPointerType + identical: (ExternalType typeNamed: type asPointerType typeName).! Item was added: + ----- Method: ExternalTypeTests>>testAllArrayTypes (in category 'tests - image') ----- + testAllArrayTypes + + ExternalType arrayTypes do: [:type | + self + deny: type isAtomic; + deny: type isPointerType; + deny: type isStructureType; + assert: type isArrayType].! Item was added: + ----- Method: ExternalTypeTests>>testAllAtomicTypes (in category 'tests - image') ----- + testAllAtomicTypes + + ExternalType atomicTypes do: [:type | + self + assert: type isAtomic; + deny: type isPointerType; + deny: type isStructureType; + deny: type isArrayType; + deny: type isTypeAlias].! Item was added: + ----- Method: ExternalTypeTests>>testAllPointerTypes (in category 'tests - image') ----- + testAllPointerTypes + + ExternalType pointerTypes do: [:type | + self + deny: type isAtomic; + assert: type isPointerType; + deny: type isStructureType; + deny: type isArrayType].! Item was added: + ----- Method: ExternalTypeTests>>testAllStructureTypes (in category 'tests - image') ----- + testAllStructureTypes + + ExternalType structTypes do: [:type | + self + deny: type isAtomic; + deny: type isPointerType; + assert: type isStructureType; + deny: type isArrayType].! Item was removed: - ----- Method: ExternalTypeTests>>testAllocateAtomics (in category 'tests') ----- - testAllocateAtomics - - self should: [ExternalType void allocate] raise: Error. - self assert: false equals: ExternalType bool allocate. - - self assert: 0 equals: ExternalType int8_t "sbyte" allocate. - self assert: 0 equals: ExternalType uint8_t "byte" allocate. - - self assert: 0 equals: ExternalType uint16_t "ushort" allocate. - self assert: 0 equals: ExternalType int16_t "short" allocate. - - self assert: 0 equals: ExternalType uint32_t "ulong" allocate. - self assert: 0 equals: ExternalType int32_t "long" allocate. - - self assert: 0 equals: ExternalType uint64_t "ulonglong" allocate. - self assert: 0 equals: ExternalType int64_t "longlong" allocate. - - self assert: Character null equals: ExternalType schar allocate. - self assert: Character null equals: ExternalType char allocate. - - self assert: 0.0 equals: ExternalType float allocate. - self assert: 0.0 equals: ExternalType double allocate.! Item was removed: - ----- Method: ExternalTypeTests>>testAllocateAtomicsExternal (in category 'tests') ----- - testAllocateAtomicsExternal - "Note that #allocateExternal for atomics does not need an extra #free. See #allocateExternal." - - self should: [ExternalType void allocateExternal] raise: Error. - self assert: false equals: ExternalType bool allocateExternal. - - self assert: 0 equals: ExternalType int8_t "sbyte" allocateExternal. - self assert: 0 equals: ExternalType uint8_t "byte" allocateExternal. - - self assert: 0 equals: ExternalType uint16_t "ushort" allocateExternal. - self assert: 0 equals: ExternalType int16_t "short" allocateExternal. - - self assert: 0 equals: ExternalType uint32_t "ulong" allocateExternal. - self assert: 0 equals: ExternalType int32_t "long" allocateExternal. - - self assert: 0 equals: ExternalType uint64_t "ulonglong" allocateExternal. - self assert: 0 equals: ExternalType int64_t "longlong" allocateExternal. - - self assert: Character null equals: ExternalType schar allocateExternal. - self assert: Character null equals: ExternalType char allocateExternal. - - self assert: 0.0 equals: ExternalType float allocateExternal. - self assert: 0.0 equals: ExternalType double allocateExternal.! Item was removed: - ----- Method: ExternalTypeTests>>testAllocateStructs (in category 'tests') ----- - testAllocateStructs - - | struct | - struct := FFITestPoint2 allocate. - self assert: 0 equals: struct x. - self assert: 0 equals: struct y. - - struct := FFITestSd2 allocate. - self assert: 0.0 equals: struct d1. - self assert: 0.0 equals: struct d2. - - struct := FFITestSsSsf allocate. - self assert: 0 equals: struct s1. - self assert: 0 equals: struct ssf2 s1. - self assert: 0.0 equals: struct ssf2 f2. - - struct := FFITestUfd allocate. - self assert: 0.0 equals: struct d1. - self assert: 0.0 equals: struct f1.! Item was removed: - ----- Method: ExternalTypeTests>>testAllocateStructsExternal (in category 'tests') ----- - testAllocateStructsExternal - - | struct | - struct := heapObject := FFITestPoint2 allocateExternal. - self assert: 0 equals: struct x. - self assert: 0 equals: struct y. - - struct := heapObject := FFITestSd2 allocateExternal. - self assert: 0.0 equals: struct d1. - self assert: 0.0 equals: struct d2. - - struct := heapObject := FFITestSsSsf allocateExternal. - self assert: 0 equals: struct s1. - self assert: 0 equals: struct ssf2 s1. - self assert: 0.0 equals: struct ssf2 f2. - - struct := heapObject := FFITestUfd allocateExternal. - self assert: 0.0 equals: struct d1. - self assert: 0.0 equals: struct f1.! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAliases (in category 'tests - array types') ----- + testArrayOfAliases + + self classesForTypeAliases do: [:aliasClass | + | contentType arrayType | + contentType := aliasClass externalType. + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self + assert: contentType + identical: arrayType contentType; + assert: contentType byteAlignment + equals: arrayType byteAlignment. + + self + assert: contentType isTypeAlias; + assert: (contentType isAtomic or: [contentType isStructureType]); + deny: contentType isPointerType; + deny: contentType isArrayType. + + self + deny: arrayType isAtomic; + deny: arrayType isStructureType; + deny: arrayType isPointerType; + deny: arrayType isTypeAlias. + + self + "referentClass shared" + assert: contentType referentClass + identical: arrayType referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAliasesByName (in category 'tests - array types') ----- + testArrayOfAliasesByName + + self classesForTypeAliases do: [:aliasClass | + | contentType arrayType | + contentType := aliasClass externalType. + arrayType := contentType asArrayType: 5. + self + assert: arrayType + identical: (ExternalType typeNamed: arrayType typeName); + assert: arrayType asPointerType + identical: (ExternalType typeNamed: arrayType asPointerType typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAliasesForArrays (in category 'tests - array types') ----- + testArrayOfAliasesForArrays + "This is the only way to construct n-dimensional arrays for now." + + | contentType arrayType | + contentType := FFITestAliasForInt32Array externalType. + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self + assert: contentType + identical: arrayType contentType; + assert: contentType byteAlignment + equals: arrayType byteAlignment. + + self + assert: contentType isTypeAlias; + assert: contentType isArrayType; + deny: contentType isAtomic; + deny: contentType isStructureType; + deny: contentType isPointerType. + + self + deny: arrayType isAtomic; + deny: arrayType isStructureType; + deny: arrayType isPointerType; + deny: arrayType isTypeAlias. + + self + "referentClass shared" + assert: contentType referentClass + identical: arrayType referentClass.! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAliasesForPointers (in category 'tests - array types') ----- + testArrayOfAliasesForPointers + + self specsForTypeAliasForPointer groupsDo: [:aliasClass :originalType | + | contentType arrayType | + contentType := aliasClass externalType. + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self + assert: contentType + identical: arrayType contentType; + assert: contentType byteAlignment + equals: arrayType byteAlignment. + + self + assert: contentType isTypeAlias; + assert: contentType isPointerType; + deny: contentType isAtomic; + deny: contentType isStructureType; + deny: contentType isArrayType. + + self + deny: arrayType isAtomic; + deny: arrayType isStructureType; + deny: arrayType isPointerType; + deny: arrayType isTypeAlias. + + self + "referentClass shared" + assert: contentType referentClass + identical: arrayType referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAliasesForPointersByName (in category 'tests - array types') ----- + testArrayOfAliasesForPointersByName + + self specsForTypeAliasForPointer groupsDo: [:aliasClass :originalType | + | contentType arrayType | + contentType := aliasClass externalType. + arrayType := contentType asArrayType: 5. + self + assert: arrayType asNonPointerType + identical: (ExternalType typeNamed: arrayType asNonPointerType typeName); + assert: arrayType asPointerType + identical: (ExternalType typeNamed: arrayType asPointerType typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAliasesForPointersDereferenced (in category 'tests - array types') ----- + testArrayOfAliasesForPointersDereferenced + "It should be possible to use the non-pointer type of an alias-to-pointer type as contentType in an array/container." + + self specsForTypeAliasForPointer groupsDo: [:aliasClass :originalType | + | contentType arrayType | + contentType := aliasClass externalType asNonPointerType. + contentType byteSize = 0 ifTrue: [^ self "Ignore void"]. + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self + assert: contentType + identical: arrayType contentType; + assert: contentType byteAlignment + equals: arrayType byteAlignment. + + self + deny: contentType isTypeAlias; + deny: contentType isPointerType; + assert: [contentType isAtomic + or: [contentType isStructureType + or: [contentType isArrayType]]]. + + self + deny: arrayType isAtomic; + deny: arrayType isStructureType; + deny: arrayType isPointerType; + deny: arrayType isTypeAlias. + + self + "referentClass shared" + assert: contentType referentClass + identical: arrayType referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfArrays (in category 'tests - array types') ----- + testArrayOfArrays + "Not directly supported." + + self + assert: (ExternalType typeNamed: 'char[5]') + identical: (ExternalType typeNamed: 'char[5][5]'). + + self + should: [(ExternalType char asArrayType: 5) asArrayType: 5] + raise: Error. + + self + assert: (ExternalType typeNamed: 'FFITestPoint2[5]') + identical: (ExternalType typeNamed: 'FFITestPoint2[5][5]'). + + self + should: [(FFITestPoint2 externalType asArrayType: 5) asArrayType: 5] + raise: Error. + ! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAtomics (in category 'tests - array types') ----- + testArrayOfAtomics + + ExternalType atomicTypes allButFirst "void" do: [:contentType | + | arrayType | + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self deny: arrayType isAtomic. + self deny: arrayType isStructureType. + self deny: arrayType isPointerType. + self deny: arrayType isTypeAlias. + + self assert: arrayType referentClass isNil].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAtomicsByName (in category 'tests - array types') ----- + testArrayOfAtomicsByName + + ExternalType atomicTypes allButFirst "void" do: [:contentType | + | arrayType | + arrayType := contentType asArrayType: 5. + self + assert: arrayType + identical: (ExternalType typeNamed: arrayType typeName); + assert: arrayType asPointerType + identical: (ExternalType typeNamed: arrayType asPointerType typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfAtomicsWithSpecialSize (in category 'tests - array types') ----- + testArrayOfAtomicsWithSpecialSize + "Test char[] and char[0]." + + | contentType containerType | + contentType := ExternalType char. + + containerType := contentType asArrayType: 0. + self assert: containerType identical: (ExternalType typeNamed: 'char[0]'). + self assert: 0 equals: containerType byteSize. + self assert: 0 equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: contentType byteAlignment equals: containerType byteAlignment. + + containerType := contentType asArrayType: nil. + self assert: containerType identical: (ExternalType typeNamed: 'char[]'). + self assert: nil equals: containerType byteSize. + self assert: nil equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: 0 equals: containerType byteAlignment.! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfPointersToAtomics (in category 'tests - array types') ----- + testArrayOfPointersToAtomics + + ExternalType atomicTypes "including void" do: [:atomicType | + | arrayType contentType | + contentType := atomicType asPointerType. + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self deny: arrayType isAtomic. + self deny: arrayType isStructureType. + self deny: arrayType isPointerType. + self deny: arrayType isTypeAlias. + + self assert: arrayType referentClass isNil].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfPointersToAtomicsByName (in category 'tests - array types') ----- + testArrayOfPointersToAtomicsByName + + ExternalType atomicTypes "including void" do: [:atomicType | + | arrayType contentType | + contentType := atomicType asPointerType. + arrayType := contentType asArrayType: 5. + self + assert: arrayType + identical: (ExternalType typeNamed: arrayType typeName); + assert: arrayType asPointerType + identical: (ExternalType typeNamed: arrayType asPointerType typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfPointersToAtomicsWithSpecialSize (in category 'tests - array types') ----- + testArrayOfPointersToAtomicsWithSpecialSize + "Test char*[] and char*[0]." + + | contentType containerType | + contentType := ExternalType char asPointerType. "char*" + + containerType := contentType asArrayType: 0. + self assert: containerType identical: (ExternalType typeNamed: 'char*[0]'). + self assert: 0 equals: containerType byteSize. + self assert: 0 equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: contentType byteAlignment equals: containerType byteAlignment. + + containerType := contentType asArrayType: nil. + self assert: containerType identical: (ExternalType typeNamed: 'char*[]'). + self assert: nil equals: containerType byteSize. + self assert: nil equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: 0 equals: containerType byteAlignment. + + ! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfPointersToStructs (in category 'tests - array types') ----- + testArrayOfPointersToStructs + + self classesForStructures do: [:structClass | + | arrayType contentType | + contentType := structClass externalType asPointerType. + arrayType := contentType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self deny: arrayType isAtomic. + self deny: arrayType isStructureType. + self deny: arrayType isPointerType. + self deny: arrayType isTypeAlias. + + self + assert: structClass + identical: arrayType referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfPointersToStructsByName (in category 'tests - array types') ----- + testArrayOfPointersToStructsByName + + self classesForStructures do: [:structClass | + | arrayType contentType | + contentType := structClass externalType asPointerType. + arrayType := contentType asArrayType: 5. + self + assert: arrayType + identical: (ExternalType typeNamed: arrayType typeName); + assert: arrayType asPointerType + identical: (ExternalType typeNamed: arrayType asPointerType typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfPointersToStructsWithSpecialSize (in category 'tests - array types') ----- + testArrayOfPointersToStructsWithSpecialSize + + | contentType containerType | + contentType := FFITestPoint2 externalType asPointerType. "FFITestPoint2*" + + containerType := contentType asArrayType: 0. + self assert: containerType identical: (ExternalType typeNamed: 'FFITestPoint2*[0]'). + self assert: 0 equals: containerType byteSize. + self assert: 0 equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: contentType byteAlignment equals: containerType byteAlignment. + + containerType := contentType asArrayType: nil. + self assert: containerType identical: (ExternalType typeNamed: 'FFITestPoint2*[]'). + self assert: nil equals: containerType byteSize. + self assert: nil equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: 0 equals: containerType byteAlignment. + ! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfStructs (in category 'tests - array types') ----- + testArrayOfStructs + + self classesForStructures do: [:structClass | + | arrayType contentType | + contentType := structClass externalType. + arrayType := structClass externalType asArrayType: 5. + + self assert: arrayType isArrayType. + self assert: contentType identical: arrayType contentType. + self assert: 5 equals: arrayType size. + self assert: 5 * contentType byteSize equals: arrayType byteSize. + + self deny: arrayType isAtomic. + self deny: arrayType isStructureType. + self deny: arrayType isPointerType. + self deny: arrayType isTypeAlias. + + self + assert: structClass + identical: arrayType referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfStructsByName (in category 'tests - array types') ----- + testArrayOfStructsByName + + self classesForStructures do: [:structClass | + | arrayType contentType | + contentType := structClass externalType. + arrayType := structClass externalType asArrayType: 5. + self + assert: arrayType + identical: (ExternalType typeNamed: arrayType typeName); + assert: arrayType asPointerType + identical: (ExternalType typeNamed: arrayType asPointerType typeName)].! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfStructsWithSpecialSize (in category 'tests - array types') ----- + testArrayOfStructsWithSpecialSize + + | contentType containerType | + contentType := FFITestPoint2 externalType. + + containerType := contentType asArrayType: 0. + self assert: containerType identical: (ExternalType typeNamed: 'FFITestPoint2[0]'). + self assert: 0 equals: containerType byteSize. + self assert: 0 equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: contentType byteAlignment equals: containerType byteAlignment. + + containerType := contentType asArrayType: nil. + self assert: containerType identical: (ExternalType typeNamed: 'FFITestPoint2[]'). + self assert: nil equals: containerType byteSize. + self assert: nil equals: containerType size. + self assert: contentType identical: containerType contentType. + self assert: 0 equals: containerType byteAlignment.! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfUnknown (in category 'tests - unkown types') ----- + testArrayOfUnknown + "For missing referentClass, one can safely try to lookup an array type but forcing its creation will raise an error. Note that it is not possible to embed an array type for a struct in itself. You MUST use pointer types for that." + + self + assert: nil + equals: (ExternalType typeNamed: 'UnknownStruct[5]'). + + self + should: [ExternalType newTypeNamed: 'UnknownStruct[5]'] + raise: Error.! Item was added: + ----- Method: ExternalTypeTests>>testArrayOfVoid (in category 'tests - array types') ----- + testArrayOfVoid + + self + should: [ExternalType void asArrayType: 5] + raise: Error.! Item was removed: - ----- Method: ExternalTypeTests>>testArrayTypesEmpty (in category 'tests') ----- - testArrayTypesEmpty - - self - should: [ExternalType char asArrayType: 0] - raise: Error; - should: [ExternalType typeNamed: 'char[]'] - raise: Error; - should: [ExternalType typeNamed: 'char[0]'] - raise: Error.! Item was removed: - ----- Method: ExternalTypeTests>>testArrayTypesForAtomics (in category 'tests') ----- - testArrayTypesForAtomics - - self - should: [ExternalType void asArrayType: 5] - raise: Error. - - AtomicTypeNames keysInOrder allButFirst "void" do: [:index | - | atomicType arrayType | - atomicType := AtomicTypes at: (AtomicTypeNames at: index). - arrayType := atomicType asArrayType: 5. - self assert: arrayType isArrayType. - self assert: arrayType isAtomic. - self deny: arrayType isStructureType. - self deny: arrayType isPointerType. - self assert: 5 equals: arrayType size].! Item was removed: - ----- Method: ExternalTypeTests>>testArrayTypesForStructs (in category 'tests') ----- - testArrayTypesForStructs - - self assert: (ExternalType typeNamed: 'UnknownStruct[5]') isNil. - self - should: [ExternalType newTypeNamed: 'UnknownStruct[5]'] - raise: Error. - { - FFITestPoint2. - FFITestSdi. - FFITestUfd. - FFITestIntAlias. - FFITestCompoundStruct. - } do: [:structClass | - | arrayType | - arrayType := structClass externalType asArrayType: 5. - self assert: arrayType isArrayType. - self deny: arrayType isPointerType. - self assert: 5 equals: arrayType size].! Item was added: + ----- Method: ExternalTypeTests>>testArrayVsPointer (in category 'tests - array types') ----- + testArrayVsPointer + + | arrayType pointerType | + arrayType := ExternalType typeNamed: 'char[]'. + pointerType := ExternalType typeNamed: 'char*'. + self + assert: arrayType isArrayType; + deny: arrayType isPointerType; + assert: pointerType isPointerType; + deny: pointerType isArrayType. + + self deny: arrayType typeName = pointerType typeName. + self deny: arrayType asPointerType typeName = pointerType typeName.! Item was changed: + ----- Method: ExternalTypeTests>>testAtomicType (in category 'tests - atomic types') ----- - ----- Method: ExternalTypeTests>>testAtomicType (in category 'tests') ----- testAtomicType + "Check the basic integrity of atomic types." + ExternalType atomicTypes do: [:type | - AtomicTypes keysAndValuesDo: [:typeName :type | self assert: type isAtomic; + assert: type typeName equals: type atomicTypeName; - assert: typeName equals: type atomicTypeName; deny: type isPointerType; + deny: type isStructureType; + deny: type isArrayType; + deny: type isTypeAlias; + + assert: type referentClass isNil].! - deny: type isStructureType].! Item was changed: + ----- Method: ExternalTypeTests>>testAtomicTypeByName (in category 'tests - atomic types') ----- - ----- Method: ExternalTypeTests>>testAtomicTypeByName (in category 'tests') ----- testAtomicTypeByName + "Check whether the lookup of atomic types will yield the singleton instances of those types." + ExternalType atomicTypeNames do: [:typeName | - AtomicTypeNames do: [:typeName | self + assert: (ExternalType typeNamed: typeName) + identical: (ExternalType typeNamed: typeName)].! - assert: (AtomicTypes at: typeName) - identical: (ExternalType typeNamed: typeName); - assert: (AtomicTypes at: typeName) - identical: (ExternalType atomicTypeNamed: typeName)].! Item was changed: + ----- Method: ExternalTypeTests>>testAtomicTypeBySelector (in category 'tests - atomic types') ----- - ----- Method: ExternalTypeTests>>testAtomicTypeBySelector (in category 'tests') ----- testAtomicTypeBySelector + "Check whether all atomic type names are available as message on the class ExternalType such as 'ExternalType char'." + + ExternalType atomicTypeNames do: [:typeName | + self assert: (ExternalType perform: typeName asSymbol) isAtomic].! - - AtomicTypeNames do: [:typeName | - self - assert: (AtomicTypes at: typeName) - identical: (ExternalType perform: typeName asSymbol)].! Item was changed: + ----- Method: ExternalTypeTests>>testAtomicTypeNameByType (in category 'tests - atomic types') ----- - ----- Method: ExternalTypeTests>>testAtomicTypeNameByType (in category 'tests') ----- testAtomicTypeNameByType + "Check whether #typeName answers a name that can be used for looking up atomic types." + + ExternalType atomicTypes do: [:type | - - AtomicTypeNames do: [:symbol | | typeName | - typeName := symbol. self + assert: type + identical: (ExternalType typeNamed: type typeName). - assert: typeName - equals: (ExternalType typeNamed: typeName) typeName; - assert: typeName - equals: (AtomicTypes at: typeName) typeName. - typeName := (AtomicTypes at: symbol) asPointerType typeName. self + assert: type asPointerType + identical: (ExternalType typeNamed: type asPointerType typeName)].! - assert: typeName - equals: (ExternalType typeNamed: typeName) typeName].! Item was changed: + ----- Method: ExternalTypeTests>>testAtomicTypeRange (in category 'tests - atomic types') ----- - ----- Method: ExternalTypeTests>>testAtomicTypeRange (in category 'tests') ----- testAtomicTypeRange + "Tests the range of non-integer and non-float types. Includes char types because those look different in Smalltalk." + - self should: [ExternalType void minVal] raise: Error. self should: [ExternalType void maxVal] raise: Error. self should: [ExternalType bool minVal] raise: Error. + self should: [ExternalType bool maxVal] raise: Error. - self should: [ExternalType bool maxVal] raise: Error. - - self assert: 0 equals: ExternalType uint8_t "byte" minVal. - self assert: 255 equals: ExternalType uint8_t "byte" maxVal. - self assert: -128 equals: ExternalType int8_t "sbyte" minVal. - self assert: 127 equals: ExternalType int8_t "sbyte" maxVal. - self assert: 0 equals: ExternalType uint16_t "ushort" minVal. - self assert: 65535 equals: ExternalType uint16_t "ushort" maxVal. - self assert: -32768 equals: ExternalType int16_t "short" minVal. - self assert: 32767 equals: ExternalType int16_t "short" maxVal. - - self assert: 0 equals: ExternalType uint32_t "ulong" minVal. - self assert: 4294967295 equals: ExternalType uint32_t "ulong" maxVal. - self assert: -2147483648 equals: ExternalType int32_t "long" minVal. - self assert: 2147483647 equals: ExternalType int32_t "long" maxVal. - - self assert: 0 equals: ExternalType uint64_t "ulonglong" minVal. - self assert: 18446744073709551615 equals: ExternalType uint64_t "ulonglong" maxVal. - self assert: -9223372036854775808 equals: ExternalType int64_t "longlong" minVal. - self assert: 9223372036854775807 equals: ExternalType int64_t "longlong" maxVal. - self assert: Character null equals: ExternalType char "unsignedChar" minVal. self assert: (Character value: 255) equals: ExternalType char "unsignedChar" maxVal. self assert: (Character value: 128) equals: ExternalType signedChar "schar" minVal. self assert: (Character value: 127) equals: ExternalType signedChar "schar" maxVal. + ! - - self assert: -3.4028234663852886e38 equals: ExternalType float minVal. - self assert: 3.4028234663852886e38 equals: ExternalType float maxVal. - self assert: -1.7976931348623157e308 equals: ExternalType double minVal. - self assert: 1.7976931348623157e308 equals: ExternalType double maxVal. ! Item was added: + ----- Method: ExternalTypeTests>>testByteSizeArrayType (in category 'tests - compiled spec') ----- + testByteSizeArrayType + + | type baseType | + type := ExternalType typeNamed: 'char[5]'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalArrayType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type byteSize equals: baseType byteSize.! Item was added: + ----- Method: ExternalTypeTests>>testByteSizeAtomicType (in category 'tests - compiled spec') ----- + testByteSizeAtomicType + + | type baseType | + type := ExternalType typeNamed: 'int32_t'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalAtomicType identical: type class. + + self assert: type byteSize equals: baseType byteSize.! Item was added: + ----- Method: ExternalTypeTests>>testByteSizePointerType (in category 'tests - compiled spec') ----- + testByteSizePointerType + + | type baseType | + type := ExternalType typeNamed: 'int32_t*'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalPointerType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type byteSize equals: baseType byteSize.! Item was added: + ----- Method: ExternalTypeTests>>testByteSizeStructureType (in category 'tests - compiled spec') ----- + testByteSizeStructureType + + | type baseType | + type := ExternalType typeNamed: 'FFITestSdi'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalStructureType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type byteSize equals: baseType byteSize.! Item was added: + ----- Method: ExternalTypeTests>>testFloatPrecision (in category 'tests - atomic float types') ----- + testFloatPrecision + + self + assert: ExternalType float isSinglePrecision; + assert: ExternalType double + equals: ExternalType float asDoublePrecision; + assert: ExternalType double isDoublePrecision; + assert: ExternalType float + equals: ExternalType float asSinglePrecision.! Item was added: + ----- Method: ExternalTypeTests>>testFloatSign (in category 'tests - atomic float types') ----- + testFloatSign + "Float and double types are always signed. Thus, the check is not defined but only for integer types." + + self + should: [ExternalType float isSigned] raise: Error; + should: [ExternalType float isUnsigned] raise: Error; + should: [ExternalType float asSigned] raise: Error; + should: [ExternalType float asUnsigned] raise: Error; + should: [ExternalType double isSigned] raise: Error; + should: [ExternalType double isUnsigned] raise: Error; + should: [ExternalType double asSigned] raise: Error; + should: [ExternalType double asUnsigned] raise: Error.! Item was added: + ----- Method: ExternalTypeTests>>testFloatTypeRange (in category 'tests - atomic float types') ----- + testFloatTypeRange + + self assert: -3.4028234663852886e38 equals: ExternalType float minVal. + self assert: 3.4028234663852886e38 equals: ExternalType float maxVal. + self assert: -1.7976931348623157e308 equals: ExternalType double minVal. + self assert: 1.7976931348623157e308 equals: ExternalType double maxVal. ! Item was added: + ----- Method: ExternalTypeTests>>testFloatTypes (in category 'tests - atomic float types') ----- + testFloatTypes + + #( + float 4 + double 8 + ) pairsDo: [:typeName :byteSize | + | type | + type := ExternalType typeNamed: typeName. + self + assert: type isFloatType; + assert: byteSize equals: type byteSize].! Item was changed: + ----- Method: ExternalTypeTests>>testIntegerPointerTypes (in category 'tests - atomic integer types') ----- - ----- Method: ExternalTypeTests>>testIntegerPointerTypes (in category 'tests') ----- testIntegerPointerTypes | wordSize | wordSize := FFIPlatformDescription current wordSize. #(size_t ptrdiff_t uintptr_t intptr_t) do: [:typeName | | type | type := ExternalType typeNamed: typeName. self assert: type isIntegerType; assert: wordSize equals: type byteSize].! Item was added: + ----- Method: ExternalTypeTests>>testIntegerPrecision (in category 'tests - atomic integer types') ----- + testIntegerPrecision + "Precision is not defined on integer types." + + ExternalType atomicTypes do: [:type | + type isIntegerType ifTrue: [ + self + should: [type isSinglePrecision] + raise: Error; + should: [type isDoublePrecision] + raise: Error]].! Item was added: + ----- Method: ExternalTypeTests>>testIntegerSign (in category 'tests - atomic integer types') ----- + testIntegerSign + + ExternalType atomicTypes do: [:type | + self + assert: type isIntegerType ==> [ + (type isSigned and: [type asUnsigned isUnsigned]) + or: [type isUnsigned and: [type asSigned isSigned]]]].! Item was added: + ----- Method: ExternalTypeTests>>testIntegerTypeRange (in category 'tests - atomic integer types') ----- + testIntegerTypeRange + + self assert: 0 equals: ExternalType uint8_t "byte" minVal. + self assert: 255 equals: ExternalType uint8_t "byte" maxVal. + self assert: -128 equals: ExternalType int8_t "sbyte" minVal. + self assert: 127 equals: ExternalType int8_t "sbyte" maxVal. + + self assert: 0 equals: ExternalType uint16_t "ushort" minVal. + self assert: 65535 equals: ExternalType uint16_t "ushort" maxVal. + self assert: -32768 equals: ExternalType int16_t "short" minVal. + self assert: 32767 equals: ExternalType int16_t "short" maxVal. + + self assert: 0 equals: ExternalType uint32_t "ulong" minVal. + self assert: 4294967295 equals: ExternalType uint32_t "ulong" maxVal. + self assert: -2147483648 equals: ExternalType int32_t "long" minVal. + self assert: 2147483647 equals: ExternalType int32_t "long" maxVal. + + self assert: 0 equals: ExternalType uint64_t "ulonglong" minVal. + self assert: 18446744073709551615 equals: ExternalType uint64_t "ulonglong" maxVal. + self assert: -9223372036854775808 equals: ExternalType int64_t "longlong" minVal. + self assert: 9223372036854775807 equals: ExternalType int64_t "longlong" maxVal. + ! Item was changed: + ----- Method: ExternalTypeTests>>testIntegerTypes (in category 'tests - atomic integer types') ----- - ----- Method: ExternalTypeTests>>testIntegerTypes (in category 'tests') ----- testIntegerTypes #( uint8_t 1 int8_t 1 uint16_t 2 int16_t 2 uint32_t 4 int32_t 4 uint64_t 8 int64_t 8 ) pairsDo: [:typeName :byteSize | | type | type := ExternalType typeNamed: typeName. self assert: type isIntegerType; assert: byteSize equals: type byteSize].! Item was added: + ----- Method: ExternalTypeTests>>testIsArrayType (in category 'tests - compiled spec') ----- + testIsArrayType + "#isArrayType should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." + + | type baseType | + type := ExternalType typeNamed: 'char[5]'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalArrayType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type isArrayType. + self assert: baseType isArrayType.! Item was added: + ----- Method: ExternalTypeTests>>testIsAtomicType (in category 'tests - compiled spec') ----- + testIsAtomicType + "#isAtomic should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." + + | type baseType | + type := ExternalType typeNamed: 'int32_t'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalAtomicType identical: type class. + + self assert: type isAtomic. + self assert: baseType isAtomic.! Item was added: + ----- Method: ExternalTypeTests>>testIsPointerType (in category 'tests - compiled spec') ----- + testIsPointerType + "#isPointerType should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." + + | type baseType | + type := ExternalType typeNamed: 'int32_t*'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalPointerType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type isPointerType. + self assert: baseType isPointerType.! Item was added: + ----- Method: ExternalTypeTests>>testIsStructureType (in category 'tests - compiled spec') ----- + testIsStructureType + "#isStructureType should be independent from the subclass but also encoded in the #compiledSpec's #headerWord." + + | type baseType | + type := ExternalType typeNamed: 'FFITestSdi'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalStructureType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type isStructureType. + self assert: baseType isStructureType.! Item was added: + ----- Method: ExternalTypeTests>>testPointerToAlias (in category 'tests - pointer types') ----- + testPointerToAlias + "Test pointer types for type aliases for atomic types or struct types. Do not test pointer types to type aliases for array types." + + self classesForTypeAliases do: [:aliasClass | | type pointerType | + type := aliasClass externalType. + pointerType := type asPointerType. + + self + assert: type isTypeAlias; + assert: (type isAtomic or: [type isStructureType]); + deny: type isPointerType; + deny: type isArrayType. + + self + assert: pointerType isPointerType; + deny: pointerType isAtomic; + deny: pointerType isStructureType; + deny: pointerType isArrayType; + deny: pointerType isTypeAlias. + + self + "referentClass is retained to instantiate the correct classes for return values (i.e. ExternalStructure or ExternalData)" + assert: type referentClass + identical: pointerType referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testPointerToAliasForArray (in category 'tests - pointer types') ----- + testPointerToAliasForArray + + | type pointerType | + type := FFITestAliasForInt32Array externalType. + pointerType := type asPointerType. + + self + assert: type isArrayType; + assert: type isTypeAlias. + + self + assert: pointerType isPointerType; + assert: pointerType isPointerTypeForArray; + deny: pointerType isAtomic; + deny: pointerType isStructureType; + deny: pointerType isArrayType; + deny: pointerType isTypeAlias. + + self + "referentClass is nil to ensure ExternalData for return values from FFI calls" + assert: pointerType referentClass isNil.! Item was added: + ----- Method: ExternalTypeTests>>testPointerToAliasForPointer (in category 'tests - pointer types') ----- + testPointerToAliasForPointer + "Alias-for-pointer types are actual pointer types. Their non-pointer type points to the original non-pointer type. See #testAliasForPointer." + + self specsForTypeAliasForPointer groupsDo: [:aliasClass :originalType | | type | + type := aliasClass externalType. + + self + assert: type + identical: type asPointerType].! Item was added: + ----- Method: ExternalTypeTests>>testPointerToArray (in category 'tests - pointer types') ----- + testPointerToArray + "The pointer type of an array type should look like a pointer to its content type except that we omit the referentClass so that we will always get ExternalData from an FFI call. From there, #contentType is very easy to access. Note that MyStruct* and MyStruct[] are different. See #testArrayVsPointer." + + | arrayTypes | + arrayTypes := #( + char 'char*' int32_t 'int32_t*' double 'double*' + FFITestSdi 'FFITestSdi*' FFITestUfd 'FFITestUfd*') + collect: [:typeName | (ExternalType typeNamed: typeName) asArrayType: 5]. + + arrayTypes do: [:arrayType | | pointerType | + pointerType := arrayType asPointerType. + + self + deny: pointerType isAtomic; + assert: pointerType isPointerType; + deny: pointerType isStructureType; + deny: pointerType isArrayType; + deny: pointerType isTypeAlias; + + "Important!! We really want to get ExternalData for such return types. We MUST NOT instantiate the content type because we would loose the array type and thus the size information." + assert: pointerType referentClass isNil].! Item was added: + ----- Method: ExternalTypeTests>>testPointerToAtomic (in category 'tests - pointer types') ----- + testPointerToAtomic + + ExternalType atomicTypes do: [:type | | pointerType | + pointerType := type asPointerType. + + self + deny: pointerType isAtomic; + assert: pointerType isPointerType; + deny: pointerType isStructureType; + deny: pointerType isArrayType; + deny: pointerType isTypeAlias; + + assert: pointerType referentClass isNil].! Item was added: + ----- Method: ExternalTypeTests>>testPointerToPointer (in category 'tests - pointer types') ----- + testPointerToPointer + "A double pointer could either mean array-of-pointers or address of a pointer to be initialized such as in a domain-specific allocate(void**). Since we do not support by-address invocation in FFI calls yet and we do have array types, such a type is not supported. See ExternalFunction >> #flags." + + self + assert: nil + equals: (ExternalType typeNamed: 'char**'). "Use 'char*[]' if possible." + + self + should: [ExternalType newTypeNamed: 'char**'] + raise: Error.! Item was added: + ----- Method: ExternalTypeTests>>testPointerToPointerVsArrayOfPointers (in category 'tests - pointer types') ----- + testPointerToPointerVsArrayOfPointers + "For visual clarity, the pointer type of an array-of-pointers type will look different from the pointer type of an array-of-atomics/structs. Also see #testPointerToPointer." + + | arrayType | + arrayType := ExternalType typeNamed: 'char[]'. + + self + assert: '(char[])*' + equals: arrayType asPointerType typeName. + + arrayType := ExternalType typeNamed: 'char*[]'. + + self + assert: '(char*[])*' + equals: arrayType asPointerType typeName.! Item was added: + ----- Method: ExternalTypeTests>>testPointerToStruct (in category 'tests - pointer types') ----- + testPointerToStruct + + self classesForStructures do: [:structClass | | type pointerType | + type := structClass externalType. + pointerType := type asPointerType. + + self + deny: pointerType isAtomic; + assert: pointerType isPointerType; + deny: pointerType isStructureType; + deny: pointerType isArrayType; + deny: pointerType isTypeAlias; + + assert: structClass + identical: pointerType referentClass].! Item was removed: - ----- Method: ExternalTypeTests>>testPrecisionFloatTypes (in category 'tests') ----- - testPrecisionFloatTypes - - self - assert: ExternalType float isSinglePrecision; - assert: ExternalType double - equals: ExternalType float asDoublePrecision; - assert: ExternalType double isDoublePrecision; - assert: ExternalType float - equals: ExternalType float asSinglePrecision.! Item was removed: - ----- Method: ExternalTypeTests>>testPrecisionIntegerTypes (in category 'tests') ----- - testPrecisionIntegerTypes - - AtomicTypeNames do: [:typeName | - | type | - type := ExternalType atomicTypeNamed: typeName. - type isIntegerType ifTrue: [ - self - should: [type isSinglePrecision] - raise: Error; - should: [type isDoublePrecision] - raise: Error]].! Item was removed: - ----- Method: ExternalTypeTests>>testSignFloatTypes (in category 'tests') ----- - testSignFloatTypes - - self - should: [ExternalType float isSigned] raise: Error; - should: [ExternalType float isUnsigned] raise: Error; - should: [ExternalType float asSigned] raise: Error; - should: [ExternalType float asUnsigned] raise: Error; - should: [ExternalType double isSigned] raise: Error; - should: [ExternalType double isUnsigned] raise: Error; - should: [ExternalType double asSigned] raise: Error; - should: [ExternalType double asUnsigned] raise: Error.! Item was removed: - ----- Method: ExternalTypeTests>>testSignIntegerTypes (in category 'tests') ----- - testSignIntegerTypes - - AtomicTypeNames do: [:typeName | - | type | - type := ExternalType atomicTypeNamed: typeName. - self - assert: type isIntegerType ==> [ - (type isSigned and: [type asUnsigned isUnsigned]) - or: [type isUnsigned and: [type asSigned isSigned]]]].! Item was added: + ----- Method: ExternalTypeTests>>testSizeArrayType (in category 'tests - compiled spec') ----- + testSizeArrayType + + | type baseType | + type := ExternalType typeNamed: 'char[5]'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalArrayType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type size equals: baseType size.! Item was added: + ----- Method: ExternalTypeTests>>testSizeAtomicType (in category 'tests - compiled spec') ----- + testSizeAtomicType + + | type baseType | + type := ExternalType typeNamed: 'int32_t'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalAtomicType identical: type class. + + self assert: type size equals: baseType size.! Item was added: + ----- Method: ExternalTypeTests>>testSizePointerType (in category 'tests - compiled spec') ----- + testSizePointerType + + | type baseType | + type := ExternalType typeNamed: 'int32_t*'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalPointerType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type size equals: baseType size.! Item was added: + ----- Method: ExternalTypeTests>>testSizeStructureType (in category 'tests - compiled spec') ----- + testSizeStructureType + + | type baseType | + type := ExternalType typeNamed: 'FFITestSdi'. + baseType := type copy changeClassTo: ExternalType. + + self assert: ExternalStructureType identical: type class. + self assert: ExternalType identical: baseType class. + + self assert: type size equals: baseType size.! Item was added: + ----- Method: ExternalTypeTests>>testStructType (in category 'tests - struct types') ----- + testStructType + "Check the basic integrity of struct types." + + self classesForStructures do: [:structClass | | type | + type := structClass externalType. + self + deny: type isAtomic; + deny: type isPointerType; + assert: type isStructureType; + deny: type isArrayType; + deny: type isTypeAlias; + + assert: structClass + identical: type referentClass].! Item was added: + ----- Method: ExternalTypeTests>>testStructTypeByName (in category 'tests - struct types') ----- + testStructTypeByName + + self classesForStructures do: [:structClass | | type pointerType | + type := structClass externalType asNonPointerType. + pointerType := type asPointerType. + self + assert: type + identical: (ExternalType typeNamed: type typeName); + assert: pointerType + identical: (ExternalType typeNamed: pointerType typeName)]! Item was added: + ----- Method: ExternalTypeTests>>testUnknownReferentClass (in category 'tests - unkown types') ----- + testUnknownReferentClass + + | type | + Smalltalk garbageCollect. + ExternalType cleanupUnusedTypes. + type := ExternalType typeNamed: 'UnknownStructForTest'. + self assert: type isNil. + type := ExternalType newTypeNamed: 'UnknownStructForTest'. + self assert: type isUnknownType. + self + should: [ExternalType newTypeNamed: 'UnknownStructForTest'] + raise: Error. "Already existing" + ! Item was added: + FFIAllocateTests subclass: #FFIAllocateExternalTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests'! Item was added: + ----- Method: FFIAllocateExternalTests class>>shouldInheritSelectors (in category 'testing') ----- + shouldInheritSelectors + + ^ true! Item was added: + ----- Method: FFIAllocateExternalTests>>allocate: (in category 'running') ----- + allocate: spec + + | result | + result := externalObjects add: (self lookupType: spec) allocateExternal. + self checkAllocate: result. + ^ result! Item was added: + ----- Method: FFIAllocateExternalTests>>allocate:size: (in category 'running') ----- + allocate: spec size: size + + | result | + result := externalObjects add: ((self lookupType: spec) allocateExternal: size). + self checkAllocate: result. + ^ result! Item was added: + ----- 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 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 deny: handle isInternalMemory.! Item was added: + ----- 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 added: + ----- Method: FFIAllocateExternalTests>>checkType: (in category 'running') ----- + checkType: externalObject + + self assert: externalObject externalType isPointerType.! Item was added: + ----- Method: FFIAllocateExternalTests>>expectedFailures (in category 'failures') ----- + expectedFailures + + ^ super expectedFailures copyWithoutAll: #( + test04LinkedList "Storing pointers works fine." + )! Item was added: + ----- Method: FFIAllocateExternalTests>>test00ReaderWriter (in category 'tests') ----- + test00ReaderWriter + "Overwritten to show that #reader and #writer is virtually a #yourself on external objects that point to external memory." + + | si2 | + si2 := self allocate: FFITestSi2. + + self assert: si2 == si2 reader. + self assert: si2 == si2 writer. + self assert: si2 reader == si2. + self assert: si2 writer == si2.! Item was added: + ----- Method: FFIAllocateExternalTests>>test01ArrayFromTo (in category 'tests - array') ----- + test01ArrayFromTo + "Overwritten because missing #writer as no effect. See #test00ReaderWriter." + + | points portion | + points := FFITestPoint2 allocateExternal: 5. + + portion := points from: 2 to: 3. + + portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self + assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]).! Item was added: + ----- Method: FFIAllocateExternalTests>>test02ArrayCopyFromTo (in category 'tests - array') ----- + test02ArrayCopyFromTo + "Overwritten to emphasize that the copy is in internal memory. Implementation is the same, see #allocate:size:." + + super test02ArrayCopyFromTo.! Item was added: + ----- Method: FFIAllocateExternalTests>>test02StructureCompositeAccess (in category 'tests - structure') ----- + test02StructureCompositeAccess + "Overwritten because #writer is not necessary for external memory." + + | composite | + composite := self allocate: FFITestSsSsf. + + self assert: 0 equals: composite s1. + self assert: 0 equals: composite ssf2 s1. + self assert: 0.0 equals: composite ssf2 f2. + + composite s1: 1. + self assert: 1 equals: composite s1. + + composite ssf2 s1: 2. + self assert: 2 equals: composite ssf2 s1. + + composite ssf2 f2: 3.0. + self assert: 3.0 equals: composite ssf2 f2.! Item was added: + ----- Method: FFIAllocateExternalTests>>test04UnionCompositeAccess (in category 'tests - union') ----- + test04UnionCompositeAccess + "Overwritten because #writer is not necessary." + + | composite | + composite := self allocate: FFITestUdSi2. + + self assert: 0.0 equals: composite d1. + self assert: 0 equals: composite sii1 i1. + self assert: 0 equals: composite sii1 i2. + + composite d1: 1.0. + self assert: 1.0 equals: composite d1. + composite d1: 0.0. "Clear to clear shared sub-structure." + + composite sii1 i1: 2. + self assert: 2 equals: composite sii1 i1. + + composite sii1 i2: 3. + self assert: 3 equals: composite sii1 i2.! Item was added: + ----- Method: FFIAllocateExternalTests>>test05UnionCompositeAccessTwo (in category 'tests - union') ----- + test05UnionCompositeAccessTwo + "Overwritten because #writer is not necessary for external memory." + + | composite | + composite := self allocate: FFITestSUfdUdSi2. + + self assert: 0.0 equals: composite ufd1 f1. + composite ufd1 f1: 3.5. + self assert: 3.5 equals: composite ufd1 f1. + + self assert: 0 equals: composite udSii2 sii1 i1. + composite udSii2 sii1 i1: 42. + self assert: 42 equals: composite udSii2 sii1 i1.! Item was added: + ----- Method: FFIAllocateExternalTests>>test06ArrayOfPointers (in category 'tests - array') ----- + test06ArrayOfPointers + "Overwritten because in external memory, we can manage pointer indirections." + + | array type string| + type := self lookupType: 'char*'. + array := self allocate: type size: 5. + self assert: 5 * type byteSize equals: array byteSize. + + string := self allocate: array contentType asNonPointerType size: 7. + string setSize: nil. "Not needed due to null-termination." + + string at: 1 put: $S. + string at: 2 put: $Q. + string at: 3 put: $U. + string at: 4 put: $E. + string at: 5 put: $A. + string at: 6 put: $K. + string at: 7 put: Character null. "Not needed here because memory was zero from the beginning." + self assert: 'SQUEAK' equals: string fromCString. + + array at: 1 put: string. + self assert: 'SQUEAK' equals: array first fromCString.! Item was added: + TestCase subclass: #FFIAllocateTests + instanceVariableNames: 'externalObjects' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests'! + + !FFIAllocateTests commentStamp: 'mt 5/10/2021 10:18' prior: 0! + A collection of tests around the allocation of structs, unions, and arrays of atomics/structs/unions. Includes tests about accessing (field read/write) those after allocation.! Item was added: + ----- Method: FFIAllocateTests>>allocate: (in category 'running') ----- + allocate: spec + + | result | + result := externalObjects add: (self lookupType: spec) allocate. + self checkAllocate: result. + ^ result! Item was added: + ----- Method: FFIAllocateTests>>allocate:size: (in category 'running') ----- + allocate: spec size: size + + | result | + result := externalObjects add: ((self lookupType: spec) allocate: size). + self checkAllocate: result. + ^ result! Item was added: + ----- 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 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 assert: handle isInternalMemory.! Item was added: + ----- Method: FFIAllocateTests>>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]. + + (type isTypeAlias and: [type isPointerType]) ifTrue: [ + self assert: handle isExternalAddress. + self assert: handle isNull. + ^ self]. + + self assert: handle isNil.! Item was added: + ----- Method: FFIAllocateTests>>checkType: (in category 'running') ----- + checkType: externalObject + + self assert: externalObject externalType isPointerType not.! Item was added: + ----- Method: FFIAllocateTests>>expectedFailures (in category 'failures') ----- + expectedFailures + + ^ #( + test04LinkedList "We don't have pointers to internal memory, yet." + )! Item was added: + ----- Method: FFIAllocateTests>>lookupType: (in category 'running') ----- + lookupType: structClassOrTypeNameOrType + + ^ structClassOrTypeNameOrType isString + ifTrue: [ExternalType typeNamed: structClassOrTypeNameOrType] + ifFalse: [structClassOrTypeNameOrType isBehavior + ifTrue: [structClassOrTypeNameOrType externalType] + ifFalse: [structClassOrTypeNameOrType]]! Item was added: + ----- Method: FFIAllocateTests>>setUp (in category 'running') ----- + setUp + + super setUp. + externalObjects := OrderedCollection new.! Item was added: + ----- Method: FFIAllocateTests>>tearDown (in category 'running') ----- + tearDown + + externalObjects do: [:externalObject | + externalObject free. + self checkFree: externalObject].! Item was added: + ----- Method: FFIAllocateTests>>test00ReaderWriter (in category 'tests') ----- + test00ReaderWriter + + | si2 | + si2 := self allocate: FFITestSi2. + + self deny: si2 == si2 reader. + self deny: si2 reader == si2 reader. + + self assert: (si2 ffiEqual: si2 reader). + self assert: (si2 reader ffiEqual: si2). + + self deny: si2 == si2 writer. + self deny: si2 writer == si2 writer. + + self assert: (si2 ffiEqual: si2 writer). + self assert: (si2 writer ffiEqual: si2). + ! Item was added: + ----- Method: FFIAllocateTests>>test01AliasForAtomicAccess (in category 'tests - type alias') ----- + test01AliasForAtomicAccess + + | char | + char := self allocate: FFITestAliasForChar. + self assert: Character null equals: char value. + char value: $A. + self assert: $A equals: char value.! Item was added: + ----- Method: FFIAllocateTests>>test01AllocateAtomics (in category 'tests - atomics') ----- + test01AllocateAtomics + + self should: [(self allocate: ExternalType void)] raise: Error. + self assert: false equals: (self allocate: ExternalType bool). + + 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"). + self assert: 0 equals: (self allocate: ExternalType int16_t "short"). + + 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"). + self assert: 0 equals: (self allocate: ExternalType int64_t "longlong"). + + 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). + self assert: 0.0 equals: (self allocate: ExternalType double).! Item was added: + ----- Method: FFIAllocateTests>>test01ArrayFromTo (in category 'tests - array') ----- + test01ArrayFromTo + "Access a sub-range in the external data. Internal memory will be copied if not accessed through a read-writer." + + | points portion | + points := self allocate: FFITestPoint2 size: 5. + portion := points from: 2 to: 3. + + portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self "Forgot to use a read-writer..." + assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]). + + portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self "Forgot to use a read-writer early enough..." + assert: { 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]). + + portion := points writer from: 2 to: 3. + portion withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self + assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]). + + points zeroMemory. + portion := points reader from: 2 to: 3. + portion writer withIndexDo: [:point :index | point setX: index+1 setY: index+1]. + self "Both #reader and #writer used. No worries." + assert: { 0 at 0 . 2 at 2 . 3 at 3 . 0 at 0 . 0 at 0 } + equals: (points collect: [:each | each asPoint]).! Item was added: + ----- Method: FFIAllocateTests>>test01Identity (in category 'tests') ----- + test01Identity + + | a b c | + a := self allocate: FFITestPoint2. + b := self allocate: FFITestPoint2. + c := FFITestPoint2 fromHandle: a getHandle. + + self assert: (a ffiIdentical: a). + self deny: (a ffiIdentical: b). + self assert: (a ffiIdentical: c). "!!!! unlike #==" + + self assert: a == a. + self deny: a == b. + self deny: a == c. "!!!! unlike #ffiIdentical:" + + ! Item was added: + ----- Method: FFIAllocateTests>>test01StructureAccess (in category 'tests - structure') ----- + test01StructureAccess + + | sfi | + sfi := self allocate: FFITestSfi. + + "1) Test initial values." + self assert: 0.0 equals: sfi f1. + self assert: 0 equals: sfi i2. + + "2) Test basic read/write of fields" + sfi i2: 2. + self assert: 2 equals: sfi i2. + self assert: 0.0 equals: sfi f1. "not touched" + sfi f1: 2.0. + self assert: 2.0 equals: sfi f1. + self assert: 2 equals: sfi i2. "not touched"! Item was added: + ----- Method: FFIAllocateTests>>test01UnionAccess (in category 'tests - union') ----- + test01UnionAccess + + | ufi | + ufi := self allocate: FFITestUfi. + + "1) Test initial values." + self assert: 0.0 equals: ufi f1. + self assert: 0 equals: ufi i1. + + "2) Test basic read/write of fields" + ufi i1: 2. + self assert: 2 equals: ufi i1. + self deny: 0.0 equals: ufi f1. "overwritten" + ufi f1: 2.0. + self assert: 2.0 equals: ufi f1. + self deny: 2 equals: ufi i1. "overwritten"! Item was added: + ----- Method: FFIAllocateTests>>test02AliasForAtomicZeroMemory (in category 'tests - type alias') ----- + test02AliasForAtomicZeroMemory + + | char | + char := self allocate: FFITestAliasForChar. + char value: $A. + char zeroMemory. + self assert: Character null equals: char value.! Item was added: + ----- 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 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 added: + ----- Method: FFIAllocateTests>>test02Equality (in category 'tests') ----- + test02Equality + + | a b c | + a := self allocate: FFITestPoint2. + b := self allocate: FFITestPoint2. + c := FFITestPoint2 fromHandle: a getHandle. + + self assert: (a ffiEqual: a). + self assert: (a ffiEqual: b). + self assert: (a ffiEqual: c). + + self assert: a = a. + self deny: a = b. + self assert: a = c. "bc. #ffiIdentical: by default" + ! Item was added: + ----- Method: FFIAllocateTests>>test02StructureCompositeAccess (in category 'tests - structure') ----- + test02StructureCompositeAccess + "Tests the access to composite structures. Uses #writer to avoid copy-on-access for sub-structs." + + | composite | + composite := self allocate: FFITestSsSsf. + + self assert: 0 equals: composite s1. + self assert: 0 equals: composite ssf2 s1. + self assert: 0.0 equals: composite ssf2 f2. + + composite s1: 1. + self assert: 1 equals: composite s1. + + composite ssf2 s1: 2. + self assert: 0 equals: composite ssf2 s1. + composite writer ssf2 s1: 2. + self assert: 2 equals: composite ssf2 s1. + + composite ssf2 f2: 3.0. + self assert: 0.0 equals: composite ssf2 f2. + composite writer ssf2 f2: 3.0. + self assert: 3.0 equals: composite ssf2 f2.! Item was added: + ----- Method: FFIAllocateTests>>test02Union_IEEE32BitWord (in category 'tests - union') ----- + test02Union_IEEE32BitWord + "Test union-specific field overlay, directly and indirectly." + + | ufi | + ufi := self allocate: FFITestUfi. + + ufi f1: 3.0. "Direct write" + self assert: 3.0 asIEEE32BitWord equals: ufi i1. + self assert: 3.0 equals: (Float fromIEEE32Bit: ufi i1). + + ufi i1: 4.0 asIEEE32BitWord. + self assert: 4.0 equals: (Float fromIEEE32Bit: ufi i1). + self assert: 4.0 equals: ufi f1. "Direct read"! Item was added: + ----- Method: FFIAllocateTests>>test03AliasForStructureAccess (in category 'tests - type alias') ----- + test03AliasForStructureAccess + + | sdi | + sdi := self allocate: FFITestAliasForSdi. + + self assert: 0.0 equals: sdi d1. + self assert: 0 equals: sdi i2. + + sdi d1: 1.0. + sdi i2: 2. + + self assert: 1.0 equals: sdi d1. + self assert: 2 equals: sdi i2.! Item was added: + ----- Method: FFIAllocateTests>>test03ArrayAccess (in category 'tests - array') ----- + test03ArrayAccess + + | somePoints firstPoint | + somePoints := self allocate: FFITestPoint2 size: 5. + self assert: 5 equals: somePoints size. + firstPoint := somePoints at: 1. + self assert: 0 at 0 equals: firstPoint asPoint. + firstPoint setX: 2 setY: 3. + self assert: 2 at 3 equals: firstPoint asPoint.! Item was added: + ----- 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 | + global := self allocate: FFITestAliasForInt32. + self assert: 0 equals: global value. + global value: 42. + self assert: 42 equals: global value.! Item was added: + ----- Method: FFIAllocateTests>>test03StructureCopy (in category 'tests - structure') ----- + test03StructureCopy + + | original copy | + original := self allocate: FFITestPoint2. + original setX: 1 setY: 2. + + copy := original copy. + self assert: (original ffiEqual: copy). + self deny: (original ffiIdentical: copy). + + copy setX: 3 setY: 4. + self assert: 1 at 2 equals: original asPoint. + self assert: 3 at 4 equals: copy asPoint.! Item was added: + ----- Method: FFIAllocateTests>>test03Union_IEEE64BitWord (in category 'tests - union') ----- + test03Union_IEEE64BitWord + "Test union-specific field overlay, directly and indirectly." + + | udi | + udi := self allocate: FFITestUdi. + + udi d1: 3.0. "Direct write" + self assert: 3.0 asIEEE64BitWord equals: udi i1. + self assert: 3.0 equals: (Float fromIEEE64Bit: udi i1). + + udi i1: 4.0 asIEEE64BitWord. + self assert: 4.0 equals: (Float fromIEEE64Bit: udi i1). + self assert: 4.0 equals: udi d1. "Direct read"! Item was added: + ----- Method: FFIAllocateTests>>test04AliasForUnionAccess (in category 'tests - type alias') ----- + test04AliasForUnionAccess + + | ufi | + ufi := self allocate: FFITestAliasForUfi. + + self assert: 0.0 equals: ufi f1. + self assert: 0 equals: ufi i1. + + ufi i1: 2. + self assert: 2 equals: ufi i1. + self deny: 0.0 equals: ufi f1. "overwritten" + ufi f1: 2.0. + self assert: 2.0 equals: ufi f1. + self deny: 2 equals: ufi i1. "overwritten"! Item was added: + ----- Method: FFIAllocateTests>>test04ArrayCompositeAccess (in category 'tests - array') ----- + test04ArrayCompositeAccess + + | data | + data := FFITestSdA5i allocate. + self assert: data a5i2 first equals: 0. + data writer a5i2 at: 1 put: 42. + self assert: data a5i2 first equals: 42.! Item was added: + ----- 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 | + global := self allocate: ExternalType int32_t size: 1. + self assert: global isArray. + self assert: 0 equals: global value. + global value: 42. + self assert: 42 equals: global value.! Item was added: + ----- Method: FFIAllocateTests>>test04LinkedList (in category 'tests - structure') ----- + test04LinkedList + + | link1 link2 link3 | + link1 := self allocate: FFITestLink. + link2 := self allocate: FFITestLink. + link3 := self allocate: FFITestLink. + + link1 next: link2. link2 prev: link1. + link2 next: link3. link3 prev: link2. + link3 next: link1. link1 prev: link3. + + self assert: link1 next = link2. + self assert: link2 next = link3. + self assert: link3 next = link1. + + self assert: link3 prev = link2. + self assert: link2 prev = link1. + self assert: link1 prev = link3. ! Item was added: + ----- Method: FFIAllocateTests>>test04UnionCompositeAccess (in category 'tests - union') ----- + test04UnionCompositeAccess + "Tests the access to composite union. Uses #writer to avoid copy-on-access for sub-structs." + + | composite | + composite := self allocate: FFITestUdSi2. + + self assert: 0.0 equals: composite d1. + self assert: 0 equals: composite sii1 i1. + self assert: 0 equals: composite sii1 i2. + + composite d1: 1.0. + self assert: 1.0 equals: composite d1. + composite d1: 0.0. "Clear to clear shared sub-structure." + + composite sii1 i1: 2. + self assert: 0 equals: composite sii1 i1. + composite writer sii1 i1: 2. + self assert: 2 equals: composite sii1 i1. + + composite sii1 i2: 3. + self assert: 0 equals: composite sii1 i2. + composite writer sii1 i2: 3. + self assert: 3 equals: composite sii1 i2.! Item was added: + ----- Method: FFIAllocateTests>>test05AliasForPointerToStructureAccess (in category 'tests - type alias') ----- + test05AliasForPointerToStructureAccess + + | sdi | + sdi := self allocate: FFITestAliasForSdiPointer. + + self assert: 0.0 equals: sdi d1. + self assert: 0 equals: sdi i2. + + sdi d1: 1.0. + sdi i2: 2. + + self assert: 1.0 equals: sdi d1. + self assert: 2 equals: sdi i2.! Item was added: + ----- Method: FFIAllocateTests>>test05ArrayFromCString (in category 'tests - array') ----- + test05ArrayFromCString + + | data | + + ExternalData allowDetectForUnknownSizeDuring: [ + data := self allocate: ExternalType char size: 4. + data setType: ExternalType byte. + self assert: data size isNil. + + #[65 66 67 0] withIndexDo: [:byte :index | data at: index put: byte]. + data setType: ExternalType char. + self assert: 'ABC' equals: data fromCString. + + data := self allocate: ExternalType char size: 9. + data setType: ExternalType byte. + self assert: data size isNil. + + #[65 66 67 0 68 69 70 0 0] withIndexDo: [:byte :index | data at: index put: byte]. + data setType: ExternalType char. + self assert:#('ABC' 'DEF') equals: data fromCStrings].! Item was added: + ----- Method: FFIAllocateTests>>test05StructureZeroMemory (in category 'tests - structure') ----- + test05StructureZeroMemory + + | sfi | + sfi := self allocate: FFITestSfi. + sfi i2: 2. + sfi f1: 2.0. + + sfi zeroMemory. + self assert: 0.0 equals: sfi f1. + self assert: 0 equals: sfi i2.! Item was added: + ----- Method: FFIAllocateTests>>test05UnionCompositeAccessTwo (in category 'tests - union') ----- + test05UnionCompositeAccessTwo + + | composite | + composite := self allocate: FFITestSUfdUdSi2. + + self assert: 0.0 equals: composite ufd1 f1. + composite ufd1 f1: 3.5. + self deny: 3.5 equals: composite ufd1 f1. + composite writer ufd1 f1: 3.5. + self assert: 3.5 equals: composite ufd1 f1. + + self assert: 0 equals: composite udSii2 sii1 i1. + composite udSii2 sii1 i1: 42. + self deny: 42 equals: composite udSii2 sii1 i1. + composite writer udSii2 sii1 i1: 42. + self assert: 42 equals: composite udSii2 sii1 i1.! Item was added: + ----- Method: FFIAllocateTests>>test06ArrayOfPointers (in category 'tests - array') ----- + test06ArrayOfPointers + "In internal memory, byte-array pointers do not count. We cannot really do anything here with an array of null-pointers." + + | array type | + type := self lookupType: 'char*'. + array := self allocate: type size: 6. + self assert: 0 equals: array byteSize. + + self deny: array isNull. + array do: [:each | + self assert: each isNull. + self assert: 0 equals: each byteSize].! Item was added: + ----- Method: FFIAllocateTests>>test06StructureAsArray (in category 'tests - structure') ----- + test06StructureAsArray + + | sfi array element | + sfi := self allocate: FFITestSfi. + sfi f1: 2.5. + sfi i2: 10. + + array := sfi reader asArray. + element := array first. + + self assert: (sfi ffiIdentical: element). + self assert: (sfi ffiEqual: element). + + self assert: 2.5 equals: element f1. + self assert: 10 equals: element i2.! Item was added: + ----- Method: FFIAllocateTests>>test06UnionCopy (in category 'tests - union') ----- + test06UnionCopy + + | original copy | + original := self allocate: FFITestUdi. + original d1: 1.0. + + copy := original copy. + self assert: (original ffiEqual: copy). + self deny: (original ffiIdentical: copy). + + copy i1: 2. + self assert: 1.0 equals: original d1. + self assert: 2 equals: copy i1.! Item was added: + ----- Method: FFIAllocateTests>>test07UnionZeroMemory (in category 'tests - union') ----- + test07UnionZeroMemory + + | ufi | + ufi := self allocate: FFITestUfi. + ufi f1: 2.0. + ufi i1: 2. + + ufi zeroMemory. + self assert: 0.0 equals: ufi f1. + self assert: 0 equals: ufi i1.! Item was changed: ----- Method: FFIPluginTests>>expectedFailures (in category 'failures') ----- expectedFailures ^ #( + testIntAliasCallReturnIntAlias "return-type coercing failed - check referentClass notNil missing?" + testIntCallReturnIntAlias "return-type coercing failed - check referentClass notNil missing?" - testIntAliasCallReturnIntAlias "return-type coercing failed" - testIntCallReturnIntAlias "return-type coercing failed" testMixedDoublesAndLongsSum "more than 15 method args needed" testSumStructSslf4 "some overflow issue, maybe expected")! Item was added: + ----- Method: FFIPluginTests>>testArrayResultWithPoint (in category 'tests - arrays') ----- + testArrayResultWithPoint + "Test returning of pointers to arrays" + | pt1 pt2 pt3 | + pt1 := FFITestPoint4 new. + pt1 x: 1. pt1 y: 2. pt1 z: 3. pt1 w: 4. + pt2 := FFITestPoint4 new. + pt2 x: 5. pt2 y: 6. pt2 z: 7. pt2 w: 8. + pt3 := heapObject := FFITestLibrary ffiTestArrayResultWith: pt1 with: pt2. + + self assert: pt3 isArray. + pt3 := pt3 value. + + self assert: pt3 x = 6. + self assert: pt3 y = 8. + self assert: pt3 z = 10. + self assert: pt3 w = 12.! Item was added: + ----- Method: FFIPluginTests>>testArrayResultWithString (in category 'tests - arrays') ----- + testArrayResultWithString + "Note that the result does not have to be free'd because the FFITestLibrary is just passing along a Smalltalkg string. I think." + + | string result | + string := 'Hello Squeak!!'. + result := FFITestLibrary ffiTestArrayResultWithString: string. + self assert: result isArray. + ExternalData allowDetectForUnknownSizeDuring: [ + self assert: string equals: result fromCString].! Item was changed: ----- Method: FFIPluginTests>>testIntAliasCall (in category 'tests - type alias') ----- testIntAliasCall | result | result := FFITestLibrary + ffiTestIntAlias4IntSum: (FFITestAliasForInt32 fromHandle: 1) + with: (FFITestAliasForInt32 fromHandle: 2) + with: (FFITestAliasForInt32 fromHandle: 3) + with: (FFITestAliasForInt32 fromHandle: 4). - ffiTestIntAlias4IntSum: (FFITestIntAlias fromHandle: 1) - with: (FFITestIntAlias fromHandle: 2) - with: (FFITestIntAlias fromHandle: 3) - with: (FFITestIntAlias fromHandle: 4). self assert: 10 equals: result.! Item was changed: ----- Method: FFIPluginTests>>testIntAliasCallReturnIntAlias (in category 'tests - type alias') ----- testIntAliasCallReturnIntAlias | result | result := FFITestLibrary + ffiTestIntAlias4IntAliasSum: (FFITestAliasForInt32 fromHandle: 1) + with: (FFITestAliasForInt32 fromHandle: 2) + with: (FFITestAliasForInt32 fromHandle: 3) + with: (FFITestAliasForInt32 fromHandle: 4). - ffiTestIntAlias4IntAliasSum: (FFITestIntAlias fromHandle: 1) - with: (FFITestIntAlias fromHandle: 2) - with: (FFITestIntAlias fromHandle: 3) - with: (FFITestIntAlias fromHandle: 4). self + assert: (result isKindOf: FFITestAliasForInt32); - assert: (result isKindOf: FFITestIntAlias); assert: 10 equals: result value.! Item was changed: ----- Method: FFIPluginTests>>testIntCallReturnIntAlias (in category 'tests - type alias') ----- testIntCallReturnIntAlias | result | result := FFITestLibrary ffiTestIntAlias4IntSum: 1 with: 2 with: 3 with: 4. self + assert: (result isKindOf: FFITestAliasForInt32); - assert: (result isKindOf: FFITestIntAlias); assert: 10 equals: result value.! Item was added: + TestCase subclass: #FFIPluginTypeTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests'! + + !FFIPluginTypeTests commentStamp: 'mt 5/10/2021 09:48' prior: 0! + A collection of tests around the type signatures for the FFITestLibrary.! Item was added: + ----- Method: FFIPluginTypeTests>>argTypesAt: (in category 'support') ----- + argTypesAt: selector + + ^ (FFITestLibrary class >> selector) externalLibraryFunction argTypes! Item was added: + ----- Method: FFIPluginTypeTests>>testArray (in category 'tests') ----- + testArray + + (self argTypesAt: #ffiTestArrayType) do: [:type | + self + assert: type isPointerType; + deny: type isArrayType; + assert: type asNonPointerType isArrayType; + assert: type asNonPointerType size > 0]! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicBool (in category 'tests') ----- + testAtomicBool + + self + flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestBool:with:with:with:) + equals: (Array new: 5 withAll: ExternalType bool).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicChar (in category 'tests') ----- + testAtomicChar + + self + flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestChars:with:with:with:) + equals: (Array new: 5 withAll: ExternalType char).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicCharPointer (in category 'tests') ----- + testAtomicCharPointer + + self + assert: (self argTypesAt: #ffiPrintString:) + equals: (Array new: 2 withAll: ExternalType char asPointerType).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicDouble (in category 'tests') ----- + testAtomicDouble + + self + assert: (self argTypesAt: #ffiTestDoubles:with:) + equals: (Array new: 3 withAll: ExternalType double).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicFloat (in category 'tests') ----- + testAtomicFloat + + self + assert: (self argTypesAt: #ffiTestFloats:with:) + equals: (Array new: 3 withAll: ExternalType float).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicInt (in category 'tests') ----- + testAtomicInt + + self + flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestInts:with:with:with:) + equals: (Array new: 5 withAll: ExternalType int).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicLong (in category 'tests') ----- + testAtomicLong + + self + flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestInts:with:with:with:) + equals: (Array new: 5 withAll: ExternalType long).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicLongLong (in category 'tests') ----- + testAtomicLongLong + + self + assert: (self argTypesAt: #ffiTestLongLong:with:) + equals: (Array new: 3 withAll: ExternalType longlong).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicString (in category 'tests') ----- + testAtomicString + + self + assert: (self argTypesAt: #ffiPrintString:) + equals: (Array new: 2 withAll: ExternalType string).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicUint (in category 'tests') ----- + testAtomicUint + + self + flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestUint:with:with:with:) allButFirst + equals: (Array new: 4 withAll: ExternalType uint).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicUlong (in category 'tests') ----- + testAtomicUlong + + self + flag: #ffiLongVsInt; + assert: (self argTypesAt: #ffiTestUint:with:with:with:) allButFirst + equals: (Array new: 4 withAll: ExternalType ulong).! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicVoid (in category 'tests') ----- + testAtomicVoid + "Only test for return type since argument 'void' means 'no argument' in C." + + self + assert: (self argTypesAt: #ffiTestVoid) + equals: {ExternalType void}.! Item was added: + ----- Method: FFIPluginTypeTests>>testAtomicVoidPointer (in category 'tests') ----- + testAtomicVoidPointer + + self + assert: (self argTypesAt: #ffiTestVoidPointer) + equals: (Array new: 2 withAll: ExternalType void asPointerType).! Item was added: + ----- Method: FFIPluginTypeTests>>testStruct (in category 'tests') ----- + testStruct + + self + assert: (self argTypesAt: #ffiTestStruct64:with:) + equals: (Array new: 3 withAll: FFITestPoint2 externalType).! Item was added: + ----- Method: FFIPluginTypeTests>>testStructPointer (in category 'tests') ----- + testStructPointer + + self + assert: (self argTypesAt: #ffiTestPointers:with:) + equals: (Array new: 3 withAll: FFITestPoint4 externalType asPointerType).! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForChar + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForChar class>>originalTypeName (in category 'type alias') ----- + originalTypeName + + ^ 'char'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForCharPointer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForCharPointer class>>originalTypeName (in category 'as yet unclassified') ----- + originalTypeName + " + self defineFields + " + ^ 'char*'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForInt32 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForInt32 class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields + " + ^ 'int32_t'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForInt32Array + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForInt32Array class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields. + " + ^ 'int32_t[5]'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForInt32ArrayPointer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForInt32ArrayPointer class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields + " + "^ 'int32_t[5]*' -- Not supported" + "^ 'void**' -- Not supported" + ^ 'void*' "Workaround."! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForInt32Pointer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForInt32Pointer class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields + " + ^ 'int32_t*'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForSdi + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForSdi class>>originalTypeName (in category 'as yet unclassified') ----- + originalTypeName + " + self defineFields + " + ^ 'FFITestSdi'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForSdiPointer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForSdiPointer class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields + " + ^ 'FFITestSdi*'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForUfi + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForUfi class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields. + " + ^ 'FFITestUfi'! Item was added: + ExternalTypeAlias subclass: #FFITestAliasForVoidPointer + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestAliasForVoidPointer class>>originalTypeName (in category 'type alias') ----- + originalTypeName + " + self defineFields + " + ^ 'void*'! Item was removed: - ExternalTypeAlias subclass: #FFITestCharAlias - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Tests-Fixtures'! Item was removed: - ----- Method: FFITestCharAlias class>>originalTypeName (in category 'type alias') ----- - originalTypeName - - ^ 'char'! Item was added: + ExternalStructure subclass: #FFITestEmptyStruct + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was removed: - ExternalTypeAlias subclass: #FFITestIntAlias - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Tests-Fixtures'! Item was removed: - ----- Method: FFITestIntAlias class>>originalTypeName (in category 'type alias') ----- - originalTypeName - " - self defineFields - " - ^ 'int32_t'! Item was added: + ----- Method: FFITestLibrary class>>ffiTestArrayResultWith:with: (in category 'mocks') ----- + ffiTestArrayResultWith: pt1 with: pt2 + "Allocates the result. Needs to be free'd after calling." + <cdecl: FFITestPoint4[] 'ffiTestPointers' (FFITestPoint4* FFITestPoint4*) module:'SqueakFFIPrims'> + ^self externalCallFailed! Item was added: + ----- Method: FFITestLibrary class>>ffiTestArrayResultWithString: (in category 'mocks') ----- + ffiTestArrayResultWithString: aString + " + FFITestLibrary ffiTestArrayResultWithString: 'Hello Squeak'. + " + <cdecl: char[] 'ffiPrintString' (char *) module:'SqueakFFIPrims'> + ^self externalCallFailed! Item was changed: ----- Method: FFITestLibrary class>>ffiTestInt4IntAliasSum:with:with:with: (in category 'type alias') ----- ffiTestInt4IntAliasSum: c1 with: c2 with: c3 with: c4 "FFITestLibrary ffiTest4IntSum: 1 with: 2 with: 3 with: 4" + <cdecl: int 'ffiTest4IntSum' (FFITestAliasForInt32 FFITestAliasForInt32 FFITestAliasForInt32 FFITestAliasForInt32) module:'SqueakFFIPrims'> - <cdecl: int 'ffiTest4IntSum' (FFITestIntAlias FFITestIntAlias FFITestIntAlias FFITestIntAlias) module:'SqueakFFIPrims'> ^self externalCallFailed! Item was changed: ----- Method: FFITestLibrary class>>ffiTestIntAlias4IntAliasSum:with:with:with: (in category 'type alias') ----- ffiTestIntAlias4IntAliasSum: c1 with: c2 with: c3 with: c4 "FFITestLibrary ffiTest4IntSum: 1 with: 2 with: 3 with: 4" + <cdecl: FFITestAliasForInt32 'ffiTest4IntSum' (FFITestAliasForInt32 FFITestAliasForInt32 FFITestAliasForInt32 FFITestAliasForInt32) module:'SqueakFFIPrims'> - <cdecl: FFITestIntAlias 'ffiTest4IntSum' (FFITestIntAlias FFITestIntAlias FFITestIntAlias FFITestIntAlias) module:'SqueakFFIPrims'> ^self externalCallFailed! Item was changed: ----- Method: FFITestLibrary class>>ffiTestIntAlias4IntSum:with:with:with: (in category 'type alias') ----- ffiTestIntAlias4IntSum: c1 with: c2 with: c3 with: c4 "FFITestLibrary ffiTest4IntSum: 1 with: 2 with: 3 with: 4" + <cdecl: FFITestAliasForInt32 'ffiTest4IntSum' (int32_t int32_t int32_t int32_t) module:'SqueakFFIPrims'> - <cdecl: FFITestIntAlias 'ffiTest4IntSum' (int int int int) module:'SqueakFFIPrims'> ^self externalCallFailed! Item was removed: - ----- Method: FFITestLink>>= (in category 'comparing') ----- - = other - - (other isKindOf: ExternalStructure) ifFalse: [^ false]. - self externalType = other externalType ifFalse: [^ false]. - ^ other getHandle = self getHandle! Item was removed: - ----- Method: FFITestLink>>hash (in category 'comparing') ----- - hash - - ^ ExternalObject hash bitXor: self getHandle hash! Item was added: + ExternalUnion subclass: #FFITestUdi + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Tests-Fixtures'! Item was added: + ----- Method: FFITestUdi class>>fields (in category 'field definition') ----- + fields + " + self defineFields + " + ^#( + (d1 'double') + (i1 'int64_t') + )! Item was removed: - TestCase subclass: #FFITypeNameTests - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'FFI-Tests'! Item was removed: - ----- Method: FFITypeNameTests>>argTypesAt: (in category 'support') ----- - argTypesAt: selector - - ^ (FFITestLibrary class >> selector) externalLibraryFunction argTypes! Item was removed: - ----- Method: FFITypeNameTests>>testArray (in category 'tests') ----- - testArray - - (self argTypesAt: #ffiTestArrayType) do: [:type | - self - assert: type isPointerType; - deny: type isArrayType; - assert: type asNonPointerType isArrayType; - assert: type asNonPointerType size > 0]! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicBool (in category 'tests') ----- - testAtomicBool - - self - flag: #ffiLongVsInt; - assert: (self argTypesAt: #ffiTestBool:with:with:with:) - equals: (Array new: 5 withAll: ExternalType bool).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicChar (in category 'tests') ----- - testAtomicChar - - self - flag: #ffiLongVsInt; - assert: (self argTypesAt: #ffiTestChars:with:with:with:) - equals: (Array new: 5 withAll: ExternalType char).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicCharPointer (in category 'tests') ----- - testAtomicCharPointer - - self - assert: (self argTypesAt: #ffiPrintString:) - equals: (Array new: 2 withAll: ExternalType char asPointerType).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicDouble (in category 'tests') ----- - testAtomicDouble - - self - assert: (self argTypesAt: #ffiTestDoubles:with:) - equals: (Array new: 3 withAll: ExternalType double).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicFloat (in category 'tests') ----- - testAtomicFloat - - self - assert: (self argTypesAt: #ffiTestFloats:with:) - equals: (Array new: 3 withAll: ExternalType float).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicInt (in category 'tests') ----- - testAtomicInt - - self - flag: #ffiLongVsInt; - assert: (self argTypesAt: #ffiTestInts:with:with:with:) - equals: (Array new: 5 withAll: ExternalType int).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicLong (in category 'tests') ----- - testAtomicLong - - self - flag: #ffiLongVsInt; - assert: (self argTypesAt: #ffiTestInts:with:with:with:) - equals: (Array new: 5 withAll: ExternalType long).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicLongLong (in category 'tests') ----- - testAtomicLongLong - - self - assert: (self argTypesAt: #ffiTestLongLong:with:) - equals: (Array new: 3 withAll: ExternalType longlong).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicString (in category 'tests') ----- - testAtomicString - - self - assert: (self argTypesAt: #ffiPrintString:) - equals: (Array new: 2 withAll: ExternalType string).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicUint (in category 'tests') ----- - testAtomicUint - - self - flag: #ffiLongVsInt; - assert: (self argTypesAt: #ffiTestUint:with:with:with:) allButFirst - equals: (Array new: 4 withAll: ExternalType uint).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicUlong (in category 'tests') ----- - testAtomicUlong - - self - flag: #ffiLongVsInt; - assert: (self argTypesAt: #ffiTestUint:with:with:with:) allButFirst - equals: (Array new: 4 withAll: ExternalType ulong).! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicVoid (in category 'tests') ----- - testAtomicVoid - "Only test for return type since argument 'void' means 'no argument' in C." - - self - assert: (self argTypesAt: #ffiTestVoid) - equals: {ExternalType void}.! Item was removed: - ----- Method: FFITypeNameTests>>testAtomicVoidPointer (in category 'tests') ----- - testAtomicVoidPointer - - self - assert: (self argTypesAt: #ffiTestVoidPointer) - equals: (Array new: 2 withAll: ExternalType void asPointerType).! Item was removed: - ----- Method: FFITypeNameTests>>testStruct (in category 'tests') ----- - testStruct - - self - assert: (self argTypesAt: #ffiTestStruct64:with:) - equals: (Array new: 3 withAll: FFITestPoint2 externalType).! Item was removed: - ----- Method: FFITypeNameTests>>testStructPointer (in category 'tests') ----- - testStructPointer - - self - assert: (self argTypesAt: #ffiTestPointers:with:) - equals: (Array new: 3 withAll: FFITestPoint4 externalType asPointerType).!
More information about the Squeak-dev mailing list |