summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-08-21 20:41:31 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-08-21 20:41:31 (GMT)
commit5a6f909bc973a094f28f7cadc81faf84a9128748 (patch)
treee30018135f4e85fac7c5b364a7f210449f2cd160
parent2d087cd971d85e6e4bb484878b61f0ce4d845b6b (diff)
downloadtcl-5a6f909bc973a094f28f7cadc81faf84a9128748.zip
tcl-5a6f909bc973a094f28f7cadc81faf84a9128748.tar.gz
tcl-5a6f909bc973a094f28f7cadc81faf84a9128748.tar.bz2
* generic/tclMain.c: Corrected the logic of dropping the last
* tests/main.test: newline from an interactively typed command. [Bug 1775878].
-rw-r--r--ChangeLog8
-rw-r--r--generic/tclMain.c44
-rw-r--r--tests/main.test31
3 files changed, 64 insertions, 19 deletions
diff --git a/ChangeLog b/ChangeLog
index c443a17..4590952 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2007-08-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclMain.c: Corrected the logic of dropping the last
+ * tests/main.test: newline from an interactively typed command.
+ [Bug 1775878].
+
2007-08-21 Pat Thoyts <patthoyts@users.sourceforge.net>
* tests/thread.test: thread-4.4: clear ::errorInfo in the thread as
@@ -22,7 +28,7 @@
previous
((a >= 0 || b >= 0 || s < 0) && (s >= 0 || b < 0 || a < 0))
now
- (((a^s) >= 0) || ((a^b) < 0))
+ (((a^s) >= 0) || ((a^b) < 0))
This expresses: "a and s have the same sign or else a and b have
different sign".
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 2ccb855..02cc5a9 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.42 2007/04/24 16:03:51 dgp Exp $
+ * RCS: @(#) $Id: tclMain.c,v 1.43 2007/08/21 20:41:32 dgp Exp $
*/
#include "tclInt.h"
@@ -527,22 +527,30 @@ Tcl_Main(
break;
}
- if (!TclObjCommandComplete(commandPtr)) {
- /*
- * Add the newline removed by Tcl_GetsObj back to the string.
- */
+ /*
+ * Add the newline removed by Tcl_GetsObj back to the string.
+ * Have to add it back before testing completeness, because
+ * it can make a difference. [Bug 1775878].
+ */
- if (Tcl_IsShared(commandPtr)) {
- Tcl_DecrRefCount(commandPtr);
- commandPtr = Tcl_DuplicateObj(commandPtr);
- Tcl_IncrRefCount(commandPtr);
- }
- Tcl_AppendToObj(commandPtr, "\n", 1);
+ 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;
}
prompt = PROMPT_START;
+ /*
+ * The final newline is syntactically redundant, and causes
+ * some error messages troubles deeper in, so lop it back off.
+ */
+ Tcl_GetStringFromObj(commandPtr, &length);
+ Tcl_SetObjLength(commandPtr, --length);
code = Tcl_RecordAndEvalObj(interp, commandPtr, TCL_EVAL_GLOBAL);
inChannel = Tcl_GetStdChannel(TCL_STDIN);
outChannel = Tcl_GetStdChannel(TCL_STDOUT);
@@ -758,17 +766,19 @@ StdinProc(
return;
}
+ if (Tcl_IsShared(commandPtr)) {
+ Tcl_DecrRefCount(commandPtr);
+ commandPtr = Tcl_DuplicateObj(commandPtr);
+ Tcl_IncrRefCount(commandPtr);
+ }
+ Tcl_AppendToObj(commandPtr, "\n", 1);
if (!TclObjCommandComplete(commandPtr)) {
- if (Tcl_IsShared(commandPtr)) {
- Tcl_DecrRefCount(commandPtr);
- commandPtr = Tcl_DuplicateObj(commandPtr);
- Tcl_IncrRefCount(commandPtr);
- }
- Tcl_AppendToObj(commandPtr, "\n", 1);
isPtr->prompt = PROMPT_CONTINUE;
goto prompt;
}
isPtr->prompt = PROMPT_START;
+ Tcl_GetStringFromObj(commandPtr, &length);
+ Tcl_SetObjLength(commandPtr, --length);
/*
* Disable the stdin channel handler while evaluating the command;
diff --git a/tests/main.test b/tests/main.test
index 7842644..e188f6e 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -1,6 +1,6 @@
# This file contains a collection of tests for generic/tclMain.c.
#
-# RCS: @(#) $Id: main.test,v 1.20 2006/09/04 21:34:58 dgp Exp $
+# RCS: @(#) $Id: main.test,v 1.21 2007/08/21 20:41:32 dgp Exp $
if {[catch {package require tcltest 2.0.2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -819,6 +819,20 @@ namespace eval ::tcl::test::main {
file delete result
} -result "Exit MainLoop\nIn exit\neven 0\n"
+ test Tcl_Main-5.13 {
+ Bug 1775878
+ } -constraints {
+ exec
+ } -setup {
+ catch {set f [open "|[list [interpreter]]" w+]}
+ } -body {
+ type $f "puts \\"
+ type $f return
+ list [catch {gets $f} line] $line
+ } -cleanup {
+ close $f
+ } -result [list 0 return]
+
# Tests Tcl_Main-6.*: interactive operations with prompts
test Tcl_Main-6.1 {
@@ -1202,6 +1216,21 @@ namespace eval ::tcl::test::main {
file delete result
} -result "1\nExit MainLoop\n"
+ test Tcl_Main-8.13 {
+ Bug 1775878
+ } -constraints {
+ exec Tcltest
+ } -setup {
+ catch {set f [open "|[list [interpreter]]" w+]}
+ } -body {
+ exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result
+ set f [open result]
+ read $f
+ } -cleanup {
+ close $f
+ file delete result
+ } -result "pwd\nExit MainLoop\n"
+
# Tests Tcl_Main-9.*: Prompt operations
test Tcl_Main-9.1 {