diff options
| -rw-r--r-- | generic/tclPipe.c | 51 | ||||
| -rw-r--r-- | tests/exec.test | 6 |
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] |