summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2002-07-10 08:25:59 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2002-07-10 08:25:59 (GMT)
commit2bd24907d1762ded15a5d294dcc6ad03ed0fd787 (patch)
tree9b1cfa200e4217a99e49898d99a6161a96eb4c66
parent02a6e9afc2955f7bd59537c5a65a6b024a55e796 (diff)
downloadtcl-2bd24907d1762ded15a5d294dcc6ad03ed0fd787.zip
tcl-2bd24907d1762ded15a5d294dcc6ad03ed0fd787.tar.gz
tcl-2bd24907d1762ded15a5d294dcc6ad03ed0fd787.tar.bz2
Fix for bug 579284; registered math funcs can now correctly return wide-ints.
-rw-r--r--ChangeLog70
-rw-r--r--generic/tclExecute.c12
-rw-r--r--tests/expr.test60
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}