diff options
author | dkf <dkf@noemail.net> | 2008-10-31 22:08:31 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2008-10-31 22:08:31 (GMT) |
commit | 3c93321249970564737718ffc5993c5d8ce46020 (patch) | |
tree | 48e83fa4c090195326480154283f0888f703a276 /generic/tclOO.c | |
parent | 7a7edf82d3d4faf5b2c056a7c5e5865a97d8bdd8 (diff) | |
download | tcl-3c93321249970564737718ffc5993c5d8ce46020.zip tcl-3c93321249970564737718ffc5993c5d8ce46020.tar.gz tcl-3c93321249970564737718ffc5993c5d8ce46020.tar.bz2 |
Fix [Bug 2200824] and make class constructor error handling much more robust.
FossilOrigin-Name: c8dd022f7e09fd76778993ccb2afd93d8089305a
Diffstat (limited to 'generic/tclOO.c')
-rw-r--r-- | generic/tclOO.c | 18 |
1 files changed, 12 insertions, 6 deletions
diff --git a/generic/tclOO.c b/generic/tclOO.c index 11a7cbd..e161563 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclOO.c,v 1.17 2008/09/23 05:05:48 dkf Exp $ + * RCS: @(#) $Id: tclOO.c,v 1.18 2008/10/31 22:08:32 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -246,6 +246,8 @@ InitFoundation( Tcl_IncrRefCount(fPtr->unknownMethodNameObj); Tcl_IncrRefCount(fPtr->constructorName); Tcl_IncrRefCount(fPtr->destructorName); + Tcl_NRCreateCommand(interp, "::oo::UpCatch", TclOOUpcatchCmd, + TclOONRUpcatch, NULL, NULL); Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition", TclOOUnknownDefinition, NULL, NULL); namePtr = Tcl_NewStringObj("::oo::UnknownDefinition", -1); @@ -309,6 +311,10 @@ InitFoundation( * Finish setting up the class of classes by marking the 'new' method as * private; classes, unlike general objects, must have explicit names. We * also need to create the constructor for classes. + * + * The 0xDeadBeef is a special signal to the errorInfo logger that is used + * by constructors that stops it from generating extra error information + * that is confusing. */ namePtr = Tcl_NewStringObj("new", -1); @@ -318,12 +324,12 @@ InitFoundation( argsPtr = Tcl_NewStringObj("{definitionScript {}}", -1); Tcl_IncrRefCount(argsPtr); bodyPtr = Tcl_NewStringObj( - "if {[catch {define [self] $definitionScript} msg opt]} {\n" - "set ei [split [dict get $opt -errorinfo] \\n]\n" - "dict set opt -errorinfo [join [lrange $ei 0 end-2] \\n]\n" - "dict set opt -errorline 0xdeadbeef\n" + "set script [list ::oo::define [self] $definitionScript];" + "lassign [::oo::UpCatch $script] msg opts\n" + "if {[dict get $opts -code] == 1} {" + " dict set opts -errorline 0xDeadBeef\n" "}\n" - "return -options $opt $msg", -1); + "return -options $opts $msg", -1); fPtr->classCls->constructorPtr = TclOONewProcMethod(interp, fPtr->classCls, 0, NULL, argsPtr, bodyPtr, NULL); Tcl_DecrRefCount(argsPtr); |