From c246782cc0bc14600f737dfc07d0bc3853d95dd4 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 18 Jan 2011 13:50:03 +0000 Subject: * generic/tclOOMethod.c (PushMethodCallFrame): [Bug 3001438]: Make sure that the cmdPtr field of the procPtr is correct and relevant at all times so that [info frame] can report sensible information about a frame after a return to it from a recursive call, instead of probably crashing (depending on what else has overwritten the Tcl stack!) --- ChangeLog | 20 ++++++++++++++------ generic/tclOOMethod.c | 38 +++++++++++++++++++++++++++++++++++--- tests/oo.test | 14 +++++++++++++- 3 files changed, 62 insertions(+), 10 deletions(-) diff --git a/ChangeLog b/ChangeLog index 45c4657..04a76ec 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,14 @@ +2011-01-18 Donal K. Fellows + + * generic/tclOOMethod.c (PushMethodCallFrame): [Bug 3001438]: Make + sure that the cmdPtr field of the procPtr is correct and relevant at + all times so that [info frame] can report sensible information about a + frame after a return to it from a recursive call, instead of probably + crashing (depending on what else has overwritten the Tcl stack!) + 2011-01-18 Jan Nijtmans - * generic/tclBasic.c: Various mismatches between Tcl_Panic + * generic/tclBasic.c: Various mismatches between Tcl_Panic * generic/tclCompCmds.c: format string and its arguments, * generic/tclCompCmdsSZ.c: discovered thanks to [Bug 3159920] * generic/tclCompExpr.c @@ -20,11 +28,11 @@ * doc/tclvars.n: * generic/tclStrToD.c: * generic/tclUtil.c (Tcl_PrintDouble): - * tests/util.test (util-16.*): Restored full Tcl 8.4 compatibility - for the formatting of floating point numbers when $::tcl_precision - is not zero. Added compatibility tests to make sure that excess - trailing zeroes are suppressed for all eight major code paths. - [Bug 3157475] + * tests/util.test (util-16.*): [Bug 3157475]: Restored full Tcl 8.4 + compatibility for the formatting of floating point numbers when + $::tcl_precision is not zero. Added compatibility tests to make sure + that excess trailing zeroes are suppressed for all eight major code + paths. 2011-01-12 Jan Nijtmans diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 61aeb12..735ced9 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.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: tclOOMethod.c,v 1.29 2010/11/09 16:26:30 dkf Exp $ + * RCS: @(#) $Id: tclOOMethod.c,v 1.30 2011/01/18 13:50:03 dkf Exp $ */ #ifdef HAVE_CONFIG_H @@ -41,6 +41,7 @@ typedef struct { Tcl_Obj *nameObj; /* The "name" of the command. */ Command cmd; /* The command structure. Mostly bogus. */ ExtraFrameInfo efi; /* Extra information used for [info frame]. */ + Command *oldCmdPtr; struct PNI pni; /* Specialist information used in the efi * field for this type of call. */ } PMFrameData; @@ -711,6 +712,13 @@ InvokeProcedureMethod( result = pmPtr->preCallProc(pmPtr->clientData, interp, context, (Tcl_CallFrame *) fdPtr->framePtr, &isFinished); if (isFinished || result != TCL_OK) { + /* + * Restore the old cmdPtr so that a subsequent use of [info frame] + * won't crash on us. [Bug 3001438] + */ + + pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; + Tcl_PopCallFrame(interp); TclStackFree(interp, fdPtr->framePtr); if (--pmPtr->refCount < 1) { @@ -752,6 +760,13 @@ FinalizePMCall( } /* + * Restore the old cmdPtr so that a subsequent use of [info frame] won't + * crash on us. [Bug 3001438] + */ + + pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; + + /* * Scrap the special frame data now that we're done with it. Note that we * are inlining DeleteProcedureMethod() here; this location is highly * sensitive when it comes to performance! @@ -820,6 +835,14 @@ PushMethodCallFrame( } /* + * Save the old cmdPtr so that when this recursive call returns, we can + * restore it. To do otherwise causes crashes in [info frame] after we + * return from a recursive call. [Bug 3001438] + */ + + fdPtr->oldCmdPtr = pmPtr->procPtr->cmdPtr; + + /* * Compile the body. This operation may fail. */ @@ -845,7 +868,7 @@ PushMethodCallFrame( result = TclProcCompileProc(interp, pmPtr->procPtr, pmPtr->procPtr->bodyPtr, nsPtr, "body of method", namePtr); if (result != TCL_OK) { - return result; + goto failureReturn; } /* @@ -856,7 +879,7 @@ PushMethodCallFrame( result = TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, (Tcl_Namespace *) nsPtr, FRAME_IS_PROC|FRAME_IS_METHOD); if (result != TCL_OK) { - return result; + goto failureReturn; } fdPtr->framePtr->clientData = contextPtr; @@ -891,6 +914,15 @@ PushMethodCallFrame( } return TCL_OK; + + /* + * Restore the old cmdPtr so that a subsequent use of [info frame] won't + * crash on us. [Bug 3001438] + */ + + failureReturn: + pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; + return result; } /* diff --git a/tests/oo.test b/tests/oo.test index fbeecc6..1954d1b 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -7,7 +7,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: oo.test,v 1.43 2011/01/01 15:14:43 dkf Exp $ +# RCS: @(#) $Id: oo.test,v 1.44 2011/01/18 13:50:03 dkf Exp $ package require -exact TclOO 0.6.2 ;# Must match value in generic/tclOO.h package require tcltest 2 @@ -2235,6 +2235,18 @@ test oo-22.1 {OO and info frame} -setup { } -cleanup { c destroy } -result {1 {{type source line * file * cmd {info frame 0} method frames class ::c level 0} {type source line * file * cmd {info frame 0} method frames object ::i level 0}} ::c} +test oo-22.2 {OO and info frame: Bug 3001438} -setup { + oo::class create c +} -body { + oo::define c method test {{x 1}} { + if {$x} {my test 0} + lsort {q w e r t y u i o p}; # Overwrite the Tcl stack + info frame 0 + } + [c new] test +} -match glob -cleanup { + c destroy +} -result {* cmd {info frame 0} method test class ::c level 0} # Prove that the issue in [Bug 1865054] isn't an issue any more test oo-23.1 {Self-like derivation; complex case!} -setup { -- cgit v0.12