diff options
author | dgp <dgp@users.sourceforge.net> | 2006-05-05 18:09:47 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2006-05-05 18:09:47 (GMT) |
commit | c802ec354b63ada12adc6522c9d96b60bd16687a (patch) | |
tree | 798c410899336ae3a0e0642c314d7af97a06dd75 /generic/tclMain.c | |
parent | 567b7209bf2c1079048fca82605f2f468b9bf66b (diff) | |
download | tcl-c802ec354b63ada12adc6522c9d96b60bd16687a.zip tcl-c802ec354b63ada12adc6522c9d96b60bd16687a.tar.gz tcl-c802ec354b63ada12adc6522c9d96b60bd16687a.tar.bz2 |
* generic/tclMain.c (Tcl_Main): Corrected flaw that required
* tests/main.test: (Tcl_Main-4.5): processing of one interactive
command before passing control to the loop routine registered with
Tcl_SetMainLoop() [Bug 1481986].
Diffstat (limited to 'generic/tclMain.c')
-rw-r--r-- | generic/tclMain.c | 222 |
1 files changed, 111 insertions, 111 deletions
diff --git a/generic/tclMain.c b/generic/tclMain.c index 7961d0f..c3a75ef 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMain.c,v 1.35 2005/11/01 15:30:52 dkf Exp $ + * RCS: @(#) $Id: tclMain.c,v 1.36 2006/05/05 18:09:47 dgp Exp $ */ #include "tclInt.h" @@ -487,85 +487,85 @@ Tcl_Main( inChannel = Tcl_GetStdChannel(TCL_STDIN); outChannel = Tcl_GetStdChannel(TCL_STDOUT); while ((inChannel != (Tcl_Channel) NULL) && !Tcl_InterpDeleted(interp)) { - if (tty) { - Prompt(interp, &prompt); - if (Tcl_InterpDeleted(interp)) { - break; - } - if (Tcl_LimitExceeded(interp)) { - break; + if (mainLoopProc == NULL) { + if (tty) { + Prompt(interp, &prompt); + if (Tcl_InterpDeleted(interp)) { + break; + } + if (Tcl_LimitExceeded(interp)) { + break; + } + inChannel = Tcl_GetStdChannel(TCL_STDIN); + if (inChannel == (Tcl_Channel) NULL) { + break; + } } - inChannel = Tcl_GetStdChannel(TCL_STDIN); - if (inChannel == (Tcl_Channel) NULL) { - break; + if (Tcl_IsShared(commandPtr)) { + Tcl_DecrRefCount(commandPtr); + commandPtr = Tcl_DuplicateObj(commandPtr); + Tcl_IncrRefCount(commandPtr); } - } - if (Tcl_IsShared(commandPtr)) { - Tcl_DecrRefCount(commandPtr); - commandPtr = Tcl_DuplicateObj(commandPtr); - Tcl_IncrRefCount(commandPtr); - } - length = Tcl_GetsObj(inChannel, commandPtr); - if (length < 0) { - if (Tcl_InputBlocked(inChannel)) { + length = Tcl_GetsObj(inChannel, commandPtr); + if (length < 0) { + if (Tcl_InputBlocked(inChannel)) { + /* + * This can only happen if stdin has been set to + * non-blocking. In that case cycle back and try again. + * This sets up a tight polling loop (since we have no + * event loop running). If this causes bad CPU hogging, + * we might try toggling the blocking on stdin instead. + */ + + continue; + } + /* - * This can only happen if stdin has been set to non-blocking. - * In that case cycle back and try again. This sets up a tight - * polling loop (since we have no event loop running). If this - * causes bad CPU hogging, we might try toggling the blocking - * on stdin instead. + * Either EOF, or an error on stdin; we're done */ - continue; + break; } - /* - * Either EOF, or an error on stdin; we're done - */ - - break; - } - - if (!TclObjCommandComplete(commandPtr)) { - /* - * Add the newline removed by Tcl_GetsObj back to the string. - */ + if (!TclObjCommandComplete(commandPtr)) { + /* + * Add the newline removed by Tcl_GetsObj back to the string. + */ - if (Tcl_IsShared(commandPtr)) { - Tcl_DecrRefCount(commandPtr); - commandPtr = Tcl_DuplicateObj(commandPtr); - Tcl_IncrRefCount(commandPtr); + if (Tcl_IsShared(commandPtr)) { + Tcl_DecrRefCount(commandPtr); + commandPtr = Tcl_DuplicateObj(commandPtr); + Tcl_IncrRefCount(commandPtr); + } + Tcl_AppendToObj(commandPtr, "\n", 1); + prompt = PROMPT_CONTINUE; + continue; } - Tcl_AppendToObj(commandPtr, "\n", 1); - prompt = PROMPT_CONTINUE; - continue; - } - prompt = PROMPT_START; - code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); - inChannel = Tcl_GetStdChannel(TCL_STDIN); - outChannel = Tcl_GetStdChannel(TCL_STDOUT); - errChannel = Tcl_GetStdChannel(TCL_STDERR); - Tcl_DecrRefCount(commandPtr); - commandPtr = Tcl_NewObj(); - Tcl_IncrRefCount(commandPtr); - if (code != TCL_OK) { - if (errChannel) { - Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); - Tcl_WriteChars(errChannel, "\n", 1); - } - } else if (tty) { - resultPtr = Tcl_GetObjResult(interp); - Tcl_IncrRefCount(resultPtr); - Tcl_GetStringFromObj(resultPtr, &length); - if ((length > 0) && outChannel) { - Tcl_WriteObj(outChannel, resultPtr); - Tcl_WriteChars(outChannel, "\n", 1); + prompt = PROMPT_START; + code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL); + inChannel = Tcl_GetStdChannel(TCL_STDIN); + outChannel = Tcl_GetStdChannel(TCL_STDOUT); + errChannel = Tcl_GetStdChannel(TCL_STDERR); + Tcl_DecrRefCount(commandPtr); + commandPtr = Tcl_NewObj(); + Tcl_IncrRefCount(commandPtr); + if (code != TCL_OK) { + if (errChannel) { + Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp)); + Tcl_WriteChars(errChannel, "\n", 1); + } + } else if (tty) { + resultPtr = Tcl_GetObjResult(interp); + Tcl_IncrRefCount(resultPtr); + Tcl_GetStringFromObj(resultPtr, &length); + if ((length > 0) && outChannel) { + Tcl_WriteObj(outChannel, resultPtr); + Tcl_WriteChars(outChannel, "\n", 1); + } + Tcl_DecrRefCount(resultPtr); } - Tcl_DecrRefCount(resultPtr); - } - - if (mainLoopProc != NULL) { + } else { /* (mainLoopProc != NULL) */ /* * If a main loop has been defined while running interactively, we * want to start a fileevent based prompt by establishing a @@ -635,55 +635,55 @@ Tcl_Main( * If everything has gone OK so far, call the main loop proc, if it * exists. Packages (like Tk) can set it to start processing events at * this point. - */ + */ - (*mainLoopProc)(); - mainLoopProc = NULL; - } - if (commandPtr != NULL) { - Tcl_DecrRefCount(commandPtr); - } + (*mainLoopProc)(); + mainLoopProc = NULL; + } + if (commandPtr != NULL) { + Tcl_DecrRefCount(commandPtr); + } - /* - * Rather than calling exit, invoke the "exit" command so that users can - * replace "exit" with some other command to do additional cleanup on - * exit. The Tcl_EvalObjEx call should never return. - */ + /* + * Rather than calling exit, invoke the "exit" command so that users can + * replace "exit" with some other command to do additional cleanup on + * exit. The Tcl_EvalObjEx call should never return. + */ - if (!Tcl_InterpDeleted(interp)) { - if (!Tcl_LimitExceeded(interp)) { - Tcl_Obj *cmd = Tcl_NewObj(); - TclObjPrintf(NULL, cmd, "exit %d", exitCode); - Tcl_IncrRefCount(cmd); - Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); - Tcl_DecrRefCount(cmd); - } + if (!Tcl_InterpDeleted(interp)) { + if (!Tcl_LimitExceeded(interp)) { + Tcl_Obj *cmd = Tcl_NewObj(); + TclObjPrintf(NULL, cmd, "exit %d", exitCode); + Tcl_IncrRefCount(cmd); + Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL); + Tcl_DecrRefCount(cmd); + } - /* - * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual - * is happening. Maybe interp has been deleted; maybe [exit] was - * redefined, maybe we've blown up because of an exceeded limit. We - * still want to cleanup and exit. - */ + /* + * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual + * is happening. Maybe interp has been deleted; maybe [exit] was + * redefined, maybe we've blown up because of an exceeded limit. We + * still want to cleanup and exit. + */ - if (!Tcl_InterpDeleted(interp)) { - Tcl_DeleteInterp(interp); - } - } - Tcl_SetStartupScript(NULL, NULL); + if (!Tcl_InterpDeleted(interp)) { + Tcl_DeleteInterp(interp); + } + } + Tcl_SetStartupScript(NULL, NULL); - /* - * If we get here, the master interp has been deleted. Allow its - * destruction with the last matching Tcl_Release. - */ + /* + * If we get here, the master interp has been deleted. Allow its + * destruction with the last matching Tcl_Release. + */ - Tcl_Release((ClientData) interp); - Tcl_Exit(exitCode); -} - -/* - *--------------------------------------------------------------- - * + Tcl_Release((ClientData) interp); + Tcl_Exit(exitCode); + } + + /* + *--------------------------------------------------------------- + * * Tcl_SetMainLoop -- * * Sets an alternative main loop function. |