1#
2# ffidl testing - test ability to
3# define, call, and get sensible
4# values from the routines defined
5# in ffidl_test.c
6# arguments won't have the same values
7#
8
9if {[lsearch [namespace children] ::tcltest] == -1} {
10    package require tcltest
11    namespace import -force ::tcltest::*
12}
13
14package require Ffidl
15package require Ffidlrt
16set lib [::ffidl::find-lib ffidl_test]
17
18test ffidl-basic {ffidl basic tests} {} {
19    set msg ""
20    
21    ::ffidl::callout ffidl_test_signatures {} pointer-utf8 [::ffidl::symbol $lib ffidl_test_signatures]
22    ::ffidl::typedef ffidl_test_struct {signed char} {short} {int} {long} {long long} float double pointer \
23        {unsigned char} {unsigned char} {unsigned char} {unsigned char} {unsigned char} {unsigned char} {unsigned char} {unsigned char}
24    
25    array set types {
26        void void
27        int int
28        float float
29        double double
30        {long double} {long double}
31        {signed char} {signed char}
32        {unsigned char} {unsigned char}
33        {signed short} {short}
34        {unsigned short} {unsigned short}
35        {signed int} {int}
36        {unsigned int} {unsigned}
37        {signed long} {long}
38        {unsigned long} {unsigned long}
39        {signed long long} {long long}
40        {unsigned long long} {unsigned long long}
41        {void *} pointer
42        ffidl_test_struct ffidl_test_struct
43    }
44    
45    if { ! [::ffidl::info have-long-double]} {
46        unset {types(long double)}
47    }
48    if { ! [::ffidl::info have-long-long]} {
49        unset {types(signed long long)}
50        unset {types(long long)}
51        unset {types(unsigned long long)}
52    }
53        
54    foreach sig [split [string trim [ffidl_test_signatures]] \n] {
55        if {[catch {
56            if { ! [regexp {^([a-z_ ]+) (\*?)([a-z0-9_]+)\((.*)\)$} $sig all rtype rptr name args]} {
57                append msg "malformed signature: $sig" "\n"
58                error ""
59            }
60            if {[catch {::ffidl::symbol $lib $name} addr]} {
61                append msg "function is not defined in \"$lib\": \"$name\"\n$addr" "\n"
62                error ""
63            }
64            set argout {}
65            set argsize {}
66            foreach atype [split $args ,] {
67                set atype [string trim $atype]
68                if { ! [info exists types($atype)]} {
69                    append msg "no type map for: $atype" "\n"
70                    error ""
71                }
72                lappend argout $types($atype)
73                lappend argsize [::ffidl::info sizeof $types($atype)]
74            }
75            if {[string length $rptr] != 0} {
76                set rtype "$rtype $rptr"
77            }
78            set rtype [string trim $rtype]
79            if { ! [info exists types($rtype)]} {
80                append msg "no type map for: $rtype" "\n"
81                error ""
82            }
83        }]} {
84            continue
85        }
86        set retout $types($rtype)
87        set retsize [::ffidl::info sizeof $types($rtype)]
88        ::ffidl::callout $name $argout $retout $addr
89        switch -regexp $name {
90            ^ffidl_fill_struct$ {
91                if {[catch {$name} r]} {
92                    append msg "catch {$name} r, sig $sig, error $r" "\n"
93                } else {
94                    binary scan $r [::ffidl::info format ffidl_test_struct] \
95                        v_schar v_sshort v_sint v_slong v_slonglong v_float v_double v_pointer \
96                        v_bytes0 v_bytes1 v_bytes2 v_bytes3 v_bytes4 v_bytes5 v_bytes6 v_bytes7
97                    #append msg "$name: $v_schar $v_sshort $v_sint $v_slong $v_slonglong $v_float $v_double $v_pointer" "\n"
98                    #append msg "	$v_bytes0 $v_bytes1 $v_bytes2 $v_bytes3 $v_bytes4 $v_bytes5 $v_bytes6 $v_bytes7" "\n"
99                    if {$v_schar != 1
100                        || $v_sshort != 2
101                        || $v_sint != 3
102                        || $v_slong != 4
103                        || $v_slonglong != 5
104                        || $v_float != 6
105                        || $v_double != 7
106                        || $v_pointer != 8
107                        || $v_bytes0 != 48
108                        || $v_bytes1 != 49
109                        || $v_bytes2 != 50
110                        || $v_bytes3 != 51
111                        || $v_bytes4 != 52
112                        || $v_bytes5 != 53
113                        || $v_bytes6 != 54
114                        || $v_bytes7 != 0    
115                    } {
116                        append msg "scalar value error in ffidl_fill_struct" "\n"
117                    }
118                }
119            }
120            ^ffidl_struct_to_struct$ {
121                set a [binary format [::ffidl::info format ffidl_test_struct] 1 2 3 4 5 6 7 8 48 49 50 51 52 53 54 0]
122                binary scan $a [::ffidl::info format ffidl_test_struct] \
123                    v_schar v_sshort v_sint v_slong v_slonglong v_float v_double v_pointer \
124                    v_bytes0 v_bytes1 v_bytes2 v_bytes3 v_bytes4 v_bytes5 v_bytes6 v_bytes7
125                #append msg "arg: $v_schar $v_sshort $v_sint $v_slong $v_slonglong $v_float $v_double $v_pointer" "\n"
126                #append msg "	$v_bytes0 $v_bytes1 $v_bytes2 $v_bytes3 $v_bytes4 $v_bytes5 $v_bytes6 $v_bytes7" "\n"
127                if {[catch {$name $a} r]} {
128                    append msg "catch {$name $a} r, sig $sig, error $r" "\n"
129                } else {
130                    binary scan $r [::ffidl::info format ffidl_test_struct] \
131                        v_schar v_sshort v_sint v_slong v_slonglong v_float v_double v_pointer \
132                        v_bytes0 v_bytes1 v_bytes2 v_bytes3 v_bytes4 v_bytes5 v_bytes6 v_bytes7
133                    #append msg "$name: $v_schar $v_sshort $v_sint $v_slong $v_slonglong $v_float $v_double $v_pointer" "\n"
134                    #append msg "	$v_bytes0 $v_bytes1 $v_bytes2 $v_bytes3 $v_bytes4 $v_bytes5 $v_bytes6 $v_bytes7" "\n"
135                    if {$v_schar != 1
136                        || $v_sshort != 2
137                        || $v_sint != 3
138                        || $v_slong != 4
139                        || $v_slonglong != 5
140                        || $v_float != 6
141                        || $v_double != 7
142                        || $v_pointer != 8
143                        || $v_bytes0 != 48
144                        || $v_bytes1 != 49
145                        || $v_bytes2 != 50
146                        || $v_bytes3 != 51
147                        || $v_bytes4 != 52
148                        || $v_bytes5 != 53
149                        || $v_bytes6 != 54
150                        || $v_bytes7 != 0    
151                    } {
152                        append msg "scalar value error in ffidl_struct_to_struct" "\n"
153                    }
154                }
155            }
156            ^ffidl_.*_to_void$ {
157                # numerics to void
158                if {[catch {$name 123} r]} {
159                    append msg "catch {$name 123} r, sig $sig, returned $r" "\n"
160                } elseif {[string compare $r {}] != 0} {
161                    append msg "$name returned $r instead of {}" "\n"
162                }
163            }
164            ^.*$ {
165                # pure numerics
166                if {[catch {$name 123} r]} {
167                    append msg "catch {$name 123} r, sig $sig, returned $r" "\n"
168                } elseif {$r != 123} {
169                    append msg "$name 123, sig $sig, returned $r" "\n"
170                }
171            }
172        }
173    }
174    set msg
175} {}
176
177# cleanup
178::tcltest::cleanupTests
179return
180