# (c) 2021 Ashok P. Nadkarni
# See LICENSE for license terms.
#
# Tests for the cffi::memory command

source [file join [file dirname [info script]] common.tcl]

# NOTE: use fully qualified command name since Tcl also has a
# command called memory

namespace eval cffi::test {
    testsubcmd ::cffi::memory
    testnumargs memory-allocate "cffi::memory allocate" "SIZE" "?TAG?"

    test memory-allocate-0 {Allocate 1 byte untagged} -cleanup {
        cffi::memory free $p
    } -body {
        set p [cffi::memory allocate 1]
    } -result {^0x[[:xdigit:]]{8,16}\^$} -match regexp

    test memory-allocate-1 {Allocate 1 byte tagged} -cleanup {
        cffi::memory free $p
    } -body {
        set p [cffi::memory allocate 1 TAG]
    } -result {^0x[[:xdigit:]]{8,16}\^::cffi::test::TAG$} -match regexp


    foreach {type val} [array get testValues] {
        if {$type ni {string unistring binary}} {
            test memory-allocate-$type-0 "allocate $type" -setup {
                set p [cffi::memory allocate $type]
            } -cleanup {
                cffi::memory free $p
            } -body {
                cffi::memory set $p $type $val
                cffi::memory get $p $type
            } -result $val
            if {$type in [list {*}$numericTypes struct.::StructValue]} {
                # In array tests, use [lindex $type 0] since testValues contains
                # "pointer unsafe" and we only want pointer
                test memory-allocate-$type-array-0 "allocate $type array" -setup {
                    set p [cffi::memory allocate $type\[2\]]
                } -cleanup {
                    cffi::memory free $p
                } -body {
                    cffi::memory set $p $type\[2\] [list $val $val]
                    cffi::memory get $p $type\[2\]
                } -result [list $val $val]
            }
        }
    }

    test memory-allocate-error-0 {Allocate zero bytes} -body {
        list [catch {cffi::memory allocate 0} result] $result $::errorCode
    } -result {1 {Invalid value "0". Allocation size argument must be a positive 32-bit integer or a type specification.} {cffi INVALID_VALUE {Invalid value "0". Allocation size argument must be a positive 32-bit integer or a type specification.}}}

