#
# ffidl testing - test ability to
# define, call, and get sensible
# values from the routines defined
# in ffidl_test.c
# arguments won't have the same values
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

package require Ffidl
package require Ffidlrt
set lib [::ffidl::find-lib ffidl_test]

test ffidl-basic {ffidl basic tests} {} {
    set msg ""
    
    ::ffidl::callout ffidl_test_signatures {} pointer-utf8 [::ffidl::symbol $lib ffidl_test_signatures]
    ::ffidl::typedef ffidl_test_struct \
	{signed char} \
	short \
	int \
	long \
	float \
	double \
	pointer \
        {unsigned char} {unsigned char} {unsigned char} {unsigned char} \
	{unsigned char} {unsigned char} {unsigned char} {unsigned char}
    
    array set types {
        void void
        int int
        float float
        double double
        {long double} {long double}
        {signed char} {signed char}
        {unsigned char} {unsigned char}
        {signed short} {short}
        {unsigned short} {unsigned short}
        {signed int} {int}
        {unsigned int} {unsigned}
        {signed long} {long}
        {unsigned long} {unsigned long}
        {signed long long} {long long}
        {unsigned long long} {unsigned long long}
        {void *} pointer
        ffidl_test_struct ffidl_test_struct
    }
    
    if { ! [::ffidl::info have-long-double]} {
        unset {types(long double)}
    }
    if { ! [::ffidl::info have-long-long]} {
        unset {types(signed long long)}
        unset {types(long long)}
        unset {types(unsigned long long)}
    }
        
    foreach sig [split [string trim [ffidl_test_signatures]] \n] {
        if {[catch {
            if { ! [regexp {^([a-z_ ]+) (\*?)([a-z0-9_]+)\((.*)\)$} $sig all rtype rptr name args]} {
                append msg "malformed signature: $sig" "\n"
                error ""
            }
            if {[catch {::ffidl::symbol $lib $name} addr]} {
                append msg "function is not defined in \"$lib\": \"$name\"\n$addr" "\n"
                error ""
            }
            set argout {}
            set argsize {}
            foreach atype [split $args ,] {
                set atype [string trim $atype]
                if { ! [info exists types($atype)]} {
                    #append msg "no type map for: $atype" "\n"
                    error ""
                }
                lappend argout $types($atype)
                lappend argsize [::ffidl::info sizeof $types($atype)]
            }
            if {[string length $rptr] != 0} {
                set rtype "$rtype $rptr"
            }
            set rtype [string trim $rtype]
            if { ! [info exists types($rtype)]} {
                #append msg "no type map for: $rtype" "\n"
                error ""
            }
        }]} {
            continue
        }
        set retout $types($rtype)
        set retsize [::ffidl::info sizeof $types($rtype)]
        ::ffidl::callout $name $argout $retout $addr
        switch -regexp $name {
            ^ffidl_fill_struct$ {
                if {[catch {$name} r]} {
                    append msg "catch {$name} r, sig $sig, error $r" "\n"
                } else {
                    binary scan $r [::ffidl::info format ffidl_test_struct] \
                        v_schar v_sshort v_sint v_slong v_float v_double v_pointer \
                        v_bytes0 v_bytes1 v_bytes2 v_bytes3 v_bytes4 v_bytes5 v_bytes6 v_bytes7
                    #append msg "$name: $v_schar $v_sshort $v_sint $v_slong $v_float $v_double $v_pointer" "\n"
                    #append msg "	$v_bytes0 $v_bytes1 $v_bytes2 $v_bytes3 $v_bytes4 $v_bytes5 $v_bytes6 $v_bytes7" "\n"
                    if {$v_schar != 1
                        || $v_sshort != 2
                        || $v_sint != 3
                        || $v_slong != 4
                        || $v_float != 5
                        || $v_double != 6
                        || $v_pointer != 7
                        || $v_bytes0 != 48
                        || $v_bytes1 != 49
                        || $v_bytes2 != 50
                        || $v_bytes3 != 51
                        || $v_bytes4 != 52
                        || $v_bytes5 != 53
                        || $v_bytes6 != 54
                        || $v_bytes7 != 0    
                    } {
                        append msg "scalar value error in ffidl_fill_struct" "\n"
                    }
                }
            }
            ^ffidl_struct_to_struct$ {
                set a [binary format [::ffidl::info format ffidl_test_struct] 1 2 3 4 5 6 7 48 49 50 51 52 53 54 0]
                binary scan $a [::ffidl::info format ffidl_test_struct] \
                    v_schar v_sshort v_sint v_slong v_float v_double v_pointer \
                    v_bytes0 v_bytes1 v_bytes2 v_bytes3 v_bytes4 v_bytes5 v_bytes6 v_bytes7
                #append msg "arg: $v_schar $v_sshort $v_sint $v_slong $v_float $v_double $v_pointer" "\n"
                #append msg "	$v_bytes0 $v_bytes1 $v_bytes2 $v_bytes3 $v_bytes4 $v_bytes5 $v_bytes6 $v_bytes7" "\n"
                if {[catch {$name $a} r]} {
                    append msg "catch {$name 123} r, sig $sig, error $r" "\n"
                } else {
                    binary scan $r [::ffidl::info format ffidl_test_struct] \
                        v_schar v_sshort v_sint v_slong v_float v_double v_pointer \
                        v_bytes0 v_bytes1 v_bytes2 v_bytes3 v_bytes4 v_bytes5 v_bytes6 v_bytes7
                    #append msg "$name: $v_schar $v_sshort $v_sint $v_slong $v_float $v_double $v_pointer" "\n"
                    #append msg "	$v_bytes0 $v_bytes1 $v_bytes2 $v_bytes3 $v_bytes4 $v_bytes5 $v_bytes6 $v_bytes7" "\n"
                    if {$v_schar != 1
                        || $v_sshort != 2
                        || $v_sint != 3
                        || $v_slong != 4
                        || $v_float != 5
                        || $v_double != 6
                        || $v_pointer != 7
                        || $v_bytes0 != 48
                        || $v_bytes1 != 49
                        || $v_bytes2 != 50
                        || $v_bytes3 != 51
                        || $v_bytes4 != 52
                        || $v_bytes5 != 53
                        || $v_bytes6 != 54
                        || $v_bytes7 != 0    
                    } {
                        append msg "scalar value error in ffidl_struct_to_struct" "\n"
                    }
                }
            }
            ^ffidl_.*_to_void$ {
                # numerics to void
                if {[catch {$name 123} r]} {
                    append msg "catch {$name 123} r, sig $sig, returned $r" "\n"
                } elseif {[string compare $r {}] != 0} {
                    append msg "$name returned $r instead of {}" "\n"
                }
            }
            ^.*$ {
                # pure numerics
                if {[catch {$name 123} r]} {
                    append msg "catch {$name 123} r, sig $sig, returned $r" "\n"
                } elseif {$r != 123} {
                    append msg "$name 123, sig $sig, returned $r" "\n"
                }
            }
        }
    }
    set msg
} {}

