# (c) 2021 Ashok P. Nadkarni
# See LICENSE for license terms.
#
# This file contains tests pertaining to definition and invocation of functions.

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

namespace eval ${NS}::test {

    proc testnullptr {cmd} {
        test pointer-$cmd-null-0 "pointer $cmd NULL" -body {
            list [catch {cffi::pointer $cmd [makeptr 0]} result] $result $::errorCode
        } -result [list 1 \
                       "Invalid value \"[makeptr 0]\". Pointer is NULL." \
                       [list cffi INVALID_VALUE "Invalid value \"[makeptr 0]\". Pointer is NULL."]]
        test pointer-$cmd-null-1 "pointer $cmd NULL tagged" -body {
            list [catch {cffi::pointer $cmd [makeptr 0 TAG]} result] $result $::errorCode
        } -result [list 1 \
                       "Invalid value \"[makeptr 0 TAG]\". Pointer is NULL." \
                       [list cffi INVALID_VALUE "Invalid value \"[makeptr 0 TAG]\". Pointer is NULL."]]
    }
    proc testbadargs {cmd} {
        test pointer-$cmd-badarg-0 "pointer $cmd non-pointer" -body {
            list [catch {cffi::pointer $cmd abc} result] $result $::errorCode
        } -result [list 1 \
                       "Invalid value \"abc\". Invalid pointer format." \
                       [list cffi INVALID_VALUE "Invalid value \"abc\". Invalid pointer format."]]

        test pointer-$cmd-badarg-1 "pointer $cmd empty string" -body {
            list [catch {cffi::pointer $cmd ""} result] $result $::errorCode
        } -result [list 1 \
                       "Invalid value \"\". Invalid pointer format." \
                       [list cffi INVALID_VALUE "Invalid value \"\". Invalid pointer format."]]

        test pointer-$cmd-numargs-0 "pointer $cmd no args" -body {
            cffi::pointer $cmd
        } -result "wrong # args: should be \"cffi::pointer $cmd POINTER\"" -returnCodes error
        test pointer-$cmd-numargs-1 "pointer $cmd too many args" -body {
            cffi::pointer $cmd 1^ 2^
        } -result "wrong # args: should be \"cffi::pointer $cmd POINTER\"" -returnCodes error
    }

    testsubcmd ::cffi::pointer

    # pointer tag
    testbadargs tag
    test pointer-tag-0 "pointer no tag" -body {
        cffi::pointer tag [makeptr 1]
    } -result ""
    test pointer-tag-1 "pointer tag" -body {
        cffi::pointer tag [makeptr 1 TAG]
    } -result TAG
    test pointer-tag-2 "pointer no tag null pointer " -body {
        cffi::pointer tag [makeptr 0]
    } -result ""
    test pointer-tag-3 "pointer tag null pointer" -body {
        cffi::pointer tag [makeptr 0 TAG]
    } -result TAG

    # pointer check
    testbadargs check
    testnullptr check
    test pointer-check-0 "pointer check fail" -body {
        list [catch {cffi::pointer check [makeptr 1]} result] \
            $result \
            $::errorCode
    } -result "1 {Pointer [makeptr 1] is not registered.} {cffi ERROR {Pointer [makeptr 1] is not registered.}}"

    test pointer-check-1 "pointer check success" -setup {
        set ptr [makeptr 1]
        cffi::pointer safe $ptr
    } -cleanup {
        cffi::pointer dispose $ptr
    } -body {
        cffi::pointer check $ptr
    } -result ""

    test pointer-check-2 "pointer check fail tagged" -body {
        list [catch {cffi::pointer check [makeptr 1 TAG]} result] \
            $result \
            $::errorCode
    } -result "1 {Pointer [makeptr 1 TAG] is not registered.} {cffi ERROR {Pointer [makeptr 1 TAG] is not registered.}}"

    test pointer-check-3 "pointer check success tagged" -setup {
        set ptr [makeptr 1 TAG]
        cffi::pointer safe $ptr
    } -cleanup {
        cffi::pointer dispose $ptr
    } -body {
        cffi::pointer check $ptr
    } -result ""

    test pointer-check-4 "pointer check mismatched tag" -setup {
        set ptr [makeptr 1 TAG]
        cffi::pointer safe $ptr
    } -cleanup {
        cffi::pointer dispose $ptr
    } -body {
        list [catch {cffi::pointer check [makeptr 1 TAG2]} result] \
            $result \
            $::errorCode
    } -result "1 {Value has the wrong type. Pointer tag does not match registered tag.} {cffi WRONG_TYPE {Value has the wrong type. Pointer tag does not match registered tag.}}"

