summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclPipe.c4
-rw-r--r--tests/exec.test47
-rw-r--r--win/tclWinPipe.c18
-rw-r--r--win/tclWinPort.h10
5 files changed, 69 insertions, 17 deletions
diff --git a/ChangeLog b/ChangeLog
index 4c33124..e1ef0bb 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2005-11-04 Pat Thoyts <patthoyts@users.sourceforge.net>
+
+ * win/tclWinPort.h: Applied patch #1267871 by Matt Newman for
+ * win/tclWinPipe.c: extended error code support on Windows.
+ * tests/exec.test: Tests for extended error codes.
+ * generic/tclPipe.c: Permit long codes (platform macros permitting).
+
2005-11-04 Miguel Sofer <msofer@users.sf.net>
* generic/tclBinary.c:
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index 0afc584..16dad41 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -9,7 +9,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.14 2005/11/02 14:51:05 dkf Exp $
+ * RCS: @(#) $Id: tclPipe.c,v 1.15 2005/11/04 23:01:40 patthoyts Exp $
*/
#include "tclInt.h"
@@ -317,7 +317,7 @@ TclCleanupChildren(
sprintf(msg1, "%lu", resolvedPid);
if (WIFEXITED(waitStatus)) {
if (interp != (Tcl_Interp *) NULL) {
- sprintf(msg2, "%hu", WEXITSTATUS(waitStatus));
+ sprintf(msg2, "%lu", WEXITSTATUS(waitStatus));
Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL);
}
abnormalExit = 1;
diff --git a/tests/exec.test b/tests/exec.test
index a80aaeb..6575bf6 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.23 2005/07/28 10:55:37 dkf Exp $
+# RCS: @(#) $Id: exec.test,v 1.24 2005/11/04 23:01:40 patthoyts Exp $
package require tcltest 2
namespace import -force ::tcltest::*
@@ -485,6 +485,51 @@ test exec-13.3 {setting errorCode variable} {exec} {
[string tolower [lrange $errorCode 2 end]]
} {1 {couldn't execute "_weird_cmd_": no such file or directory} POSIX {{no such file or directory}}}
+test exec-13.4 {extended exit result codes} {
+ -constraints {win}
+ -setup {
+ set tmp [makeFile {exit 0x00000101} tmpfile.exec-13.4]
+ }
+ -body {
+ list [catch {exec [interpreter] $tmp} err]\
+ [lreplace $::errorCode 1 1 {}]
+ }
+ -cleanup {
+ removeFile $tmp
+ }
+ -result {1 {CHILDSTATUS {} 257}}
+}
+
+test exec-13.5 {extended exit result codes: max value} {
+ -constraints {win}
+ -setup {
+ set tmp [makeFile {exit 0x3fffffff} tmpfile.exec-13.5]
+ }
+ -body {
+ list [catch {exec [interpreter] $tmp} err]\
+ [lreplace $::errorCode 1 1 {}]
+ }
+ -cleanup {
+ removeFile $tmp
+ }
+ -result {1 {CHILDSTATUS {} 1073741823}}
+}
+
+test exec-13.6 {extended exit result codes: signalled} {
+ -constraints {win}
+ -setup {
+ set tmp [makeFile {exit 0xC0000016} tmpfile.exec-13.6]
+ }
+ -body {
+ list [catch {exec [interpreter] $tmp} err]\
+ [lreplace $::errorCode 1 1 {}]
+ }
+ -cleanup {
+ removeFile $tmp
+ }
+ -result {1 {CHILDKILLED {} SIGABRT SIGABRT}}
+}
+
# Switches before the first argument
test exec-14.1 {-keepnewline switch} {exec} {
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 93e9655..80eb3c0 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinPipe.c,v 1.60 2005/11/04 00:06:50 dkf Exp $
+ * RCS: @(#) $Id: tclWinPipe.c,v 1.61 2005/11/04 23:01:40 patthoyts Exp $
*/
#include "tclWinInt.h"
@@ -2579,12 +2579,12 @@ Tcl_WaitPid(
case EXCEPTION_FLT_UNDERFLOW:
case EXCEPTION_INT_DIVIDE_BY_ZERO:
case EXCEPTION_INT_OVERFLOW:
- *statPtr = SIGFPE;
+ *statPtr = 0xC0000000 | SIGFPE;
break;
case EXCEPTION_PRIV_INSTRUCTION:
case EXCEPTION_ILLEGAL_INSTRUCTION:
- *statPtr = SIGILL;
+ *statPtr = 0xC0000000 | SIGILL;
break;
case EXCEPTION_ACCESS_VIOLATION:
@@ -2594,20 +2594,20 @@ Tcl_WaitPid(
case EXCEPTION_INVALID_DISPOSITION:
case EXCEPTION_GUARD_PAGE:
case EXCEPTION_INVALID_HANDLE:
- *statPtr = SIGSEGV;
+ *statPtr = 0xC0000000 | SIGSEGV;
break;
case EXCEPTION_DATATYPE_MISALIGNMENT:
- *statPtr = SIGBUS;
+ *statPtr = 0xC0000000 | SIGBUS;
break;
case EXCEPTION_BREAKPOINT:
case EXCEPTION_SINGLE_STEP:
- *statPtr = SIGTRAP;
+ *statPtr = 0xC0000000 | SIGTRAP;
break;
case CONTROL_C_EXIT:
- *statPtr = SIGINT;
+ *statPtr = 0xC0000000 | SIGINT;
break;
default:
@@ -2622,13 +2622,13 @@ Tcl_WaitPid(
* truncating it.
*/
- *statPtr = (((int)(short) exitCode << 8) & 0xffff00);
+ *statPtr = exitCode;
break;
}
result = pid;
} else {
errno = ECHILD;
- *statPtr = ECHILD;
+ *statPtr = 0xC0000000 | ECHILD;
result = (Tcl_Pid) -1;
}
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index 984682f..29c777b 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -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: tclWinPort.h,v 1.46 2005/11/03 00:17:31 patthoyts Exp $
+ * RCS: @(#) $Id: tclWinPort.h,v 1.47 2005/11/04 23:01:40 patthoyts Exp $
*/
#ifndef _TCLWINPORT
@@ -240,15 +240,15 @@
#endif /* TCL_UNION_WAIT */
#ifndef WIFEXITED
-# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xff) == 0)
+# define WIFEXITED(stat) (((*((int *) &(stat))) & 0xC0000000) == 0)
#endif
#ifndef WEXITSTATUS
-# define WEXITSTATUS(stat) (short)(((*((int *) &(stat))) >> 8) & 0xffff)
+# define WEXITSTATUS(stat) (*((int *) &(stat)))
#endif
#ifndef WIFSIGNALED
-# define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))
+# define WIFSIGNALED(stat) ((*((int *) &(stat))) & 0xC0000000)
#endif
#ifndef WTERMSIG
@@ -256,7 +256,7 @@
#endif
#ifndef WIFSTOPPED
-# define WIFSTOPPED(stat) (((*((int *) &(stat))) & 0xff) == 0177)
+# define WIFSTOPPED(stat) 0
#endif
#ifndef WSTOPSIG