summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--generic/tclPipe.c51
-rw-r--r--tests/exec.test6
2 files changed, 41 insertions, 16 deletions
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index 7d1334d..7339926 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.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: tclPipe.c,v 1.7 2002/12/17 02:47:39 davygrvy Exp $
+ * RCS: @(#) $Id: tclPipe.c,v 1.7.2.1 2004/07/02 23:37:31 hobbs Exp $
*/
#include "tclInt.h"
@@ -68,13 +68,13 @@ static TclFile
FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
releasePtr)
Tcl_Interp *interp; /* Intepreter to use for error reporting. */
- CONST char *spec; /* Points to character just after
+ CONST char *spec; /* Points to character just after
* redirection character. */
- CONST char *arg; /* Pointer to entire argument containing
- * spec: used for error reporting. */
int atOK; /* Non-zero means that '@' notation can be
* used to specify a channel, zero means that
* it isn't. */
+ CONST char *arg; /* Pointer to entire argument containing
+ * spec: used for error reporting. */
CONST char *nextArg; /* Next argument in argc/argv array, if needed
* for file name or channel name. May be
* NULL. */
@@ -107,9 +107,9 @@ FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
}
file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
if (file == NULL) {
- Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
- "\" wasn't opened for ",
- ((writing) ? "writing" : "reading"), (char *) NULL);
+ Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
+ "\" wasn't opened for ",
+ ((writing) ? "writing" : "reading"), (char *) NULL);
return NULL;
}
*releasePtr = 1;
@@ -508,7 +508,7 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
* closed when cleaning up. */
int errorRelease = 0;
CONST char *p;
- int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput;
+ int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput = 0;
Tcl_DString execBuffer;
TclFile pipeIn;
TclFile curInFile, curOutFile, curErrFile;
@@ -547,7 +547,8 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
lastBar = -1;
cmdCount = 1;
for (i = 0; i < argc; i++) {
- skip = 0;
+ errorToOutput = 0;
+ skip = 0;
p = argv[i];
switch (*p++) {
case '|':
@@ -601,7 +602,6 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
case '>':
atOK = 1;
flags = O_WRONLY | O_CREAT | O_TRUNC;
- errorToOutput = 0;
if (*p == '>') {
p++;
atOK = 0;
@@ -675,10 +675,26 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
errorRelease = 0;
TclpReleaseFile(errorFile);
}
- errorFile = FileForRedirect(interp, p, atOK, argv[i],
- argv[i + 1], flags, &skip, &errorClose, &errorRelease);
- if (errorFile == NULL) {
- goto error;
+ if (atOK && p[0] == '@' && p[1] == '1' && p[2] == '\0') {
+ /*
+ * Special case handling of 2>@1 to redirect stderr to the
+ * exec/open output pipe as well. This is meant for the end
+ * of the command string, otherwise use |& between commands.
+ */
+ if (i != argc - 1) {
+ Tcl_AppendResult(interp, "must specify \"", argv[i],
+ "\" as last word in command", (char *) NULL);
+ goto error;
+ }
+ errorFile = outputFile;
+ errorToOutput = 2;
+ skip = 1;
+ } else {
+ errorFile = FileForRedirect(interp, p, atOK, argv[i],
+ argv[i + 1], flags, &skip, &errorClose, &errorRelease);
+ if (errorFile == NULL) {
+ goto error;
+ }
}
break;
}
@@ -765,7 +781,12 @@ TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
}
if (errorFile == NULL) {
- if (errFilePtr != NULL) {
+ if (errorToOutput == 2) {
+ /*
+ * Handle 2>@1 special case at end of cmd line
+ */
+ errorFile = outputFile;
+ } else if (errFilePtr != NULL) {
/*
* Set up the standard error output sink for the pipeline, if
* requested. Use a temporary file which is opened, then deleted.
diff --git a/tests/exec.test b/tests/exec.test
index 2da0b7e..e5c9bf7 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: exec.test,v 1.16.2.2 2004/02/25 23:38:16 dgp Exp $
+# RCS: @(#) $Id: exec.test,v 1.16.2.3 2004/07/02 23:37:31 hobbs Exp $
package require tcltest 2
namespace import -force ::tcltest::*
@@ -541,6 +541,10 @@ test exec-15.6 {standard error redirection} {exec stdio} {
>& "$path(gorp.file)" 2> "$path(gorp.file2)" | [interpreter] "$path(echo)" biz baz
list [exec [interpreter] "$path(cat)" "$path(gorp.file)"] [exec [interpreter] "$path(cat)" "$path(gorp.file2)"]
} {{biz baz} {foo bar}}
+test exec-15.7 {standard error redirection 2>@1} {exec stdio} {
+ # This redirects stderr output into normal result output from exec
+ exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" 2>@1
+} {foo bar}
test exec-16.1 {flush output before exec} {exec} {
set f [open $path(gorp.file) w]