    test pointer-check-5 "pointer check tagged against registered untagged" -setup {
        set ptr [makeptr 1]
        cffi::pointer safe $ptr
    } -cleanup {
        cffi::pointer dispose $ptr
    } -body {
        list [catch {cffi::pointer check [makeptr 1 TAG]} result] \
            $result \
            $::errorCode
    } -result "1 {Value has the wrong type. Pointer tag does not match registered tag.} {cffi WRONG_TYPE {Value has the wrong type. Pointer tag does not match registered tag.}}"

    test pointer-check-6 "pointer check untagged against registered tagged" -setup {
        set ptr [makeptr 1 TAG]
        cffi::pointer safe $ptr
    } -cleanup {
        cffi::pointer dispose $ptr
    } -body {
        cffi::pointer check [makeptr 1]
    } -result ""

    test pointer-check-7 "pointer check null pointer" -body {
        list [catch {cffi::pointer check [makeptr 0]} result] $result $::errorCode
    } -result [list 1 \
                   "Invalid value \"[makeptr 0]\". Pointer is NULL." \
                   [list cffi INVALID_VALUE "Invalid value \"[makeptr 0]\". Pointer is NULL."]]

    test pointer-check-8 "pointer check null tagged pointer" -body {
        list [catch {cffi::pointer check [makeptr 0 TAG]} result] $result $::errorCode
    } -result [list 1 \
                   "Invalid value \"[makeptr 0 TAG]\". Pointer is NULL." \
                   [list cffi INVALID_VALUE "Invalid value \"[makeptr 0 TAG]\". Pointer is NULL."]]

    # pointer isvalid
    testbadargs isvalid
    test pointer-isvalid-0 "pointer isvalid fail" -body {
        cffi::pointer isvalid [makeptr 1]
    } -result 0

    test pointer-isvalid-1 "pointer isvalid success" -setup {
        set ptr [makeptr 1]
        cffi::pointer safe $ptr
    } -cleanup {
        cffi::pointer dispose $ptr
    } -body {
        cffi::pointer isvalid $ptr
    } -result 1

    test pointer-isvalid-2 "pointer isvalid fail tagged" -body {
        cffi::pointer isvalid [makeptr 1 TAG]
    } -result 0

    test pointer-isvalid-3 "pointer isvalid success tagged" -setup {
        set ptr [makeptr 1 TAG]
        cffi::pointer safe $ptr
    } -cleanup {
        cffi::pointer dispose $ptr
    } -body {
        cffi::pointer isvalid $ptr
    } -result 1

    test pointer-isvalid-4 "pointer isvalid mismatched tag" -setup {
        set ptr [makeptr 1 TAG]
        cffi::pointer safe $ptr
    } -cleanup {
        cffi::pointer dispose $ptr
    } -body {
        cffi::pointer isvalid [makeptr 1 TAG2]
    } -result 0

    test pointer-isvalid-5 "pointer isvalid tagged against registered untagged" -setup {
        set ptr [makeptr 1]
        cffi::pointer safe $ptr
    } -cleanup {
        cffi::pointer dispose $ptr
    } -body {
        cffi::pointer isvalid [makeptr 1 TAG]
    } -result 0

    test pointer-isvalid-6 "pointer isvalid untagged against registered tagged" -setup {
        set ptr [makeptr 1 TAG]
        cffi::pointer safe $ptr
    } -cleanup {
        cffi::pointer dispose $ptr
    } -body {
        cffi::pointer isvalid [makeptr 1]
    } -result 1

    test pointer-isvalid-7 "pointer isvalid null pointer" -body {
        cffi::pointer isvalid [makeptr 0]
    } -result 0

    test pointer-isvalid-8 "pointer isvalid null pointer" -body {
        cffi::pointer isvalid [makeptr 0 TAG]
    } -result 0

    ###
    # pointer list

    test pointer-list-numargs-0 "pointer list too many args" -body {
        cffi::pointer list A B
    } -result "wrong # args: should be \"cffi::pointer list ?TAG?\"" -returnCodes error

    test pointer-list-0 "pointer list empty" -body {
        cffi::pointer list
    } -result [list ]

    test pointer-list-1 "pointer list" -setup {
        cffi::pointer safe 1^TAG
        cffi::pointer safe 2^
    } -body {
        list [lsort [cffi::pointer list]] [cffi::pointer dispose 1^TAG] [cffi::pointer dispose 2^] [cffi::pointer list]
    } -result [list [list [makeptr 1 TAG] [makeptr 2]] {} {} {}]

