Tcl Source Code

Artifact dd3bf62e827a45506576f6655a2bd374e7645e33:

Attachment "tclsh_noninteractive_stream.diff" to ticket [0e7c09eb49] added by pooryorick 2015-04-14 15:01:01. (unpublished)

---

Index: generic/tclMain.c
==================================================================
--- generic/tclMain.c
+++ generic/tclMain.c
@@ -540,10 +540,14 @@
 	    if (code != TCL_OK) {
 		chan = Tcl_GetStdChannel(TCL_STDERR);
 		if (chan) {
 		    Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
 		    Tcl_WriteChars(chan, "\n", 1);
+		}
+		if (!is.tty) {
+		    exitCode = 1;
+		    goto done;
 		}
 	    } else if (is.tty) {
 		resultPtr = Tcl_GetObjResult(interp);
 		Tcl_IncrRefCount(resultPtr);
 		Tcl_GetStringFromObj(resultPtr, &length);

Index: tests/basic.test
==================================================================
--- tests/basic.test
+++ tests/basic.test
@@ -551,32 +551,31 @@
 } {}
 
 test basic-45.1 {Tcl_SetRecursionLimit: see interp.test} {emptyTest} {
 } {}
 
-test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {stdio} {
+test basic-46.1 {Tcl_AllowExceptions: exception continue not allowed} {stdio} {
     catch {close $f}
     set res [catch {
-	set f [open |[list [interpreter]] w+]
+	set f [open |[list [interpreter] 2>@1] w+]
 	chan configure $f -buffering line
 	puts $f {chan configure stdout -buffering line}
 	puts $f continue
 	puts $f {puts $::errorInfo}
-	puts $f {puts DONE}
 	set newMsg {}
 	set msg {}
-	while {$newMsg != "DONE"} {
+	while 1 {
 	    set newMsg [gets $f]
+	    if {$newMsg eq {} && [eof $f]} {
+		break
+	    }
 	    append msg "${newMsg}\n"
 	}
 	close $f
     } error]
     list $res $msg
 } {1 {invoked "continue" outside of a loop
-    while executing
-"continue"
-DONE
 }}
 
 test basic-46.2 {Tcl_AllowExceptions: exception return not allowed} -setup {
     set fName [makeFile {
 	puts hello

Index: tests/main.test
==================================================================
--- tests/main.test
+++ tests/main.test
@@ -573,11 +573,11 @@
     test Tcl_Main-5.1 {
 	Tcl_Main: tcl_interactive must be boolean
     } -constraints {
 	exec
     } -body {
-	exec [interpreter] << {set tcl_interactive foo} >& result
+	catch {exec [interpreter] << {set tcl_interactive foo} >& result}
 	set f [open result]
 	read $f
     } -cleanup {
 	close $f
 	file delete result
@@ -651,11 +651,11 @@
     test Tcl_Main-5.5 {
 	Tcl_Main: error raised in interactive mode
     } -constraints {
 	exec
     } -body {
-	exec [interpreter] << {error foo} >& result
+	catch {exec [interpreter] << {error foo} >& result}
 	set f [open result]
 	read $f
     } -cleanup {
 	close $f
 	file delete result
@@ -665,36 +665,38 @@
 	Tcl_Main: interactive mode: errors don't stop command loop
     } -constraints {
 	exec
     } -body {
 	exec [interpreter] << {
+		set ::tcl_interactive 1
 		error foo
 		puts bar
 	} >& result
 	set f [open result]
 	read $f
     } -cleanup {
 	close $f
 	file delete result
-    } -result "foo\nbar\n"
+    } -result "1\n% foo\n% bar\n% % "
 
     test Tcl_Main-5.7 {
 	Tcl_Main: interactive mode: closed stderr
     } -constraints {
 	exec
     } -body {
 	exec [interpreter] << {
+		set ::tcl_interactive 1
 		close stderr
 		error foo
 		puts bar
 	} >& result
 	set f [open result]
 	read $f
     } -cleanup {
 	close $f
 	file delete result
-    } -result "bar\n"
+    } -result "1\n% % % bar\n% % "
 
     test Tcl_Main-5.8 {
 	Tcl_Main: interactive mode: close stdin
 		-> main loop & [exit] & exit handlers
     } -constraints {