Overview
| Comment: | Improved error handling |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
92a72f9f803d9883460c6ad2bfb069b9 |
| User & Date: | rkeene on 2014-06-15 20:06:39 |
| Other Links: | manifest | tags |
Context
|
2014-06-15
| ||
| 20:08 | Added test case for multiple arguments check-in: f2439e25b6 user: rkeene tags: trunk | |
| 20:06 | Improved error handling check-in: 92a72f9f80 user: rkeene tags: trunk | |
| 19:56 | Cleanup check-in: a972717fe8 user: rkeene tags: trunk | |
Changes
Modified tcc4tcl.tcl from [24323fece8] to [c5d45f5bb2].
| ︙ | ︙ | |||
107 108 109 110 111 112 113 114 115 116 117 118 119 120 |
proc ::tcc4tcl::ccode {code} {
variable tcc
Log "INJECTING CCODE"
append tcc(code) $code \n
}
proc ::tcc4tcl::cc {code} {
variable tcc
if {![info exists tcc(cc)]} {
set tcc(cc) [::tcc4tcl::new]
}
| > < | 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 |
proc ::tcc4tcl::ccode {code} {
variable tcc
Log "INJECTING CCODE"
append tcc(code) $code \n
}
proc ::tcc4tcl::cc {code} {
variable tcc
if {![info exists tcc(cc)]} {
set tcc(cc) [::tcc4tcl::new]
}
$tcc(cc) compile $code
}
#----------------------------------------------------------- New DLL API
namespace eval ::tcc4tcl::dll {}
proc ::tcc4tcl::dll {{name ""}} {
variable count
|
| ︙ | ︙ | |||
447 448 449 450 451 452 453 |
set cname Cmd_N${id}_[cleanname $procname]
set code ""
if {[info exists tcc(tk)] && $tcc(tk)} {
append code "\#include <tk.h>" "\n"
}
| | > > | > > > > > > > > | 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 |
set cname Cmd_N${id}_[cleanname $procname]
set code ""
if {[info exists tcc(tk)] && $tcc(tk)} {
append code "\#include <tk.h>" "\n"
}
if {[info exists tcc(code)]} {
append code $tcc(code)
append code "\n"
}
set tcc(code) ""
append code "int $cname (ClientData $v(clientdata),Tcl_Interp *$v(interp),"
append code "int $v(objc),Tcl_Obj *CONST $v(objv)\[\]) {" "\n"
append code [lindex $args end] "\n"
append code "}" "\n"
if {[catch {
uplevel 1 [list tcc4tcl::cc $code]
} err]} {
unset tcc(cc)
tcc4tcl::reset
return -code error $err
}
Log "CREATING TCL COMMAND $procname / $cname"
uplevel 1 [list $tcc(cc) command $procname $cname]
unset tcc(cc) ;# can't be used for compiling anymore
tcc4tcl::reset
}
proc ::tcc4tcl::tk {args} {
variable tcc
set tcc(tk) 1
}
::tcc4tcl::reset
namespace eval tcc4tcl {namespace export cproc ccode cdata}
|
Modified test from [67f0fe4037] to [8ffdbeb52f].
1 2 3 4 5 6 7 8 9 10 |
#! /usr/bin/env tclsh
lappend auto_path [lindex $argv 0]
package require tcc4tcl
tcc4tcl::cproc test {int i} int { return(i+42); }
tcc4tcl::cproc test1 {int i} int { return(i+42); }
tcc4tcl::cproc ::bob::test1 {int i} int { return(i+42); }
puts [test 1]
| > > > > > > > > | > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
#! /usr/bin/env tclsh
lappend auto_path [lindex $argv 0]
package require tcc4tcl
tcc4tcl::cproc test {int i} int { return(i+42); }
tcc4tcl::cproc test1 {int i} int { return(i+42); }
tcc4tcl::cproc ::bob::test1 {int i} int { return(i+42); }
# This will fail
catch {
tcc4tcl::cproc test2 {int i} int { badcode; }
}
# This should work
tcc4tcl::cproc test3 {int i} int { return(i+42); }
puts [test 1]
puts [test1 1]
puts [test3 1]
puts [::bob::test1 1]
|