Check-in [92a72f9f80]
Overview
Comment:Improved error handling
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 92a72f9f803d9883460c6ad2bfb069b9f8847e8b
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    107   proc ::tcc4tcl::ccode {code} {
   108    108   	variable tcc
   109    109   
   110    110   	Log "INJECTING CCODE"
   111    111   
   112    112   	append tcc(code) $code \n
   113    113   }
          114  +
   114    115   proc ::tcc4tcl::cc {code} {
   115    116   	variable tcc
   116    117   
   117    118   	if {![info exists tcc(cc)]} {
   118    119   		set tcc(cc) [::tcc4tcl::new]
   119    120   	}
   120    121   
   121         -	Log code:$code
   122    122   	$tcc(cc) compile $code
   123    123   }
   124    124   
   125    125   #----------------------------------------------------------- New DLL API
   126    126   namespace eval ::tcc4tcl::dll {}
   127    127   proc ::tcc4tcl::dll {{name ""}} {
   128    128   	variable count
................................................................................
   447    447   	set cname Cmd_N${id}_[cleanname $procname]
   448    448   	set code ""
   449    449   
   450    450   	if {[info exists tcc(tk)] && $tcc(tk)} {
   451    451   		append code "\#include <tk.h>" "\n"
   452    452   	}
   453    453   
   454         -	if {[info exists tcc(code)] && [string length $tcc(code)]>0} {
          454  +	if {[info exists tcc(code)]} {
   455    455   		append code $tcc(code)
   456    456   		append code "\n"
   457    457   	}
          458  +	set tcc(code) ""
   458    459   
   459    460   	append code "int $cname (ClientData $v(clientdata),Tcl_Interp *$v(interp),"
   460    461   	append code "int $v(objc),Tcl_Obj *CONST $v(objv)\[\]) {" "\n"
   461    462   	append code [lindex $args end] "\n"
   462    463   	append code "}" "\n"
   463    464   
   464         -	uplevel 1 [list tcc4tcl::cc $code]
          465  +	if {[catch {
          466  +		uplevel 1 [list tcc4tcl::cc $code]
          467  +	} err]} {
          468  +		unset tcc(cc)
          469  +		tcc4tcl::reset
          470  +
          471  +		return -code error $err
          472  +	}
   465    473   
   466    474   	Log "CREATING TCL COMMAND $procname / $cname"
   467    475   	uplevel 1 [list $tcc(cc) command $procname $cname]
          476  +
   468    477   	unset tcc(cc) ;# can't be used for compiling anymore
          478  +	tcc4tcl::reset
   469    479   }
   470    480   
   471    481   proc ::tcc4tcl::tk {args} {
   472    482   	variable tcc
   473    483   	set tcc(tk) 1
   474    484   }
   475    485   
   476    486   ::tcc4tcl::reset
   477    487   namespace eval tcc4tcl {namespace export cproc ccode cdata}

Modified test from [67f0fe4037] to [8ffdbeb52f].

     3      3   lappend auto_path [lindex $argv 0]
     4      4   package require tcc4tcl
     5      5   
     6      6   tcc4tcl::cproc test {int i} int { return(i+42); }
     7      7   tcc4tcl::cproc test1 {int i} int { return(i+42); }
     8      8   tcc4tcl::cproc ::bob::test1 {int i} int { return(i+42); }
     9      9   
           10  +# This will fail
           11  +catch {
           12  +	tcc4tcl::cproc test2 {int i} int { badcode; }
           13  +}
           14  +
           15  +# This should work
           16  +tcc4tcl::cproc test3 {int i} int { return(i+42); }
           17  +
    10     18   puts [test 1]
    11         -puts [::test1 1]
           19  +puts [test1 1]
           20  +puts [test3 1]
    12     21   puts [::bob::test1 1]