    test pointer-list-2 "pointer list" -setup {
        cffi::pointer safe 1^TAG
        cffi::pointer safe 2^
        cffi::pointer safe 3^BAG
    } -cleanup {
        cffi::pointer dispose 1^TAG
        cffi::pointer dispose 2^
        cffi::pointer dispose 3^BAG
    } -body {
        cffi::pointer list TAG
    } -result [list [makeptr 1 TAG]]

    test pointer-list-3 "pointer list" -setup {
        cffi::pointer safe 1^TAG
    } -cleanup {
        cffi::pointer dispose 1^TAG
    } -body {
        cffi::pointer list TAGX
    } -result [list ]

    ###
    # pointer safe
    testbadargs safe
    testnullptr safe

    test pointer-safe-0 "pointer safe" -body {
        set p [makeptr 1]
        cffi::pointer safe $p
        list [cffi::pointer isvalid $p] [cffi::pointer dispose $p] [cffi::pointer isvalid $p]
    } -result {1 {} 0}
    test pointer-safe-1 "pointer safe tagged" -body {
        set p [makeptr 1 TAG]
        cffi::pointer safe $p
        list [cffi::pointer isvalid $p] [cffi::pointer dispose $p] [cffi::pointer isvalid $p]
    } -result {1 {} 0}
    test pointer-safe-2 "pointer safe dup ok" -body {
        set p [makeptr 1 TAG]
        cffi::pointer safe $p
        list [cffi::pointer isvalid $p] [catch {cffi::pointer safe $p}] [cffi::pointer isvalid $p] [cffi::pointer dispose $p] [cffi::pointer isvalid $p]
    } -result {1 0 1 {} 0}
    test pointer-safe-error-0 "pointer safe after counted" -body {
        set p [makeptr 1 TAG]
        cffi::pointer counted $p
        list [cffi::pointer isvalid $p] [catch {cffi::pointer safe $p} result] [cffi::pointer isvalid $p] [cffi::pointer dispose $p] [cffi::pointer isvalid $p] $result
    } -result [list 1 1 1 {} 0 {Registered counted pointer already exists. Attempt to register an uncounted pointer.}]

    ###
    # pointer counted
    testbadargs counted
    testnullptr counted

    test pointer-counted-0 "pointer counted" -body {
        set p [makeptr 1]
        cffi::pointer counted $p
        cffi::pointer counted $p
        list [cffi::pointer isvalid $p] [cffi::pointer dispose $p] [cffi::pointer isvalid $p] [cffi::pointer dispose $p] [cffi::pointer isvalid $p]
    } -result {1 {} 1 {} 0}
    test pointer-counted-1 "pointer counted tag" -body {
        set p [makeptr 1 TAG]
        cffi::pointer counted $p
        cffi::pointer counted $p
        list [cffi::pointer isvalid $p] [cffi::pointer dispose $p] [cffi::pointer isvalid $p] [cffi::pointer dispose $p] [cffi::pointer isvalid $p]
    } -result {1 {} 1 {} 0}
    test pointer-counted-error-0 "pointer counted after safe" -body {
        set p [makeptr 1 TAG]
        cffi::pointer safe $p
        list [cffi::pointer isvalid $p] [catch {cffi::pointer counted $p} result] [cffi::pointer isvalid $p] [cffi::pointer dispose $p] [cffi::pointer isvalid $p] $result
    } -result [list 1 1 1 {} 0 {Registered uncounted pointer already exists. Attempt to register a counted pointer.}]
    test pointer-counted-error-1 "pointer counted tag conflict" -body {
        set p [makeptr 1 TAG]
        cffi::pointer counted $p
        list [catch {cffi::pointer counted [makeptr 1 TAG2]} result] [cffi::pointer dispose $p] $result
    } -result {1 {} {Value has the wrong type. Pointer tag does not match registered tag.}}

    ###
    # pointer dispose
    testbadargs dispose
    test pointer-dispose-0 "pointer dispose" -body {
        set p [makeptr 1]
        cffi::pointer safe $p
        list [cffi::pointer isvalid $p] [cffi::pointer dispose $p] [cffi::pointer isvalid $p]
    } -result {1 {} 0}
    test pointer-dispose-1 "pointer dispose counted" -body {
        set p [makeptr 1]
        cffi::pointer counted $p
        cffi::pointer counted $p
        list [cffi::pointer isvalid $p] [cffi::pointer dispose $p] [cffi::pointer isvalid $p] [cffi::pointer dispose $p] [cffi::pointer isvalid $p]
    } -result {1 {} 1 {} 0}
    test pointer-dispose-null-0 "pointer dispose NULL pointer" -body {
        set p [makeptr 0]
        cffi::pointer dispose $p
    } -result {}
    test pointer-dispose-null-1 "pointer dispose NULL pointer TAG" -body {
        set p [makeptr 0 TAG]
        cffi::pointer dispose $p
    } -result {}

    ###
    # pointer isnull
    testbadargs isnull
    test pointer-isnull-0 "pointer isnull" -body {
        cffi::pointer isnull [makeptr 0]
    } -result 1
    test pointer-isnull-1 "pointer isnull tagged" -body {
        cffi::pointer isnull [makeptr 0 TAG]
    } -result 1
    test pointer-isnull-2 "pointer isnull nonnull" -body {
        cffi::pointer isnull [makeptr 1]
    } -result 0
    test pointer-isnull-3 "pointer isnull nonnull tagged" -body {
        cffi::pointer isnull [makeptr 1 TAG]
    } -result 0

    ###
    # pointer address
    testbadargs address
    test pointer-address-0 "pointer address" -body {
        cffi::pointer address [makeptr 1]
    } -result [format 0x%.[expr {2 * $::tcl_platform(pointerSize)}]lx 1]
    test pointer-address-1 "pointer address tagged" -body {
        cffi::pointer address [makeptr 1 TAG]
    } -result [format 0x%.[expr {2 * $::tcl_platform(pointerSize)}]lx 1]
    test pointer-address-2 "pointer address nullptr" -body {
        cffi::pointer address [makeptr 0]
    } -result [format 0x%.[expr {2 * $::tcl_platform(pointerSize)}]lx 0]
    test pointer-address-3 "pointer address nullptr tagged" -body {
        cffi::pointer address [makeptr 0 TAG]
    } -result [format 0x%.[expr {2 * $::tcl_platform(pointerSize)}]lx 0]

    ###
    # pointer make
    testnumargs pointer-make "pointer make" "ADDRESS" "?TAG?"
    test pointer-make-0 "make pointer without tag" -body {
        cffi::pointer make 1
    } -result [makeptr 1]
    test pointer-make-1 "make pointer with tag" -body {
        cffi::pointer make 1 TAG
    } -result [scoped_ptr 1 TAG]
    test pointer-make-2 "make NULL pointer - ignore tag" -body {
        cffi::pointer make 0 TAG
    } -result [makeptr 0]
    test pointer-make-3 "make pointer with fqn tag" -body {
        cffi::pointer make 1 ::TAG
    } -result [scoped_ptr 1 ::TAG]

    ###
    # pointer casting
    testnumargs pointer-cast "pointer cast" "POINTER" "?TAG?"
    test pointer-cast-0 "Cast an unsafe pointer to void*" -body {
        list [::cffi::pointer cast [cffi::pointer make 1 TAG]] [::cffi::pointer list]
    } -result [list [makeptr 1] {}]

    test pointer-cast-1 "Cast an safe pointer to void*" -setup {
        set p [cffi::pointer make 1 TAG]
        cffi::pointer safe $p
    } -cleanup {
        cffi::pointer dispose [cffi::pointer make 1]
    } -body {
        list [::cffi::pointer list] [cffi::pointer cast $p] [::cffi::pointer list]
    } -result [list [list [cffi::pointer make 1 TAG]] [cffi::pointer make 1] [list [cffi::pointer make 1]]]

    test pointer-cast-2 "Cast an unsafe pointer from void*" -body {
        list [::cffi::pointer cast [cffi::pointer make 1] TAG] [::cffi::pointer list]
    } -result [list [makeptr 1 [namespace current]::TAG] {}]

    test pointer-cast-3 "Cast an safe pointer from void*" -setup {
        set p [cffi::pointer make 1]
        cffi::pointer safe $p
    } -cleanup {
        cffi::pointer dispose [cffi::pointer make 1 TAG]
    } -body {
        list [::cffi::pointer list] [cffi::pointer cast $p TAG] [::cffi::pointer list]
    } -result [list [list [cffi::pointer make 1]] [cffi::pointer make 1 TAG] [list [cffi::pointer make 1 TAG]]]

    test pointer-cast-4 "Cast a unsafe pointer" -setup {
        set p [cffi::pointer make 1 ::T]
    } -cleanup {
        cffi::pointer uncastable ::T
    } -body {
        list $p [catch {cffi::pointer cast $p ::T2}] [cffi::pointer castable ::T ::T2] [cffi::pointer cast $p ::T2] [cffi::pointer list]
    } -result [list [makeptr 1 ::T] 1 ::T [makeptr 1 ::T2] {}]