# Sanity check
test ffidl-info-alignof {ffidl::info alignof test} {} {
    ffidl::info alignof char
} 1

# Sanity check
test ffidl-info-format {ffidl::info format test} {} {
    ffidl::info format char
} c

# Sanity check
test ffidl-info-format {ffidl::info sizeof test} {} {
    ffidl::info sizeof char
} 1

test ffidl-info-callbacks {ffidl::info callbacks tests} {} {
    if {[::ffidl::info use-callbacks]} {
	set cbs1 [::ffidl::info callbacks];
	set cbname ::ffidl-info-callbacks;
	::ffidl::callback $cbname {} void;
	set cbs2 [::ffidl::info callbacks];
	expr {$cbname ni $cbs1 && $cbname in $cbs2}
    } else {
	return 1;
    }
} 1

test ffidl-info-callouts {ffidl::info callouts tests} {} {
    set cos1 [ffidl::info callouts];
    set cname ::ffidl-info-callouts;
    ::ffidl::callout $cname {} void 0;
    set cos2 [ffidl::info callouts];
    expr {$cname ni $cos1 && $cname in $cos2}
} 1

test ffidl-info-libraries {ffidl::info libraries tests} {} {
    # Not a great test: make sure the test library is loaded.
    if {$lib ni [::ffidl::info libraries]} {
	ffidl::library $lib;
    }
    expr {$lib in [::ffidl::info libraries]}
} 1

test ffidl-info-signatures {ffidl::info signatures tests} {} {
    # Add a new type and a callout using it, then check that there is a
    # signature with that type.
    set tname ffidl-info-signatures-type;
    set cname ::ffidl-info-signatures-callout;
    ::ffidl::typedef $tname char;
    ::ffidl::callout $cname [list $tname] $tname 0;
    set sig "${tname}(${tname})";
    expr {$sig in [::ffidl::info signatures]};
} 1

test ffidl-info-typedefs {ffidl::info typedefs tests} {} {
    set tname ffidl-info-typedefs;
    ffidl::typedef $tname char;
    expr {$tname in [ffidl::info typedefs]};
} 1

# Check they don't error.
test ffidl-info-flags {ffidl::info flags tests} {} {
    foreach flag {
	"have-int64"
	"have-long-double"
	"have-long-long"
	"use-callbacks"
	"use-ffcall"
	"use-libffcall"
	"use-libffi"
	"use-libffi-raw"
	"canonical-host"
    } {
	ffidl::info $flag;
    }
    return "";
} {}

# Check they return pointers.
test ffidl-info-poi {ffidl::info pointers tests} {} {
    foreach poi {
	"interp"
	"NULL"
    } {
	set ptr [::ffidl::info $poi];
	if {![string is wideinteger -strict $ptr]} {
	    error "invalid value returned by ::ffidl::info $poi: $ptr";
	}
    }
    return "";
} {}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:
