Fix for bug 579284; registered math funcs can now correctly return wide-ints.

3 files changed, 80 insertions, 62 deletions

diff --git a/ChangeLog b/ChangeLog
index b72663e..4f11d98 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2002-07-10  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
+
+	* tests/expr.test: Added tests to make sure that this works.
+	* generic/tclExecute.c (ExprCallMathFunc): Functions should also
+	be able to return wide-ints.  [Bug 579284]
+
 2002-07-08  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
 
 	* tests/socket.test: Fixed bug #578164. The original reason for
@@ -13,11 +19,11 @@
 
 2002-07-08  Vince Darley  <vincentdarley@users.sourceforge.net>
 
-        * tests/cmdAH.test:
+	* tests/cmdAH.test:
 	* tests/fCmd.test:
 	* tests/fileName.test: tests which rely on 'file link' need a
 	constraint so they don't run on older Windows OS. [Bug 578158]
-        * generic/tclIOUtil.c:
+	* generic/tclIOUtil.c:
 	* generic/tcl.h:
 	* generic/tclInt.h:
 	* generic/tclTest.c:
@@ -414,7 +420,7 @@
 	* win/makefile.vc:	to installation on Windows.
 
 	* library/init.tcl:  Corrected comments and namespace style
-        issues.  Thanks to Bruce Stephens. [Bug 572025]
+	issues.  Thanks to Bruce Stephens. [Bug 572025]
 
 2002-06-21  Vince Darley  <vincentdarley@users.sourceforge.net>
 
@@ -2250,7 +2256,7 @@
 	* win/tclWinInit.c: Partial TIP 27 rollback.  Following routines
 	restored to return (char *): Tcl_DStringAppend,
 	Tcl_DStringAppendElement, Tcl_JoinPath, Tcl_TranslateFileName,
-        Tcl_ExternalToUtfDString, Tcl_UtfToExternalDString,
+	Tcl_ExternalToUtfDString, Tcl_UtfToExternalDString,
 	Tcl_UniCharToUtfDString, Tcl_GetCwd, Tcl_WinTCharToUtf.  Also
 	restored Tcl_WinUtfToTChar to return (TCHAR *) and 
 	Tcl_UtfToUniCharDString to return (Tcl_UniChar *).  Modified
@@ -2788,7 +2794,7 @@
 	* generic/tcl.decls (Tcl_ParseVar):
 	* generic/tclParse.c (Tcl_ParseVar):
 	* generic/tclTest.c (TestparsevarObjCmd): Updated APIs in
-        generic/tclParse.c according to the guidelines of TIP 27.  Updated
+	generic/tclParse.c according to the guidelines of TIP 27.  Updated
 	callers.  [Patch 501046]
 	* generic/tclDecls.h: make genstubs
 
@@ -2817,13 +2823,13 @@
 	Tcl_ErrnoMsg; it takes an integer argument.  Thanks to Georgios
 	Petasis.  [Bug 468183]
 
-        * doc/AddErrInfo.3 (Tcl_PosixError):
-        * doc/Eval.3 (Tcl_EvalFile):
-        * doc/FileSystem.c (Tcl_FSOpenFileChannel,Tcl_FSOpenFileChannelProc):
-        * doc/OpenFileChnl.3 (Tcl_OpenFileChannel):
-        * doc/SetErrno.3 (Tcl_ErrnoId,Tcl_ErrnoMsg):
-        * doc/Signal.3 (Tcl_SignalId,Tcl_SignalMsg):
-        * generic/tcl.decls (Tcl_ErrnoId,TclErrnoMsg,Tcl_EvalFile,
+	* doc/AddErrInfo.3 (Tcl_PosixError):
+	* doc/Eval.3 (Tcl_EvalFile):
+	* doc/FileSystem.c (Tcl_FSOpenFileChannel,Tcl_FSOpenFileChannelProc):
+	* doc/OpenFileChnl.3 (Tcl_OpenFileChannel):
+	* doc/SetErrno.3 (Tcl_ErrnoId,Tcl_ErrnoMsg):
+	* doc/Signal.3 (Tcl_SignalId,Tcl_SignalMsg):
+	* generic/tcl.decls (Tcl_ErrnoId,TclErrnoMsg,Tcl_EvalFile,
 	  Tcl_OpenFileChannel,Tcl_PosixError,Tcl_SignalId,Tcl_SignalMsg,
 	  Tcl_FSOpenFileChannel):
 	* generic/tcl.h (Tcl_FSOpenFileChannelProc):
@@ -3564,9 +3570,9 @@
 	* generic/tclThreadTest.c: renamed routines conflicting with standard
 	Apple or MoreFiles headers (at compile or link time):
 	GetGlobalMouse         -> GetGlobalMouseTcl
-    	FSpGetDirectoryID      -> FSpGetDirectoryIDTcl
-    	FSpOpenResFileCompat   -> FSpOpenResFileCompatTcl
-    	FSpCreateResFileCompat -> FSpCreateResFileCompatTcl
+	FSpGetDirectoryID      -> FSpGetDirectoryIDTcl
+	FSpOpenResFileCompat   -> FSpOpenResFileCompatTcl
+	FSpCreateResFileCompat -> FSpCreateResFileCompatTcl
 	NewThread              -> NewTestThread
 	the renamed MoreFiles *Tcl routines are just wrappers calling into the
 	MoreFiles DLL.
@@ -5395,7 +5401,7 @@
 
 2001-08-11  Vince Darley <vincentdarley@users.sourceforge.net>
 
-        Variety of small issues introduced by the vfs code fixed:
+	Variety of small issues introduced by the vfs code fixed:
 	* generic/tclIOUtil.c: uninitialised read.
 	* generic/tclFCmd.c: possible memory leak in file delete 
 	with error condition.
@@ -5531,7 +5537,7 @@
 
 2001-07-31  Vince Darley <vincentdarley@users.sourceforge.net>
 
-        Changes from TIP#17 "Redo Tcl's filesystem"
+	Changes from TIP#17 "Redo Tcl's filesystem"
 	The following files were impacted:
 	* doc/Access.3: 
 	* doc/FileSystem.3: 
@@ -5929,7 +5935,7 @@
 	* unix/Makefile.in: Set CFLAGS to @CFLAGS@ and @CFLAGS_DEFAULT@.
 	Set LDFLAGS to @LDFLAGS@ and @LDFLAGS_DEFAULT@. Add LDFLAGS_DEBUG
 	and LDFLAGS_OPTIMIZE to match the way CFLAGS_DEFAULT works.
- 	This will support user set CFLAGS or LDFLAGS at configure time.
+	This will support user set CFLAGS or LDFLAGS at configure time.
 	* unix/configure: Regen.
 	* unix/configure.in: Don't set CFLAGS to CFLAGS_DEFAULT, instead
 	subst CFLAGS_DEFAULT into the Makefile. Add AC_SUBST for CFLAGS_DEFAULT,
@@ -6598,28 +6604,28 @@
 	  Thread-Aware Channels]. See also [Patch #403358] at SF.
 
 	* generic/tclIO.h (struct ChannelState, line 236f): Extended the
- 	  structure with a new field of type 'Tcl_ThreadId' to hold the id
- 	  of the thread currently managing all channels with this state.
+	  structure with a new field of type 'Tcl_ThreadId' to hold the id
+	  of the thread currently managing all channels with this state.
 
 	  Note: This structure is shared by all channels in a stack of
- 	  transformations.
+	  transformations.
 
 	* generic/tclIO.c (Tcl_CreateChannel, lines 1058-1065): Modified
- 	  to store the Id of the current thread in the 'ChannelState' of
- 	  the new channel.
+	  to store the Id of the current thread in the 'ChannelState' of
+	  the new channel.
 
 	* generic/tclIO.c (Tcl_SpliceChannel, lines 2265-2270): Modified
- 	  in the same manner as 'Tcl_CreateChannel' as the channel will be
- 	  managed by the current thread afterward.
+	  in the same manner as 'Tcl_CreateChannel' as the channel will be
+	  managed by the current thread afterward.
 
 	* generic/tclIO.c   (Tcl_GetChannelThread, lines 1478-1503):
 	* generic/tcl.decls (Tcl_GetChannelThread, lines 1504-1506): New
- 	  API function to retrieve the Id of the managing thread from a
- 	  channel. Implementation and declaration.
+	  API function to retrieve the Id of the managing thread from a
+	  channel. Implementation and declaration.
 
 	* generic/tclTest.c (TestChannelCmd, lines 4520-4532): Added
- 	  subcommand 'mthread' to query a channel about its managing
- 	  thread.
+	  subcommand 'mthread' to query a channel about its managing
+	  thread.
 
 2001-03-29  Mo DeJong  <mdejong@redhat.com>
 
@@ -6636,11 +6642,11 @@
 
 	* unix/tclUnixPipe.c (TclpCreateTempFile): prevent potential race
 	condition and security leak in tmp filename creation.
- 	(max) [Patch #402924]
+	(max) [Patch #402924]
 
 	* unix/configure:
 	* unix/tcl.m4: corrected IRIX-5.x config to not use -n32.
- 	(english) [Patch #403626]
+	(english) [Patch #403626]
 
 	* unix/tclUnixThrd.c (Tcl_ConditionWait): fixed handling of
 	timeout for threads (corrects excessive CPU usage issue for Tk on
@@ -6677,7 +6683,7 @@
 	resultPtr to prevent possible corruption.
 
 	* generic/tclNamesp.c (Tcl_Import): Correctly freed a DString.
- 	(lavana) [Patch #403755]
+	(lavana) [Patch #403755]
 
 2001-03-15  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 1f80829..1375b20 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -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: tclExecute.c,v 1.75 2002/06/20 14:47:38 msofer Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.76 2002/07/10 08:25:59 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -5413,7 +5413,7 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
 	    } else if (mathFuncPtr->argTypes[k] == TCL_WIDE_INT) {
 		args[k].type = TCL_WIDE_INT;
 		args[k].wideValue = Tcl_LongAsWide(i);
-#endif /* TCL_WIDE_INT_IS_LONG */
+#endif /* !TCL_WIDE_INT_IS_LONG */
 	    } else {
 		args[k].type = TCL_INT;
 		args[k].intValue = i;
@@ -5431,7 +5431,7 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
 		args[k].type = TCL_WIDE_INT;
 		args[k].wideValue = w;
 	    }
-#endif /* TCL_WIDE_INT_IS_LONG */
+#endif /* !TCL_WIDE_INT_IS_LONG */
 	} else {
 	    d = valuePtr->internalRep.doubleValue;
 	    if (mathFuncPtr->argTypes[k] == TCL_INT) {
@@ -5441,7 +5441,7 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
 	    } else if (mathFuncPtr->argTypes[k] == TCL_WIDE_INT) {
 		args[k].type = TCL_WIDE_INT;
 		args[k].wideValue = Tcl_DoubleAsWide(d);
-#endif /* TCL_WIDE_INT_IS_LONG */
+#endif /* !TCL_WIDE_INT_IS_LONG */
 	    } else {
 		args[k].type = TCL_DOUBLE;
 		args[k].doubleValue = d;
@@ -5475,6 +5475,10 @@ ExprCallMathFunc(interp, eePtr, objc, objv)
     
     if (funcResult.type == TCL_INT) {
 	PUSH_OBJECT(Tcl_NewLongObj(funcResult.intValue));
+#ifndef TCL_WIDE_INT_IS_LONG
+    } else if (funcResult.type == TCL_WIDE_INT) {
+	PUSH_OBJECT(Tcl_NewWideIntObj(funcResult.wideValue));
+#endif /* !TCL_WIDE_INT_IS_LONG */
     } else {
 	d = funcResult.doubleValue;
 	if (IS_NAN(d) || IS_INF(d)) {
diff --git a/tests/expr.test b/tests/expr.test
index c5b794a..4e0f18b 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -10,20 +10,16 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: expr.test,v 1.14 2001/12/06 10:59:18 dkf Exp $
+# RCS: @(#) $Id: expr.test,v 1.15 2002/07/10 08:25:59 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
-if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
-    set gotT1 0
-    puts "This application hasn't been compiled with the \"T1\" and"
-    puts "\"T2\" math functions, so I'll skip some of the expr tests."
-} else {
-    set gotT1 1
-}
+testConstraint registeredMathFuncs [expr {
+    ([catch {expr T1()} msg] != 1) || ($msg ne {unknown math function "T1"})
+}]
 
 # procedures used below
 
@@ -630,24 +626,36 @@ test expr-15.6 {CompileMathFuncCall: missing ')'} {
 } {syntax error in expression "sin(1": missing close parenthesis at end of function call
     while compiling
 "expr sin(1"}
-if $gotT1 {
-    test expr-15.7 {CompileMathFuncCall: call registered math function} {
-	expr 2*T1()
-    } 246
-    test expr-15.8 {CompileMathFuncCall: call registered math function} {
-	expr T2()*3
-    } 1035
-
-    test expr-15.9 {CompileMathFuncCall: call registered math function} {
-	expr T3(21, 37)
-    } 37
-    test expr-15.10 {CompileMathFuncCall: call registered math function} {
-	expr T3(21.2, 37)
-    } 37.0
-    test expr-15.11 {CompileMathFuncCall: call registered math function} {
-	expr T3(-21.2, -17.5)
-    } -17.5
-}
+test expr-15.7 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+    expr 2*T1()
+} 246
+test expr-15.8 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+    expr T2()*3
+} 1035
+test expr-15.9 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+    expr T3(21, 37)
+} 37
+test expr-15.10 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+    expr T3(21.2, 37)
+} 37.0
+test expr-15.11 {CompileMathFuncCall: call registered math function} {registeredMathFuncs} {
+    expr T3(-21.2, -17.5)
+} -17.5
+test expr-15.12 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+    expr T3(21, wide(37))
+} 37
+test expr=15.13 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+    expr T3(wide(21), 37)
+} 37
+test expr=15.14 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+    expr T3(wide(21), wide(37))
+} 37
+test expr-15.15 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+    expr T3(21.0, wide(37))
+} 37.0
+test expr=15.16 {ExprCallMathFunc: call registered math function} {registeredMathFuncs} {
+    expr T3(wide(21), 37.0)
+} 37.0
 
 test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
     catch {unset a}