Overview
Comment: | Cleaned up some return code handling, and added test for binary blobs |
---|---|
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
1c563bb7690b6c1186ac4959e64c8be1 |
User & Date: | rkeene on 2014-07-16 16:26:00 |
Other Links: | manifest | tags |
Context
2014-07-16
| ||
18:02 | Updated comments check-in: bb7a68b1e7 user: rkeene tags: trunk | |
16:26 | Cleaned up some return code handling, and added test for binary blobs check-in: 1c563bb769 user: rkeene tags: trunk | |
16:15 | Corrected issue with checking for variables check-in: 37f218e272 user: rkeene tags: trunk | |
Changes
Modified tcc4tcl.tcl from [f995e1562e] to [5e15b1175b].
︙ | ︙ | |||
174 175 176 177 178 179 180 181 182 183 184 185 186 187 | } if {[llength $adefs_c] == 0} { set adefs_c "void" } else { set adefs_c [join $adefs_c {, }] } # Determine how to return in failure if {$rtype != "void"} { if {[info exists returnErrorValue]} { set return_failure "return(${returnErrorValue})" } else { switch -- $rtype { | > > > > > > > > > > | 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 | } if {[llength $adefs_c] == 0} { set adefs_c "void" } else { set adefs_c [join $adefs_c {, }] } # Determine actual C return type: switch -- $rtype { "ok" { set rtype_c "int" } default { set rtype_c $rtype } } # Determine how to return in failure if {$rtype != "void"} { if {[info exists returnErrorValue]} { set return_failure "return(${returnErrorValue})" } else { switch -- $rtype { |
︙ | ︙ | |||
200 201 202 203 204 205 206 | } } } else { set return_failure "return" } # Define the C function | | | | 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 | } } } else { set return_failure "return" } # Define the C function _ccode $handle "$rtype_c $cname\($adefs_c) \{" ## Define the Tcl return value checking variable _ccode $handle " int tclrv;" ## If the interpreters return value is relevant, create a variable to store it if {$rtype != "ok" && $rtype != "void"} { _ccode $handle " Tcl_Obj *rv_interp;" } ## If we are returning a value, declare a variable for that if {$rtype != "void"} { _ccode $handle " $rtype_c rv;" } ## If we need to create a new interpreter, do so if {$newInterp} { set interp_name "ip" _ccode $handle " Tcl_Interp *${interp_name};" } |
︙ | ︙ | |||
316 317 318 319 320 321 322 | if {$rtype != "ok" && $rtype != "void"} { _ccode $handle " rv_interp = Tcl_GetObjResult(${interp_name});" } switch -- $rtype { void { } ok { | | | 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 | if {$rtype != "ok" && $rtype != "void"} { _ccode $handle " rv_interp = Tcl_GetObjResult(${interp_name});" } switch -- $rtype { void { } ok { _ccode $handle " rv = TCL_OK;" } int { _ccode $handle " if (Tcl_GetIntFromObj(ip, rv_interp, &rv) != TCL_OK) $return_failure;" } long { _ccode $handle " if (Tcl_GetLongFromObj(ip, rv_interp, &rv) != TCL_OK) $return_failure;" } |
︙ | ︙ |
Modified test.tcl from [635afa0e0c] to [6b2efca164].
︙ | ︙ | |||
167 168 169 170 171 172 173 | } $handle cwrap callToTcl1 {int x} float $handle go puts [callToTcl1 3] set handle [tcc4tcl::new] $handle proc callToTclBinary {char* blob int blob_Length} ok { | | > > > > > > | 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 | } $handle cwrap callToTcl1 {int x} float $handle go puts [callToTcl1 3] set handle [tcc4tcl::new] $handle proc callToTclBinary {char* blob int blob_Length} ok { puts "Blob: $blob ([string length $blob])" } $handle cproc callToTclBinaryWrapper {} void { callToTclBinary("test\x00test", 9); } puts [$handle code] $handle go callToTclBinaryWrapper |