Overview
| Comment: | Updated to treat NULL return values as errors from most types of return types |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
fbca0aea0cbe4a57a253fef1ddb84731 |
| User & Date: | rkeene on 2014-06-17 16:56:08 |
| Other Links: | manifest | tags |
Context
|
2014-06-18
| ||
| 04:45 | Rewrote high-level API to support a handle-based interface check-in: daa895fdb4 user: rkeene tags: trunk | |
|
2014-06-17
| ||
| 16:56 | Updated to treat NULL return values as errors from most types of return types check-in: fbca0aea0c user: rkeene tags: trunk | |
| 16:42 | Updated to include a more reliable test for "mkdir" check-in: a4245ab3df user: rkeene tags: trunk | |
Changes
Modified tcc4tcl.tcl from [7f2fbfc8a7] to [cb9913280b].
| ︙ | ︙ | |||
308 309 310 311 312 313 314 315 316 317 318 319 320 321 |
# double
# char* (TCL_STATIC char*)
# string (TCL_DYNAMIC char*)
# dstring (TCL_DYNAMIC char*)
# vstring (TCL_VOLATILE char*)
# default (Tcl_Obj*)
# wide
switch -- $rtype {
void { }
ok { append cbody " return rv;" "\n" }
int { append cbody " Tcl_SetIntObj(Tcl_GetObjResult(ip), rv);" "\n" }
long { append cbody " Tcl_SetLongObj(Tcl_GetObjResult(ip), rv);" "\n" }
float -
double { append cbody " Tcl_SetDoubleObj(Tcl_GetObjResult(ip), rv);" "\n" }
| > > > > > > > > > | 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 |
# double
# char* (TCL_STATIC char*)
# string (TCL_DYNAMIC char*)
# dstring (TCL_DYNAMIC char*)
# vstring (TCL_VOLATILE char*)
# default (Tcl_Obj*)
# wide
switch -- $rtype {
void - ok - int - long - float - double - wide {}
default {
append cbody " if (rv == NULL) {\n"
append cbody " return(TCL_ERROR);\n"
append cbody " }\n"
}
}
switch -- $rtype {
void { }
ok { append cbody " return rv;" "\n" }
int { append cbody " Tcl_SetIntObj(Tcl_GetObjResult(ip), rv);" "\n" }
long { append cbody " Tcl_SetLongObj(Tcl_GetObjResult(ip), rv);" "\n" }
float -
double { append cbody " Tcl_SetDoubleObj(Tcl_GetObjResult(ip), rv);" "\n" }
|
| ︙ | ︙ |
Modified test from [e33a20cdc2] to [22ae724521].
| ︙ | ︙ | |||
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
if (mkdir_ret != 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("failed", -1));
return(TCL_ERROR);
};
return(TCL_OK);
}
puts [test 1]
puts [test1 1]
puts [test3 1]
puts [::bob::test1 1]
puts [add [test 1] 1]
catch {
puts [mkdir "/"]
} err
if {$err != "failed"} {
error "\[mkdir\] did not return the expected error"
}
| > > > > > > > > > > > > > > > > > > | 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 |
if (mkdir_ret != 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("failed", -1));
return(TCL_ERROR);
};
return(TCL_OK);
}
# Return error on NULL
tcc4tcl::cproc test4 {int v} char* {
if (v == 1) {
return("ok");
}
return(NULL);
}
puts [test 1]
puts [test1 1]
puts [test3 1]
puts [::bob::test1 1]
puts [add [test 1] 1]
puts [test4 1]
catch {
puts [mkdir "/"]
} err
if {$err != "failed"} {
error "\[mkdir\] did not return the expected error"
}
catch {
set v 0
puts [test4 0]
set v 1
} err
if {$err != "" || $v == 1} {
error "\[test4\] did not return the expected error"
}
|