    test pointer-cast-5 "Cast unsafe pointers unqualified" -setup {
        set p [cffi::pointer make 1 T]
    } -cleanup {
        cffi::pointer uncastable T
    } -body {
        list $p \
            [catch {cffi::pointer cast $p T2}] \
            [cffi::pointer castable T T2] \
            [set p2 [cffi::pointer cast $p T2]] \
            [set p [cffi::pointer cast $p2 T]] \
            [cffi::pointer list]
    } -result [list [makeptr 1 [namespace current]::T] \
                   1 \
                   [namespace current]::T \
                   [makeptr 1 [namespace current]::T2] \
                   [makeptr 1 [namespace current]::T] \
                   {} \
                  ]
    test pointer-cast-6 "Cast safe pointers unqualified" -setup {
        set p [cffi::pointer make 1 T]
        cffi::pointer safe $p
    } -cleanup {
        cffi::pointer dispose $p
        cffi::pointer uncastable T
    } -body {
        list $p \
            [catch {cffi::pointer cast $p T2}] \
            [cffi::pointer isvalid $p] \
            [cffi::pointer castable T T2] \
            [set p2 [cffi::pointer cast $p T2]] \
            [cffi::pointer isvalid $p] \
            [cffi::pointer isvalid $p2] \
            [set p [cffi::pointer cast $p2 T]] \
            [cffi::pointer list]
    } -result [list [makeptr 1 [namespace current]::T] \
                   1 \
                   1 \
                   [namespace current]::T \
                   [makeptr 1 [namespace current]::T2] \
                   0 \
                   1 \
                   [makeptr 1 [namespace current]::T] \
                   [list [makeptr 1 [namespace current]::T]] \
                  ]

    ###
    # castable tests
    test pointer-castable-0 "Pointer argument castable" -setup {
        testDll function {pointer_to_pointer upcast} {pointer unsafe} {p {pointer.T unsafe}}
        testDll function {pointer_to_pointer downcast} {pointer unsafe} {p {pointer.T2 unsafe}}
    } -cleanup {
        cffi::pointer uncastable T2
    } -body {
        set t [cffi::pointer make 1 T]
        set t2 [cffi::pointer make 1 T2]
        list \
            [upcast $t] \
            [catch {upcast $t2}] \
            [catch {downcast $t}] \
            [cffi::pointer castable T2 T] \
            [cffi::pointer castables] \
            [upcast $t2] \
            [catch {downcast $t}] \
            [cffi::pointer uncastable T2] \
            [cffi::pointer castables]
    } -result [list [makeptr 1] 1 1 [namespace current]::T2 {::cffi::test::T2 ::cffi::test::T} [makeptr 1] 1 {} {}]

    test pointer-castable-1 "Pointer argument castable - void*" -setup {
        testDll function {pointer_to_pointer upcast} {pointer unsafe} {p {pointer unsafe}}
        testDll function {pointer_to_pointer downcast} {pointer unsafe} {p {pointer.T2 unsafe}}
    } -cleanup {
        cffi::pointer uncastable T2
    } -body {
        set t [cffi::pointer make 1]
        set t2 [cffi::pointer make 1 T2]
        list \
            [upcast $t] \
            [upcast $t2] \
            [catch {downcast $t}]
    } -result [list [makeptr 1] [makeptr 1] 1]

    test pointer-castable-2 "Pointer field castable" -setup {
        cffi::Struct create S {p {pointer.::T unsafe}}
    } -cleanup {
        S free $s
        S free $s2
    } -body {
        list \
            [catch {S new [list p [makeptr 1 ::T]]} s] \
            [catch {S new [makeptr 1 ::T2]}] \
            [cffi::pointer castable ::T2 ::T] \
            [catch {S new [list p [makeptr 1 ::T2]]} s2] \
    } -result [list 0 1 ::T2 0]

    test pointer-castable-3 "Pointer field castable to void*" -setup {
        cffi::Struct create S {p {pointer unsafe}}
    } -cleanup {
        S free $s
    } -body {
            catch {S new [list p [makeptr 1 ::T]]} s
    } -result 0

    test pointer-castable-4 "Pointer field castable from void*" -setup {
        cffi::Struct create S {p {pointer.::T unsafe}}
    } -body {
        S new [list p [makeptr 1]]
    } -result "Value*has the wrong type. Pointer type mismatch.*" -match glob -returnCodes error
}

::tcltest::cleanupTests
namespace delete ${NS}::test