    test memory-allocate-error-1 {Missing args} -body {
        list [catch {cffi::memory allocate} result] $result $::errorCode
    } -result {1 {wrong # args: should be "cffi::memory allocate SIZE ?TAG?"} {TCL WRONGARGS}}

    test memory-allocate-error-2 {Extra args} -body {
        list [catch {cffi::memory allocate 0 TAG extra} result] $result $::errorCode
    } -result {1 {wrong # args: should be "cffi::memory allocate SIZE ?TAG?"} {TCL WRONGARGS}}

    ###

    testnumargs memory-free "cffi::memory free" "POINTER"

    test memory-free-0 {free null pointer} -body {
        cffi::memory free 0^
    } -result ""

    test memory_free-error-0 {Double free} -setup {
        set p [cffi::memory allocate 1]
        cffi::memory free $p
    } -body {
        list [catch {cffi::memory free $p} result] $result $::errorCode
    } -result {1 {Pointer * is not registered.} {cffi ERROR {Pointer * is not registered.}}} -match glob

    ###

    testnumargs memory-tobinary "cffi::memory tobinary" "POINTER SIZE" "?OFFSET?"
    testnumargs memory-tobinary! "cffi::memory tobinary!" "POINTER SIZE"  "?OFFSET?"
    testnumargs memory-frombinary "cffi::memory frombinary" "BINARY" "?TAG?"

    test memory-binary-0 {To/From binary - safe} -setup {
        set bin [binary format ddd 1.0 2.0 3.0]
    } -cleanup {
        cffi::memory free $p
    } -body {
        set p [cffi::memory frombinary $bin]
        binary scan [cffi::memory tobinary $p [string length $bin]] d3 bin2
        set bin2
    } -result {1.0 2.0 3.0}

    test memory-binary-1 {To/From tobinary! - unsafe} -setup {
        set bin [binary format ddd 1.0 2.0 3.0]
    } -cleanup {
        cffi::pointer safe $p
        cffi::memory free $p
    } -body {
        set p [cffi::memory frombinary $bin]
        cffi::pointer dispose $p; # Make unsafe
        binary scan [cffi::memory tobinary! $p [string length $bin]] d3 bin2
        set bin2
    } -result {1.0 2.0 3.0}

    test memory-binary-2 {To/From tobinary - unsafe} -body {
        cffi::memory tobinary [makeptr 1] 1
    } -result "Pointer [makeptr 1] is not registered." -returnCodes error

    test memory-binary-3 {To/From tobinary! - unsafe} -setup {
        set bin [binary format ddd 1.0 2.0 3.0]
    } -cleanup {
        cffi::pointer safe $p
        cffi::memory free $p
    } -body {
        set p [cffi::memory frombinary $bin]
        cffi::pointer dispose $p
        binary scan [cffi::memory tobinary! $p [string length $bin]] d3 bin2
        set bin2
    } -result {1.0 2.0 3.0}
    test memory-binary-4 {To/From binary offset - safe} -setup {
        set bin [binary format ddd 1.0 2.0 3.0]
    } -cleanup {
        cffi::memory free $p
    } -body {
        set p [cffi::memory frombinary $bin]
        set len [string length $bin]
        set off [expr {$len/3}]
        incr len -$off
        binary scan [cffi::memory tobinary $p $len $off] d2 bin2
        set bin2
    } -result {2.0 3.0}
    test memory-binary-5 {To/From tobinary! offset - unsafe} -setup {
        set bin [binary format ddd 1.0 2.0 3.0]
    } -cleanup {
        cffi::memory free $p
    } -body {
        set p [cffi::memory frombinary $bin]
        set len [string length $bin]
        set off [expr {$len/3}]
        binary scan [cffi::memory tobinary! $p $len $off] d2 bin2
        set bin2
    } -result {2.0 3.0}
    test memory-binary-6 {To/From tobinary! offset negative - unsafe} -setup {
        set bin [binary format ddd 1.0 2.0 3.0]
    } -cleanup {
        cffi::memory free $p
    } -body {
        set p [cffi::memory frombinary $bin]
        set len [string length $bin]
        set off [expr {$len/3}]
        binary scan [cffi::memory tobinary! [pointer_unsafe_add $p $off] $len -$off] d2 bin2
        set bin2
    } -result {1.0 2.0}

    test memory-tobinary-error-0 "tobinary null pointer" -body {
        cffi::memory tobinary 0^ 1
    } -result {Invalid value. Pointer is NULL.} -returnCodes error -match regexp
    test memory-tobinary!-error-0 "tobinary! null pointer" -body {
        cffi::memory tobinary! 0^ 1
    } -result {Pointer is NULL.} -returnCodes error
    test memory-tobinary-error-1 {To/From binary offset negative - safe} -setup {
        set bin [binary format ddd 1.0 2.0 3.0]
    } -cleanup {
        cffi::memory free $p
    } -body {
        set p [cffi::memory frombinary $bin]
        cffi::memory tobinary $p $len -1
        set bin2
    } -result {Invalid value "-1". Negative offsets are not allowed for safe pointers.} -returnCodes error

    ###

    testnumargs memory-tostring "cffi::memory tostring" "POINTER" "?ENCODING? ?OFFSET?"
    testnumargs memory-tostring! "cffi::memory tostring" "POINTER" "?ENCODING? ?OFFSET?"
    testnumargs memory-fromstring "cffi::memory fromstring" "STRING" "?ENCODING?"
    set num -1
    test memory-string-[incr num] "To/from string - safe, no optional args" -body {
        set p [cffi::memory fromstring abc]
        list \
            [cffi::pointer isvalid $p] \
            [cffi::memory tostring $p] \
            [cffi::memory free $p]
    } -result [list 1 abc {}]
    test memory-string!-$num "To/from string! - safe, no optional args" -body {
        set p [cffi::memory fromstring abc]
        list \
            [cffi::pointer isvalid $p] \
            [cffi::memory tostring! $p] \
            [cffi::memory free $p]
    } -result [list 1 abc {}]
    test memory-string-[incr num] "To/from string - unsafe, no optional args" -body {
        set p [cffi::memory fromstring abc]
        cffi::pointer dispose $p
        list \
            [cffi::pointer isvalid $p] \
            [catch {cffi::memory tostring $p} result] \
            [string match {Pointer 0x*^ is not registered.} $result] \
            [cffi::pointer safe $p] \
            [cffi::memory free $p]
    } -result [list 0 1 1 {} {}]
    test memory-string!-$num "To/from string! - unsafe, no optional args" -body {
        set p [cffi::memory fromstring abc]
        cffi::pointer dispose $p
        list \
            [cffi::pointer isvalid $p] \
            [cffi::memory tostring! $p] \
            [cffi::pointer safe $p] \
            [cffi::memory free $p]
    } -result [list 0 abc {} {}]
    # Encoding tests
    # Note: do not include ascii for jis0208 encoding tests.
    # See https://core.tcl-lang.org/tcl/tktview/9bad909c6ed4691bcad1886d710a923791a524a2
    set repeat 100000
    foreach {val encoding} \
        [list \
             "abc" {} \
             "" {} \
             "abc\xe0\xe1\xe2" cp1252 \
             "\u543e" jis0208 \
             "\u543e" unicode \
            ] \
        {
            test memory-string-[incr num] "To/from string - safe $encoding" -body {
                set p [cffi::memory fromstring $val $encoding]
                list \
                    [cffi::pointer isvalid $p] \
                    [cffi::memory tostring $p $encoding] \
                    [cffi::memory free $p]
            } -result [list 1 $val {}]
            test memory-string!-$num "To/from string! - unsafe $encoding" -body {
                set p [cffi::memory fromstring $val $encoding]
                cffi::pointer dispose $p
                list \
                    [cffi::pointer isvalid $p] \
                    [cffi::memory tostring! $p $encoding] \
                    [cffi::pointer safe $p] \
                    [cffi::memory free $p]
            } -result [list 0 $val {} {}]
            test memory-string-[incr num] "To/from long string - safe $encoding" -body {
                set p [cffi::memory fromstring [string repeat $val $repeat] $encoding]
                list \
                    [cffi::pointer isvalid $p] \
                    [cffi::memory tostring $p $encoding] \
                    [cffi::memory free $p]
            } -result [list 1 [string repeat $val $repeat] {}]
            test memory-string!-$num "To/from long string! - unsafe $encoding" -body {
                set p [cffi::memory fromstring [string repeat $val $repeat] $encoding]
                cffi::pointer dispose $p
                list \
                    [cffi::pointer isvalid $p] \
                    [cffi::memory tostring! $p $encoding] \
                    [cffi::pointer safe $p] \
                    [cffi::memory free $p]
            } -result [list 0 [string repeat $val $repeat] {} {}]
    }
    test memory-string-[incr num] "memory tostring offset" -body {
        set p [cffi::memory fromstring abc]
        cffi::memory tostring $p 1
    } -cleanup {
        cffi::memory free $p
    } -result bc
    test memory-string-[incr num] "memory tostring encoding offset" -body {
        set p [cffi::memory fromstring abc]
        cffi::memory tostring $p ascii 1
    } -cleanup {
        cffi::memory free $p
    } -result bc
    test memory-string-[incr num] "memory tostring! offset" -body {
        set p [cffi::memory fromstring abc]
        cffi::memory tostring! [pointer_unsafe_add $p 1] 1
    } -cleanup {
        cffi::memory free $p
    } -result c
    test memory-string-[incr num] "memory tostring! encoding offset" -body {
        set p [cffi::memory fromstring abc]
        cffi::memory tostring! [pointer_unsafe_add $p 1] ascii 1
    } -cleanup {
        cffi::memory free $p
    } -result c
    test memory-string-[incr num] "memory tostring! negative offset" -body {
        set p [cffi::memory fromstring abc]
        cffi::memory tostring! [pointer_unsafe_add $p 1] -1
    } -cleanup {
        cffi::memory free $p
    } -result abc
    test memory-tostring-error-0 "tostring null pointer" -body {
        cffi::memory tostring 0^ 1
    } -result {Invalid value. Pointer is NULL.} -returnCodes error -match regexp
    test memory-tostring-error-1 "memory tostring negative offset" -body {
        set p [cffi::memory fromstring abc]
        cffi::memory tostring $p -1
    } -cleanup {
        cffi::memory free $p
    } -result {Invalid value. Negative offsets are not allowed for safe pointers.} -returnCodes error
    test memory-tostring!-error-0 "tostring! null pointer" -body {
        cffi::memory tostring! 0^ 1
    } -result {Pointer is NULL.} -returnCodes error

    ###
    # memory fill
    testnumargs memory-fill "::cffi::memory fill" "POINTER BYTEVALUE COUNT" "?OFFSET?"
    test memory-fill-0 {memory fill} -setup {
        set p [cffi::memory frombinary \x00\xFF]
    } -cleanup {
        cffi::memory free $p
    } -body {
        cffi::memory fill $p 1 2
        cffi::memory tobinary $p 2
    } -result \x01\x01
    test memory-fill-1 {memory fill 0 bytes} -setup {
        set p [cffi::memory frombinary \x00\xFF]
    } -cleanup {
        cffi::memory free $p
    } -body {
        cffi::memory fill $p 1 0
        cffi::memory tobinary $p 2
    } -result \x00\xff
    test memory-fill-2 {memory fill lowest value} -setup {
        set p [cffi::memory frombinary \x00\xFF]
    } -cleanup {
        cffi::memory free $p
    } -body {
        cffi::memory fill $p 0 2
        cffi::memory tobinary $p 2
    } -result \x00\x00
    test memory-fill-3 {memory fill highest value} -setup {
        set p [cffi::memory frombinary \x00\xFF]
    } -cleanup {
        cffi::memory free $p
    } -body {
        cffi::memory fill $p 255 2
        cffi::memory tobinary $p 2
    } -result \xFF\xFF
    test memory-fill-4 {memory fill at offset} -setup {
        set p [cffi::memory frombinary \x01\x02\x03]
    } -cleanup {
        cffi::memory free $p
    } -body {
        cffi::memory fill $p 255 2 1
        cffi::memory tobinary $p 3
    } -result \x01\xff\xff

    test memory-fill-error-0 {memory fill negative bytes} -setup {
        set p [cffi::memory frombinary \x00\xFF]
    } -cleanup {
        cffi::memory free $p
    } -body {
        list \
            [catch {cffi::memory fill $p 1 -1} result] \
            $result \
            [cffi::memory tobinary $p 2]
    } -result [list 1 {Value -1 not in range. Must be within [0,2147483647].} \x00\xFF]
    test memory-fill-error-1 {memory fill > int-max bytes} -setup {
        set p [cffi::memory frombinary \x00\xFF]
    } -cleanup {
        cffi::memory free $p
    } -body {
        list \
            [catch {cffi::memory fill $p 1 2147483648} result] \
            $result \
            [cffi::memory tobinary $p 2]
    } -result [list 1 {Value 2147483648 not in range. Must be within [0,2147483647].} \x00\xFF]
    test memory-fill-error-2 {memory fill negative value} -setup {
        set p [cffi::memory frombinary \x00\xFF]
    } -cleanup {
        cffi::memory free $p
    } -body {
        list \
            [catch {cffi::memory fill $p -1 1} result] \
            $result \
            [cffi::memory tobinary $p 2]
    } -result [list 1 {Value -1 not in range. Must be within [0,255].} \x00\xFF]
    test memory-fill-error-3 {memory fill too high value} -setup {
        set p [cffi::memory frombinary \x00\xFF]
    } -cleanup {
        cffi::memory free $p
    } -body {
        list \
            [catch {cffi::memory fill $p 256 1} result] \
            $result \
            [cffi::memory tobinary $p 2]
    } -result [list 1 {Value 256 not in range. Must be within [0,255].} \x00\xFF]
    test memory-fill-error-4 "memory fill - NULL pointer" -body {
        cffi::memory fill NULL 0 1
    } -result "*Pointer is NULL*" -match glob -returnCodes error
    test memory-fill-error-5 {memory fill at negative offset} -setup {
        set p [cffi::memory frombinary \x01\x02\x03]
    } -cleanup {
        cffi::memory free $p
    } -body {
        list \
            [catch {cffi::memory fill $p 255 2 -1} emsg] \
            $emsg \
            [cffi::memory tobinary $p 3]
    } -result [list 1 {Invalid value "-1". Negative offsets are not allowed for safe pointers.} \x01\x02\x03]

    #
    # memory fill!
    testnumargs memory-fill! "::cffi::memory fill!" "POINTER BYTEVALUE COUNT" "?OFFSET?"
    test memory-fill!-0 {memory fill!} -setup {
        set p [cffi::memory frombinary \x00\xFF]
        cffi::pointer dispose $p
    } -cleanup {
        cffi::pointer safe $p
        cffi::memory free $p
    } -body {
        cffi::memory fill! $p 1 2
        cffi::memory tobinary! $p 2
    } -result \x01\x01
    test memory-fill!-1 {memory fill! 0 bytes} -setup {
        set p [cffi::memory frombinary \x00\xFF]
        cffi::pointer dispose $p
    } -cleanup {
        cffi::pointer safe $p
        cffi::memory free $p
    } -body {
        cffi::memory fill! $p 1 0
        cffi::memory tobinary! $p 2
    } -result \x00\xff
    test memory-fill!-2 {memory fill! lowest value} -setup {
        set p [cffi::memory frombinary \x00\xFF]
        cffi::pointer dispose $p
    } -cleanup {
        cffi::pointer safe $p
        cffi::memory free $p
    } -body {
        cffi::memory fill! $p 0 2
        cffi::memory tobinary! $p 2
    } -result \x00\x00
    test memory-fill!-3 {memory fill! highest value} -setup {
        set p [cffi::memory frombinary \x00\xFF]
        cffi::pointer dispose $p
    } -cleanup {
        cffi::pointer safe $p
        cffi::memory free $p
    } -body {
        cffi::memory fill! $p 255 2
        cffi::memory tobinary! $p 2
    } -result \xFF\xFF
    test memory-fill!-4 {memory fill! at offset} -setup {
        set p [cffi::memory frombinary \x01\x02\x03]
        cffi::pointer dispose $p
    } -cleanup {
        cffi::pointer safe $p
        cffi::memory free $p
    } -body {
        cffi::memory fill! $p 255 2 1
        cffi::memory tobinary! $p 3
    } -result \x01\xff\xff
    test memory-fill!-5 {memory fill! at negative offset} -setup {
        set p [cffi::memory frombinary \x01\x02\x03]
    } -cleanup {
        cffi::memory free $p
    } -body {
        cffi::memory fill! [pointer_unsafe_add $p 1] 255 2 -1
        cffi::memory tobinary! $p 3
    } -result \xff\xff\x03

    test memory-fill!-error-0 {memory fill! negative bytes} -setup {
        set p [cffi::memory frombinary \x00\xFF]
        cffi::pointer dispose $p
    } -cleanup {
        cffi::pointer safe $p
        cffi::memory free $p
    } -body {
        list \
            [catch {cffi::memory fill! $p 1 -1} result] \
            $result \
            [cffi::memory tobinary! $p 2]
    } -result [list 1 {Value -1 not in range. Must be within [0,2147483647].} \x00\xFF]
    test memory-fill!-error-1 {memory fill! > int-max bytes} -setup {
        set p [cffi::memory frombinary \x00\xFF]
        cffi::pointer dispose $p
    } -cleanup {
        cffi::pointer safe $p
        cffi::memory free $p
    } -body {
        list \
            [catch {cffi::memory fill! $p 1 2147483648} result] \
            $result \
            [cffi::memory tobinary! $p 2]
    } -result [list 1 {Value 2147483648 not in range. Must be within [0,2147483647].} \x00\xFF]
    test memory-fill!-error-2 {memory fill! negative value} -setup {
        set p [cffi::memory frombinary \x00\xFF]
        cffi::pointer dispose $p
    } -cleanup {
        cffi::pointer safe $p
        cffi::memory free $p
    } -body {
        list \
            [catch {cffi::memory fill! $p -1 1} result] \
            $result \
            [cffi::memory tobinary! $p 2]
    } -result [list 1 {Value -1 not in range. Must be within [0,255].} \x00\xFF]
    test memory-fill!-error-3 {memory fill! too high value} -setup {
        set p [cffi::memory frombinary \x00\xFF]
        cffi::pointer dispose $p
    } -cleanup {
        cffi::pointer safe $p
        cffi::memory free $p
    } -body {
        list \
            [catch {cffi::memory fill! $p 256 1} result] \
            $result \
            [cffi::memory tobinary! $p 2]
    } -result [list 1 {Value 256 not in range. Must be within [0,255].} \x00\xFF]
    test memory-fill!-error-4 "memory fill! - NULL pointer" -body {
        cffi::memory fill! NULL 0 1
    } -result "*Pointer is NULL*" -match glob -returnCodes error

    #
    # memory set/get
    testnumargs memory-get "cffi::memory get" "POINTER TYPE" "?INDEX?"
    testnumargs memory-set "cffi::memory set" "POINTER TYPE VALUE" "?INDEX?"

    foreach type [array names testValues] {
        test memory-set-$type-null-0 "set $type NULL" -body {
            cffi::memory set NULL $type $testValues($type)
        } -result "Invalid value. Pointer is NULL." -returnCodes error
        test memory-set-$type-unregistered-0 "set $type unregistered" -body {
            cffi::memory set [makeptr 1] $type $testValues($type)
        } -result "Pointer [makeptr 1] is not registered." -returnCodes error
        test memory-get-$type-null-0 "get $type NULL" -body {
            cffi::memory get NULL $type
        } -result "Invalid value. Pointer is NULL." -returnCodes error
        test memory-get-$type-unregistered-0 "get $type unregistered" -body {
            cffi::memory get [makeptr 1] $type
        } -result "Pointer [makeptr 1] is not registered." -returnCodes error
        test memory-set!-$type-null-0 "set! $type NULL" -body {
            cffi::memory set! NULL $type $testValues($type)
        } -result {Pointer is NULL.} -returnCodes error
        test memory-get!-$type-null-0 "get! $type NULL" -body {
            cffi::memory get! NULL $type
        } -result {Pointer is NULL.} -returnCodes error
    }
    foreach {type val} [array get testValues] {
        if {$type ni {string unistring binary}} {
            test memory-set-get-$type-0 "set/get $type" -setup {
                set p [cffi::memory allocate $type]
            } -cleanup {
                cffi::memory free $p
            } -body {
                cffi::memory set $p $type $val
                cffi::memory get $p $type
            } -result $val

            test memory-set-get-$type-alias-0 "set/get $type - aliased" -setup {
                cffi::alias clear
                cffi::alias define ALIAS $type
                set p [cffi::memory allocate ALIAS]
            } -cleanup {
                cffi::memory free $p
                cffi::alias clear
            } -body {
                cffi::memory set $p ALIAS $val
                cffi::memory get $p ALIAS
            } -result $val

            test memory-set-$type-badindex-0 "set $type badindex" -setup {
                set p [cffi::memory allocate $type]
            } -cleanup {
                cffi::memory free $p
            } -body {
                cffi::memory set $p $type $val notanint
            } -result {expected integer but got "notanint"} -returnCodes error

            if {[info exists badValues($type)]} {
                test memory-set-$type-badvalue-0 "set $type bad value" -setup {
                    set p [cffi::memory allocate $type]
                } -cleanup {
                    cffi::memory free $p
                } -body {
                    cffi::memory set $p $type $val
                    list [cffi::memory get $p $type] \
                        [catch {cffi::memory set $p $type $badValues($type)} errorMsg] \
                        [regexp {expected.*but got|Invalid value|missing.*key} $errorMsg] \
                        [cffi::memory get $p $type]
                } -result [list $val 1 1 $val]

            }

            test memory-get-$type-badindex-0 "get $type - bad index" -setup {
                set p [cffi::memory allocate $type]
            } -cleanup {
                cffi::memory free $p
            } -body {
                cffi::memory get $p $type notanint
            } -result {expected integer but got "notanint"} -returnCodes error

            test memory-set!-get!-$type-0 "set!/get! $type" -setup {
                set p [cffi::memory allocate $type]
                cffi::pointer dispose $p;#Make unsafe
            } -cleanup {
                cffi::pointer safe $p
                cffi::memory free $p
            } -body {
                cffi::memory set! $p $type $val
                cffi::memory get! $p $type
            } -result $val
        }
        if {$type in $numericTypes} {
            test memory-set-get-$type-1 "set/get $type index" -setup {
                set p [cffi::memory allocate $type\[2\]]
            } -cleanup {
                cffi::memory free $p
            } -body {
                cffi::memory set $p $type\[2\] [list 1 $val]
                cffi::memory get $p $type 1
            } -result $val

            test memory-set-get-$type-array-0 "set/get $type array" -setup {
                set p [cffi::memory allocate $type\[2\]]
            } -cleanup {
                cffi::memory free $p
            } -body {
                cffi::memory set $p $type\[2\] [list 1 $val]
                cffi::memory get $p $type\[2\]
            } -result [list [expr {$type in $realTypes ? 1.0 : 1}] $val]
        }
    }
    set type struct.::StructValue
    set val $testValues($type)
    test memory-set-get-$type-array-0 "set/get $type array" -setup {
        set p [cffi::memory allocate $type\[2\]]
    } -cleanup {
        cffi::memory free $p
    } -body {
        cffi::memory set $p $type\[2\] [list {} $val]
        cffi::memory get $p $type\[2\]
    } -result [list {c 0 i 0} $val]
    test memory-set-get-$type-array-0 "set/get $type index" -setup {
        set p [cffi::memory allocate $type\[2\]]
    } -cleanup {
        cffi::memory free $p
    } -body {
        cffi::memory set $p $type\[2\] [list {} $val]
        cffi::memory get $p $type 1
    } -result $val

    foreach type {string unistring binary} {
        test memory-set-$type-0 "set $type" -setup {
            set p [cffi::memory allocate 8]
        } -cleanup {
            cffi::memory free $p
        } -body {
            cffi::memory set $p $type $testValues($type)
        } -result "Invalid value*" -returnCodes error -match glob
        test memory-get-$type-0 "get $type" -setup {
            set s [cffi::memory fromstring $testValues($type) unicode]
            set p [cffi::memory allocate [dict get [cffi::type info pointer field] Size]]
            cffi::memory set $p pointer $s
        } -cleanup {
            cffi::memory free $s
            cffi::memory free $p
        } -body {
            cffi::memory get $p unistring
        } -result $testValues($type)
    }

    test memory-set-badtype-0 "set bad type" -setup {
        set p [cffi::memory allocate 8]
    } -cleanup {
        cffi::memory free $p
    } -body {
        cffi::memory set $p badtype 0
    } -result {Invalid value "badtype". Invalid base type.} -returnCodes error
    test memory-set-badtype-1 "set bad type - void" -setup {
        set p [cffi::memory allocate 8]
    } -cleanup {
        cffi::memory free $p
    } -body {
        cffi::memory set $p void 0
    } -result {Invalid value "void". The specified type is not valid for the type declaration context.} -returnCodes error

    test memory-get-badtype-0 "get bad type" -setup {
        set p [cffi::memory allocate 8]
    } -cleanup {
        cffi::memory free $p
    } -body {
        cffi::memory get $p badtype
    } -result {Invalid value "badtype". Invalid base type.} -returnCodes error
    test memory-get-badtype-1 "get bad type - void" -setup {
        set p [cffi::memory allocate 8]
    } -cleanup {
        cffi::memory free $p
    } -body {
        cffi::memory get $p void 0
    } -result {Invalid value "void". The specified type is not valid for the type declaration context.} -returnCodes error

    # Error in middle value should not change array
    foreach type [list {*}$numericTypes struct.::StructValue] {
        set arrtype "$type\[3\]"
        set val $testValues($type)
        if {$type in $numericTypes} {
            set anotherval 0
        } else {
            set anotherval {2 3}
        }
        test memory-set-$type-bug128-0 "set $type bad value in array" -setup {
            set p [cffi::memory new $arrtype [list $val $val $val]]
        } -cleanup {
            cffi::memory free $p
        } -body {
            list [cffi::memory get $p $arrtype] \
                [catch {cffi::memory set $p $arrtype [list $anotherval $badValues($type) $val]} errorMsg] \
                [regexp {expected.*but got|Invalid value|missing.*key} $errorMsg] \
                [cffi::memory get $p $arrtype]
        } -result [list [list $val $val $val] 1 1 [list $val $val $val]]
    }
    test memory-set-struct-bug128-1 "set $type bad value in struct" -setup {
        set p [cffi::memory new struct.::StructValue {c 0 i 1}]
    } -cleanup {
        cffi::memory free $p
    } -body {
        list [cffi::memory get $p struct.::StructValue] \
            [catch {cffi::memory set $p struct.::StructValue {c 99 i x}} errorMsg] \
            [regexp {expected.*but got|Invalid value|missing.*key} $errorMsg] \
            [cffi::memory get $p struct.::StructValue]
    } -result [list [list c 0 i 1] 1 1 [list c 0 i 1]]

    ###################################################

    #
    # memory new
    testnumargs memory-new "cffi::memory new" "TYPE INITIALIZER" "?TAG?"

    foreach {type val} [array get testValues] {
        if {$type ni {string unistring binary}} {
            test memory-new-$type-0 "new $type" -cleanup {
                cffi::memory free $p
            } -body {
                set p [cffi::memory new $type $val]
                list [cffi::memory get $p $type] [cffi::pointer isvalid $p] [cffi::pointer tag $p]
            } -result [list $val 1 {}]
            test memory-new-$type-1 "new $type with tag" -cleanup {
                cffi::memory free $p
            } -body {
                set p [cffi::memory new $type $val TAG]
                list [cffi::memory get $p $type] [cffi::pointer isvalid $p] [cffi::pointer tag $p]
            } -result [list $val 1 [namespace current]::TAG]
            test memory-new-$type-2 "new $type with qualified tag" -cleanup {
                cffi::memory free $p
            } -body {
                set p [cffi::memory new $type $val ::ns::TAG]
                list [cffi::memory get $p $type] [cffi::pointer isvalid $p] [cffi::pointer tag $p]
            } -result [list $val 1 ::ns::TAG]
            test memory-new-$type-alias-0 "new $type aliased" -setup {
                cffi::alias clear
                cffi::alias define ALIAS $type
            } -cleanup {
                cffi::alias clear
                cffi::memory free $p
            } -body {
                set p [cffi::memory new ALIAS $val]
                list [cffi::memory get $p $type] [cffi::pointer isvalid $p] [cffi::pointer tag $p]
            } -result [list $val 1 {}]
        }
        if {$type in $numericTypes} {
            test memory-new-$type-array-0 "new $type array" -cleanup {
                cffi::memory free $p
            } -body {
                set p [cffi::memory new $type\[2\] [list 1 $val]]
                cffi::memory get $p $type\[2\]
            } -result [list [expr {$type in $realTypes ? 1.0 : 1}] $val]
            test memory-new-$type-array-1 "new $type array fill extra elements with zeroes" -cleanup {
                cffi::memory free $p
            } -body {
                set p [cffi::memory new $type\[4\] [list 1 $val]]
                cffi::memory get $p $type\[4\]
            } -result [expr {$type in $realTypes? [list 1.0 $val 0.0 0.0] : [list 1 $val 0 0]}]
        }
        if {[info exists badValues($type)]} {
            test memory-new-$type-badvalue-0 "new $type bad value" -body {
                cffi::memory new $type $badValues($type)
            } -result {expected.*but got|Invalid value|missing.*key} -returnCodes error -match regexp
        }
    }
    set type struct.::StructValue
    set val $testValues($type)
    test memory-new-$type-array-0 "new $type array" -cleanup {
        cffi::memory free $p
    } -body {
        set p [cffi::memory new $type\[2\] [list {} $val]]
        cffi::memory get $p $type\[2\]
    } -result [list {c 0 i 0} $val]

    foreach type {string unistring binary} {
        test memory-new-$type-0 "new $type" -body {
            cffi::memory new $type $testValues($type)
        } -result "Invalid value*" -returnCodes error -match glob
    }

    test memory-new-badtype-0 "new bad type" -body {
        cffi::memory new badtype 0
    } -result {Invalid value "badtype". Invalid base type.} -returnCodes error

    test memory-new-badtype-1 "new bad type - void" -body {
        cffi::memory new void 0
    } -result {Invalid value "void". The specified type is not valid for the type declaration context.} -returnCodes error
}

::tcltest::cleanupTests
namespace delete cffi::test
