Attachment "1481986.patch" to
ticket [1481986fff]
added by
dgp
2006-05-05 23:48:04.
Index: generic/tclMain.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclMain.c,v
retrieving revision 1.20.2.2
diff -u -r1.20.2.2 tclMain.c
--- generic/tclMain.c 23 Oct 2005 22:01:30 -0000 1.20.2.2
+++ generic/tclMain.c 5 May 2006 16:44:23 -0000
@@ -335,90 +335,89 @@
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 (mainLoopProc == NULL) {
+ if (tty) {
+ Prompt(interp, &prompt);
+ if (Tcl_InterpDeleted(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)) {
-
- /*
- * 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.
- */
+ 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;
- }
+ continue;
+ }
- /*
- * Either EOF, or an error on stdin; we're done
- */
+ /*
+ * Either EOF, or an error on stdin; we're done
+ */
- break;
- }
+ break;
+ }
- /*
- * Add the newline removed by Tcl_GetsObj back to the string.
- */
+ /*
+ * 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);
+ }
+ Tcl_AppendToObj(commandPtr, "\n", 1);
+ if (!TclObjCommandComplete(commandPtr)) {
+ prompt = PROMPT_CONTINUE;
+ continue;
+ }
- if (Tcl_IsShared(commandPtr)) {
+ 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_DuplicateObj(commandPtr);
+ commandPtr = Tcl_NewObj();
Tcl_IncrRefCount(commandPtr);
- }
- Tcl_AppendToObj(commandPtr, "\n", 1);
- if (!TclObjCommandComplete(commandPtr)) {
- 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);
+ 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
* channel handler for stdin.
*/
-
InteractiveState *isPtr = NULL;
if (inChannel) {
Index: tests/main.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/main.test,v
retrieving revision 1.13.2.2
diff -u -r1.13.2.2 main.test
--- tests/main.test 9 Feb 2006 15:23:52 -0000 1.13.2.2
+++ tests/main.test 5 May 2006 16:44:23 -0000
@@ -499,6 +499,27 @@
} -result "application-specific initialization failed:\
\nIn script\nExit MainLoop\nIn exit\neven 0\n"
+ test Tcl_Main-4.5 {
+ Tcl_Main: Bug 1481986
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ set rc [makeFile {
+ testsetmainloop
+ after 0 {puts "Event callback"}
+ } rc]
+ } -body {
+ set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+]
+ after 1000
+ type $f {puts {Interactive output}
+ exit
+ }
+ read $f
+ } -cleanup {
+ catch {close $f}
+ removeFile rc
+ } -result "Event callback\nInteractive output\n"
+
# Tests Tcl_Main-5.*: interactive operations
test Tcl_Main-5.1 {
