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