diff options
| author | dgp <dgp@users.sourceforge.net> | 2008-06-25 15:56:06 (GMT) |
|---|---|---|
| committer | dgp <dgp@users.sourceforge.net> | 2008-06-25 15:56:06 (GMT) |
| commit | 7f06d7ab2eacd2fe28993b637a64ae8f19d3e3f6 (patch) | |
| tree | 28054fcddf0708d2dc642db27633c09188f3fbdf | |
| parent | ac5ee6e44ae540a1ef6e1d53ebe6f4d9820413fc (diff) | |
| download | tcl-7f06d7ab2eacd2fe28993b637a64ae8f19d3e3f6.zip tcl-7f06d7ab2eacd2fe28993b637a64ae8f19d3e3f6.tar.gz tcl-7f06d7ab2eacd2fe28993b637a64ae8f19d3e3f6.tar.bz2 | |
merge updates from 8.5 branch
57 files changed, 2616 insertions, 446 deletions
@@ -1,5 +1,350 @@ +2008-06-25 Pat Thoyts <patthoyts@users.sourceforge.net> + + * win/rules.vc: Backported fix for dde/registry versions and + * win/makefile.vc: the staticpkg build option + +2008-06-24 Don Porter <dgp@users.sourceforge.net> + + * generic/tclPathObj.c: Fixed some internals management in the "path" + Tcl_ObjType for the empty string value. Problem led to a crash in + the command [glob -dir {} a]. [Bug 1999176]. + +2008-06-23 Don Porter <dgp@users.sourceforge.net> + + * generic/tclPathObj.c: Fixed bug in Tcl_GetTranslatedPath() when + operating on the "Special path" variant of the "path" Tcl_ObjType + intrep. A full normalization was getting done, in particular, coercing + relative paths to absolute, contrary to what the function of + producing the "translated path" is supposed to do. [Bug 1972879]. + +2008-06-19 Don Porter <dgp@users.sourceforge.net> + + * changes: Update for 8.5.3 release. + + * generic/tclInterp.c: Fixed completely boneheaded mistake that + * tests/interp.test: [interp bgerror $slave] and [$slave bgerror] + would always act like [interp bgerror {}]. [Bug 1999035]. + + * tests/chanio.test: Corrected flawed tests revealed by a -debug 1 + * tests/event.test: -singleproc 1 test suite run. + * tests/io.test: + +2008-06-19 Don Porter <dgp@users.sourceforge.net> + + * changes: Updates for 8.5.3 release. + +2008-06-17 Andreas Kupries <andreask@activestate.com> + + * generic/tclClock.c (ClockConvertlocaltoutcObjCmd): Removed left + over debug output. + +2008-06-17 Andreas Kupries <andreask@activestate.com> + + * doc/tm.n: Followup to changelog entry 2008-03-18 regarding + ::tcl::tm::Defaults. Updated the documentation to not only mention + the new (underscored) form of environment variable names, but make + it the encouraged form as well. See [Bug 1914604]. + +2006-06-17 Kevin Kenny <kennykb@acm.org> + + * generic/tclClock.c (ConvertLocalToUTC): + * tests/clock.test (clock-63.1): Fixed a bug where the + internal ConvertLocalToUTC command segfaulted if passed a + dictionary without the 'localSeconds' key. To the best of + my knowledge, the bug was not observable in the [clock] + command itself. + +2008-06-16 Andreas Kupries <andreask@activestate.com> + + * generic/tclCmdIL.c (TclInfoFrame): Backport of fix made on the + * tests/info.test: head branch :: Moved the code looking up the + information for key 'proc' out of the TCL_LOCATION_BC branch to + after the switch, this is common to all frame types. Updated the + testsuite to match. This was exposed by the 2008-06-08 commit + (Miguel), switching uplevel from direct eval to compilation. Fixes + [Bug 1987851]. + +2008-06-12 Daniel Steffen <das@users.sourceforge.net> + + * unix/Makefile.in: add complete deps on tclDTrace.h. + + * unix/Makefile.in: clean generated tclDTrace.h file. + * unix/configure.in (SunOS): fix static DTrace-enabled build. + + * unix/tcl.m4 (SunOS-5.11): fix 64bit amd64 support with gcc & Sun cc. + * unix/configure: autoconf-2.59 + + * macosx/Tcl.xcodeproj/project.pbxproj: add debug configs with gcov, + and with corefoundation disabled; updates and cleanup for Xcode 3.1 and + for Leopard. + * macosx/Tcl.xcode/project.pbxproj: sync Tcl.xcodeproj changes. + * macosx/README: document new build configs. + +2008-05-26 Jeff Hobbs <jeffh@ActiveState.com> + + * tests/io.test (io-53.9): need to close chan before removing file. + +2008-05-23 Andreas Kupries <andreask@activestate.com> + + * win/tclWinChan.c (FileWideSeekProc): Accepted a patch by + Alexandre Ferrieux <ferrieux@users.sourceforge.net> to fix the + [Bug 1965787]. 'tell' now works for locations > 2 GB as well + instead of going negative. + + * generic/tclIO.c (Tcl_SetChannelBufferSize): Accepted a patch by + * tests/io.test: Alexandre Ferrieux <ferrieux@users.sourceforge.net> + * tests/chanio.test: to fix the [Bug 1969953]. Buffersize outside + of the supported range are now clipped to nearest boundary instead + of ignored. + +2008-05-22 Don Porter <dgp@users.sourceforge.net> + + * generic/tclNamesp.c (Tcl_LogCommandInfo): Restored ability to + handle the argument value length = -1. Thanks to Chris Darroch for + discovering the bug and providing the fix. [Bug 1968245]. + +2008-05-21 Don Porter <dgp@users.sourceforge.net> + + * generic/tclParse.c (ParseComment): The new TclParseAllWhiteSpace() + * tests/parse.test (parse-15.60): routine has no mechanism to + return the "incomplete" status of "\\\n" so calling this routine + anywhere that can be reached within a Tcl_ParseCommand() call is a + mistake. In particular, ParseComment() must not use it. [Bug 1968882]. + +2008-05-21 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclNamesp.c (Tcl_SetNamespaceUnknownHandler): Corrected odd + logic for handling installation of namespace unknown handlers which + could lead too very strange things happening in the error case. + +2008-05-16 Miguel Sofer <msofer@users.sf.net> + + * generic/tclCompile.c: fix crash with tcl_traceExec. Found and + fixed by Alexander Pasadyn [Bug 1964803]. + +2008-05-07 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclCompCmds.c (TclCompileDictAppendCmd): Fix silly + off-by-one error that caused a crash every time a compiled 'dict + append' with more than one value argument was used. Found by Colin + McCormack. + +2008-04-26 Zoran Vasiljevic <vasiljevic@users.sourceforge.net> + + * generic/tclAsync.c: Tcl_AsyncDelete(): panic if attempt to locate + handler token fails. Happens when some other thread attempts to delete + somebody else's token. + + Also, panic early if we find out the wrong thread attempting to delete + the async handler (common trap). As, only the one that created the + handler is allowed to delete it. + +2008-04-24 Andreas Kupries <andreask@activestate.com> + + * tests/ioCmd.test: Extended testsuite for reflected channel + implementation. Added test cases about how it handles if the rug is + pulled out from under a channel (= killing threads, interpreters + containing the tcl command for a channel, and channel sitting in a + different interpreter/thread.) + + * generic/tclIORChan.c: Fixed the bugs exposed by the new testcases, + redone most of the cleanup and exit handling. + +2008-04-15 Andreas Kupries <andreask@activestate.com> + + * generic/tclIO.c (CopyData): Applied another patch by Alexandre + * io.test (io-53.8a): Ferrieux <ferrieux@users.sourceforge.net>, + * chanio.test (chan-io-53.8a): to shift EOF handling to the async + part of the command if a callback is specified, should the channel + be at EOF already when fcopy is called. Testcase by myself. + +2008-04-14 Kevin B. Kenny <kennykb@acm.org> + + * unix/tclUnixTime.c (NativeGetTime): Removed obsolete use of + 'struct timezone' in the call to 'gettimeofday'. [Bug 1942197]. + * tests/clock.test (clock-33.5, clock-33.5a, clock-33.8, clock-33.8a): + Added comments to the test that it can fail on a heavily loaded + system. + +2008-04-11 Don Porter <dgp@users.sourceforge.net> + + * generic/tcl.h: Bump version number to 8.5.3b1 to distinguish + * library/init.tcl: CVS development snapshots from the 8.5.2 and + * unix/configure.in: 8.5.3 releases. + * unix/tcl.spec: + * win/configure.in: + * README + + * unix/configure: autoconf (2.59) + * win/configure: + +2008-04-10 Andreas Kupries <andreask@activestate.com> + + * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Keeping check for negative + values, changed to not be an error, but behave like the special + value -1 (copy all, default). + + * tests/iocmd.test (iocmd-15.{12,13}): Removed. + + * tests/io.test (io-52.5{,a,b}): Reverted last change, added + * tests/chanio.test (chan-io-52.5{,a,b}): comment regarding the + meaning of -1, added two more testcases for other negative values, + and input wrapped to negative. + +2008-04-09 Andreas Kupries <andreask@activestate.com> + + * tests/chanio.test (chan-io-52.5): Removed '-size -1' from test, + * tests/io.test (io-52.5): does not seem to have any bearing, and + was an illegal value. + + * generic/tclIOCmd.c (Tcl_FcopyObjCmd): Added checking of -size + * tests/ioCmd.test (iocmd-15.{13,14}): value to reject negative + values, and values overflowing 32-bit signed. [Bug 1557855]. Basic + patch by Alexandre Ferrieux <ferrieux@users.sourceforge.net>, with + modifications from me to separate overflow from true negative + value. Extended testsuite. + +2008-04-08 Andreas Kupries <andreask@activestate.com> + + * tests/io.test (io-53.8): Fixed ordering of vwait and after + cancel. cancel has to be done after the vwait completes. + +2008-04-09 Daniel Steffen <das@users.sourceforge.net> + + * tests/chanio.test (chan-io-53.8,53.9,53.10): fix typo & quoting for + * tests/io.test (io-53.8,53.9,53.10): spaces in builddir path + +2008-04-07 Andreas Kupries <andreask@activestate.com> + + * tests/io.test (io-53.10): Testcase for bi-directionaly fcopy. + * tests/chanio.test: + * generic/tclIO.c: Additional changes to data structures for fcopy + * generic/tclIO.h: and channels to perform proper cleanup in case + of a channel having two background copy operations running as is + now possible. + + * tests/io.test (io-53.10): Testcase for bi-directionaly fcopy. + * generic/tclIO.c: Additional changes to data structures for fcopy + and channels to perform proper cleanup in case of a channel having + two background copy operations running as is now possible. + +2008-04-07 Andreas Kupries <andreask@activestate.com> + + * generic/tclIO.c (BUSY_STATE, CheckChannelErrors, + TclCopyChannel): New macro, and the places using it. This change + allows for bi-directional fcopy on channels. [Bug 1350564]. Thanks + to Alexandre Ferrieux <ferrieux@users.sourceforge.net> for the + patch. + +2008-04-07 Reinhard Max <max@suse.de> + + * generic/tclStringObj.c (Tcl_AppendFormatToObj): Fix [format {% d}] + so that it behaves the same way as in 8.4 and as C's printf(). + * tests/format.test: Add a test for '% d' and '%+d'. + +2008-04-05 Kevin B. Kenny <kennykb@acm.org> + + * tests/chanio.test (chan-io-53.9): + * tests/io.test (io-53.9): Made test cleanup robust against + the possibility of slow process shutdown on Windows. + + * win/tcl.m4: Added -D_CRT_SECURE_NO_DEPRECATE and + -DCRT_NONSTDC_NO_DEPRECATE to the MSVC compilation flags + so that the compilation doesn't barf on perfectly reasonable + Posix system calls. + * win/configure: Manually patched (don't have the right autoconf + to hand). + + * win/tclWinFile.c: (WinSymLinkDirectory): Fixed a problem that + Tcl was creating an NTFS junction point (IO_REPARSE_TAG_MOUNT_POINT) + but filling in the union member for a Vista symbolic link. + We had gotten away with this error because the union member + (SymbolicLinkReparseBuffer) was misdefined in this file + and in the 'winnt.h' in early versions of MinGW. MinGW 3.4.2 + has the correct definition of SymbolicLinkReparseBuffer, exposing + the mismatch, and making tests cmdAH-19.4.1, fCmd-28.*, and + filename-11.* fail. + +2008-04-04 Andreas Kupries <andreask@activestate.com> + + * tests/io.test (io-53.9): Added testcase for [Bug 780533], based + * tests/chanio.test: on Alexandre's test script. Also fixed + problem with timer in preceding test, was not canceled properly in + the ok case. + +2008-04-04 Andreas Kupries <andreask@activestate.com> + + * generic/tclIORChan.c (ReflectOutput): Allow zero return from + write when input was zero-length anyway. Otherwise keept it an + error, and separate the message from 'written too much'. + + * tests/ioCmd.test (iocmd-24.6): Testcase updated for changed + message. + + * generic/tclIORChan.c (ReflectClose): Added missing removal of + the now closed channel from the reflection map. Before we could + crash the system by invoking 'chan postevent' on a closed + reflected channel, dereferencing the dangling pointer in the map. + + * tests/ioCmd.test (iocmd-31.8): Testcase for the above. + +2008-04-03 Andreas Kupries <andreask@activestate.com> + + * generic/tclIO.c (CopyData): Applied patch [Bug 1932639] to + * tests/io.test: prevent fcopy from calling -command synchronously + * tests/chanio.test: the first time. Thanks to Alexandre Ferrieux + <ferrieux@users.sourceforge.net> for report and patch. + +2008-04-02 Andreas Kupries <andreask@activestate.com> + + * generic/tclIO.c (CopyData): Applied patch for the fcopy problem + [Bug 780533], with many thanks to Alexandre Ferrieux + <ferrieux@users.sourceforge.net> for tracking it down and + providing a solution. Still have to convert his test script into a + proper test case. + +2008-04-01 Andreas Kupries <andreask@activestate.com> + + * generic/tclStrToD.c: Applied patch for [Bug 1839067] (fp + * unix/tcl.m4: rounding setup on solaris x86, native cc), provided + * unix/configure: by Michael Schlenker. configure regen'd. + +2008-04-01 Don Porter <dgp@users.sourceforge.net> + + * generic/tclStubLib.c (Tcl_InitStubs): Added missing error message. + * generic/tclPkg.c (Tcl_PkgInitStubsCheck): + +2008-03-30 Kevin Kenny <kennykb@acm.org> + + * generic/tclInt.h (TclIsNaN): + * unix/configure.in: Added code to the configurator to check for + a standard isnan() macro and use it if one + is found. This change avoids bugs where + the test of ((d) != (d)) is optimized away + by an overaggressive compiler. [Bug 1783544] + * generic/tclObj.c: Added missing #include <math.h> needed to + locate isnan() after the above change. + + * unix/configure: autoconf-2.61 + + * tests/mathop.test (mathop-25.9, mathop-25.14): Modified tests + to deal with (slightly buggy) math libraries in which pow() + returns an incorrectly rounded result. [Bug 1808174] + 2008-03-26 Don Porter <dgp@users.sourceforge.net> + *** 8.5.2 TAGGED FOR RELEASE *** + + * generic/tcl.h: Bump to 8.5.2 for release. + * library/init.tcl: + * tools/tcl.wse.in: + * unix/configure.in: + * unix/tcl.spec: + * win/configure.in: + + * unix/configure: autoconf-2.59 + * win/configure: + * changes: Updated for 8.5.2 release. 2008-03-28 Donal K. Fellows <dkf@users.sf.net> @@ -181,7 +526,7 @@ Darwin 9 even when TclpCreateProcess() uses vfork(). * macosx/Tcl.xcodeproj/project.pbxproj: Add support for Xcode 3.1 and - * macosx/Tcl.xcodeproj/default.pbxuser: targets for building with + * macosx/Tcl.xcodeproj/default.pbxuser: configs for building with * macosx/Tcl-Common.xcconfig: gcc-4.2 and llvm-gcc-4.2. * unix/tclUnixPort.h: Workaround vfork() problems @@ -2933,7 +3278,7 @@ * generic/tclInt.h: fix warning when building threaded with -DPURIFY. * macosx/Tcl.xcodeproj/project.pbxproj: add 'DebugUnthreaded' & - * macosx/Tcl.xcodeproj/default.pbxuser: 'DebugLeaks' targets and env + * macosx/Tcl.xcodeproj/default.pbxuser: 'DebugLeaks' configs and env var settings needed to run the 'leaks' tool. 2007-05-07 Don Porter <dgp@users.sourceforge.net> @@ -1,11 +1,11 @@ README: Tcl - This is the Tcl 8.5.2 source distribution. + This is the Tcl 8.5.3 source distribution. Tcl/Tk is also available through NetCVS: http://tcl.sourceforge.net/ You can get any source release of Tcl from the file distributions link at the above URL. -RCS: @(#) $Id: README,v 1.59.2.8 2008/03/07 22:05:01 dgp Exp $ +RCS: @(#) $Id: README,v 1.59.2.9 2008/06/25 15:56:08 dgp Exp $ Contents -------- @@ -1,6 +1,6 @@ Recent user-visible changes to Tcl: -RCS: @(#) $Id: changes,v 1.116.2.13 2008/03/28 16:48:06 dgp Exp $ +RCS: @(#) $Id: changes,v 1.116.2.14 2008/06/25 15:56:08 dgp Exp $ 1. No more [command1] [command2] construct for grouping multiple commands on a single command line. @@ -7190,3 +7190,31 @@ variables without "." added to customization hooks (kupries) 2008-03-27 clock tzdata updated to Olson's tzdata2008b (kenny) --- Released 8.5.2, March 28, 2008 --- See ChangeLog for details --- + +2008-03-30 (bug fix)[1783544] more robust TclIsNaN() (kenny,teterin) + +2008-04-01 (bug fix)[1839067] FP round fix for Solaris/x86 (kupries,schlenker) + +2008-04-02 (bug fix)[780533,1932639] [fcopy] callbacks unreliable (ferrieux) + +2008-04-04 (bug fix) [chan postevent] crash (kupries) + +2008-04-07 (bug fix) Fix broken [format {% d}] (max) + +2008-04-07 (bug fix)[1350564] Bi-directional [fcopy] now supported (ferrieux) + +2008-05-07 (bug fix) [dict append] crash (mccormack,fellows) + +2008-05-21 (bug fix)[1968882] [info complete "\\\n"] => 0 (porter) + +2008-05-22 (bug fix)[1968245] Tcl_LogCommandInfo() accept length=-1 (darroch) + +2008-05-23 (bug fix)[1965787] 32-bit overflow in [tell] result (ferrieux) + +2008-06-12 (platform support) Solaris static build with DTrace (steffen) + +2008-06-12 (platform support) Solaris/amd64 gcc 64bit support (steffen) + +2008-06-20 (bug fix)[1999035] make [interp bgerror $i] act in $i (porter) + +--- Released 8.5.3, June ??, 2008 --- See ChangeLog for details --- diff --git a/doc/Namespace.3 b/doc/Namespace.3 index 7bc77f4..2d5c337 100644 --- a/doc/Namespace.3 +++ b/doc/Namespace.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: Namespace.3,v 1.8 2006/02/01 18:27:43 dgp Exp $ +'\" RCS: @(#) $Id: Namespace.3,v 1.8.8.1 2008/06/25 15:56:09 dgp Exp $ '\" '\" Note that some of these functions do not seem to belong, but they '\" were all introduced with the same TIP (#139) @@ -13,7 +13,7 @@ .TH Tcl_Namespace 3 8.5 Tcl "Tcl Library Procedures" .BS .SH NAME -Tcl_AppendExportList, Tcl_CreateNamespace, Tcl_DeleteNamespace, Tcl_Export, Tcl_FindCommand, Tcl_FindNamespace, Tcl_ForgetImport, Tcl_GetCurrentNamespace, Tcl_GetGloblaNamespace, Tcl_GetNamespaceUnknownHandler, Tcl_Import, Tcl_SetNamespaceUnknownHandler \- manipulate namespaces +Tcl_AppendExportList, Tcl_CreateNamespace, Tcl_DeleteNamespace, Tcl_Export, Tcl_FindCommand, Tcl_FindNamespace, Tcl_ForgetImport, Tcl_GetCurrentNamespace, Tcl_GetGlobalNamespace, Tcl_GetNamespaceUnknownHandler, Tcl_Import, Tcl_SetNamespaceUnknownHandler \- manipulate namespaces .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -1,10 +1,10 @@ '\" -'\" Copyright (c) 2004 Andreas Kupries <andreas_kupries@users.sourceforge.net> +'\" Copyright (c) 2004-2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: tm.n,v 1.6.2.2 2008/01/23 16:42:17 dgp Exp $ +'\" RCS: @(#) $Id: tm.n,v 1.6.2.3 2008/06/25 15:56:09 dgp Exp $ '\" .so man.macros .TH tm n 8.5 Tcl "Tcl Built-In Commands" @@ -256,13 +256,20 @@ Note that this is always a single entry because \fIX\fR is always a specific value (the current major version of Tcl). .SS "USER SPECIFIC PATHS" .TP -\fB$::env(TCL\fIX\fB.\fIy\fB_TM_PATH)\fR +\fB$::env(TCL\fIX\fB_\fIy\fB_TM_PATH)\fR . A list of paths, separated by either \fB:\fR (Unix) or \fB;\fR (Windows). This is user and site specific as this environment variable can be set not only by the user's profile, but by system configuration scripts as well. -.RS +.TP +\fB$::env(TCL\fIX\fB.\fIy\fB_TM_PATH)\fR +. +Same meaning and content as the previous variable. However the use of +dot '.' to separate major and minor version number makes this name +less to non-portable and its use is discouraged. Support of this +variable has been kept only for backward compatibility with the +original specification, i.e. TIP 189. .PP These paths are seen and therefore shared by all Tcl shells in the \fB$::env(PATH)\fR of the user. @@ -271,11 +278,11 @@ Note that \fIX\fR and \fIy\fR follow the general rules set out above. In other words, Tcl 8.4, for example, will look at these 5 environment variables: .CS -\fB$::env(TCL8.4_TM_PATH)\fR -\fB$::env(TCL8.3_TM_PATH)\fR -\fB$::env(TCL8.2_TM_PATH)\fR -\fB$::env(TCL8.1_TM_PATH)\fR -\fB$::env(TCL8.0_TM_PATH)\fR +\fB$::env(TCL8.4_TM_PATH)\fR \fB$::env(TCL8_4_TM_PATH)\fR +\fB$::env(TCL8.3_TM_PATH)\fR \fB$::env(TCL8_3_TM_PATH)\fR +\fB$::env(TCL8.2_TM_PATH)\fR \fB$::env(TCL8_2_TM_PATH)\fR +\fB$::env(TCL8.1_TM_PATH)\fR \fB$::env(TCL8_1_TM_PATH)\fR +\fB$::env(TCL8.0_TM_PATH)\fR \fB$::env(TCL8_0_TM_PATH)\fR .CE .RE .SH "SEE ALSO" diff --git a/generic/tcl.h b/generic/tcl.h index 6205dfc..fb0e972 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tcl.h,v 1.231.2.17 2008/03/26 20:08:55 dgp Exp $ + * RCS: @(#) $Id: tcl.h,v 1.231.2.18 2008/06/25 15:56:09 dgp Exp $ */ #ifndef _TCL @@ -60,10 +60,10 @@ extern "C" { #define TCL_MAJOR_VERSION 8 #define TCL_MINOR_VERSION 5 #define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE -#define TCL_RELEASE_SERIAL 2 +#define TCL_RELEASE_SERIAL 3 #define TCL_VERSION "8.5" -#define TCL_PATCH_LEVEL "8.5.2" +#define TCL_PATCH_LEVEL "8.5.3b1" /* * The following definitions set up the proper options for Windows compilers. diff --git a/generic/tclAsync.c b/generic/tclAsync.c index 7d27ffa..8a0691d 100644 --- a/generic/tclAsync.c +++ b/generic/tclAsync.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: tclAsync.c,v 1.10.6.1 2007/11/12 19:18:13 dgp Exp $ + * RCS: @(#) $Id: tclAsync.c,v 1.10.6.2 2008/06/25 15:56:09 dgp Exp $ */ #include "tclInt.h" @@ -259,6 +259,13 @@ Tcl_AsyncInvoke( * Side effects: * The state associated with the handler is deleted. * + * Failure to locate the handler in current thread private list + * of async handlers will result in panic; exception: the list + * is already empty (potential trouble?). + * Consequently, threads should create and delete handlers + * themselves. I.e. a handler created by one should not be + * deleted by some other thread. + * *---------------------------------------------------------------------- */ @@ -268,31 +275,40 @@ Tcl_AsyncDelete( { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); AsyncHandler *asyncPtr = (AsyncHandler *) async; - AsyncHandler *prevPtr; + AsyncHandler *prevPtr, *thisPtr; + + /* + * Assure early handling of the constraint + */ + + if (asyncPtr->originThrdId != Tcl_GetCurrentThread()) { + Tcl_Panic("Tcl_AsyncDelete: async handler deleted by the wrong thread"); + } /* - * Conservatively check the existence of the linked list of - * registered handlers, as we may come at this point even - * when the TSD's for the current thread have been already - * garbage-collected. + * If we come to this point when TSD's for the current + * thread have already been garbage-collected, we are + * in the _serious_ trouble. OTOH, we tolerate calling + * with already cleaned-up handler list (should we?). */ Tcl_MutexLock(&tsdPtr->asyncMutex); - if (tsdPtr->firstHandler != NULL ) { - if (tsdPtr->firstHandler == asyncPtr) { + if (tsdPtr->firstHandler != NULL) { + prevPtr = thisPtr = tsdPtr->firstHandler; + while (thisPtr != NULL && thisPtr != asyncPtr) { + prevPtr = thisPtr; + thisPtr = thisPtr->nextPtr; + } + if (thisPtr == NULL) { + Tcl_Panic("Tcl_AsyncDelete: cannot find async handler"); + } + if (asyncPtr == tsdPtr->firstHandler) { tsdPtr->firstHandler = asyncPtr->nextPtr; - if (tsdPtr->firstHandler == NULL) { - tsdPtr->lastHandler = NULL; - } } else { - prevPtr = tsdPtr->firstHandler; - while (prevPtr->nextPtr != asyncPtr) { - prevPtr = prevPtr->nextPtr; - } prevPtr->nextPtr = asyncPtr->nextPtr; - if (tsdPtr->lastHandler == asyncPtr) { - tsdPtr->lastHandler = prevPtr; - } + } + if (asyncPtr == tsdPtr->lastHandler) { + tsdPtr->lastHandler = prevPtr; } } Tcl_MutexUnlock(&tsdPtr->asyncMutex); diff --git a/generic/tclClock.c b/generic/tclClock.c index cb630a6..d6e5f9e 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclClock.c,v 1.61.2.2 2008/03/07 22:05:02 dgp Exp $ + * RCS: @(#) $Id: tclClock.c,v 1.61.2.3 2008/06/25 15:56:09 dgp Exp $ */ #include "tclInt.h" @@ -333,12 +333,19 @@ ClockConvertlocaltoutcObjCmd( return TCL_ERROR; } dict = objv[1]; - if ((Tcl_DictObjGet(interp, dict, literals[LIT_LOCALSECONDS], - &secondsObj) != TCL_OK) - || (Tcl_GetWideIntFromObj(interp, secondsObj, - &(fields.localSeconds)) != TCL_OK) - || (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) - || ConvertLocalToUTC(interp, &fields, objv[2], changeover)) { + if (Tcl_DictObjGet(interp, dict, literals[LIT_LOCALSECONDS], + &secondsObj)!= TCL_OK) { + return TCL_ERROR; + } + if (secondsObj == NULL) { + Tcl_SetObjResult(interp, Tcl_NewStringObj("key \"localseconds\" not " + "found in dictionary", -1)); + return TCL_ERROR; + } + if ((Tcl_GetWideIntFromObj(interp, secondsObj, + &(fields.localSeconds)) != TCL_OK) + || (TclGetIntFromObj(interp, objv[3], &changeover) != TCL_OK) + || ConvertLocalToUTC(interp, &fields, objv[2], changeover)) { return TCL_ERROR; } diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 09c5be8..92085be 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdIL.c,v 1.115.2.14 2008/03/26 20:08:56 dgp Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.115.2.15 2008/06/25 15:56:09 dgp Exp $ */ #include "tclInt.h" @@ -1125,6 +1125,8 @@ TclInfoFrame( "eval", "eval", "eval", "precompiled", "source", "proc" }; Tcl_Obj *tmpObj; + Proc *procPtr = + framePtr->framePtr ? framePtr->framePtr->procPtr : NULL; /* * Pull the information and construct the dictionary to return, as list. @@ -1181,8 +1183,6 @@ TclInfoFrame( * Execution of bytecode. Talk to the BC engine to fill out the frame. */ - Proc *procPtr = - framePtr->framePtr ? framePtr->framePtr->procPtr : NULL; CmdFrame *fPtr; fPtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame)); @@ -1216,44 +1216,6 @@ TclInfoFrame( ADD_PAIR("cmd", Tcl_NewStringObj(fPtr->cmd.str.cmd, fPtr->cmd.str.len)); - - if (procPtr != NULL) { - Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr; - - if (namePtr) { - /* - * This is a regular command. - */ - - char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr); - char *nsName = procPtr->cmdPtr->nsPtr->fullName; - - ADD_PAIR("proc", Tcl_NewStringObj(nsName, -1)); - - if (strcmp(nsName, "::") != 0) { - Tcl_AppendToObj(lv[lc-1], "::", -1); - } - Tcl_AppendToObj(lv[lc-1], procName, -1); - } else if (procPtr->cmdPtr->clientData) { - ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData; - int i; - - /* - * This is a non-standard command. Luckily, it's told us how - * to render extra information about its frame. - */ - - for (i=0 ; i<efiPtr->length ; i++) { - lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1); - if (efiPtr->fields[i].proc) { - lv[lc++] = efiPtr->fields[i].proc( - efiPtr->fields[i].clientData); - } else { - lv[lc++] = efiPtr->fields[i].clientData; - } - } - } - } TclStackFree(interp, fPtr); break; } @@ -1282,6 +1244,49 @@ TclInfoFrame( } /* + * 'proc'. Common to all frame types. Conditional on having an associated + * Procedure CallFrame. + */ + + if (procPtr != NULL) { + Tcl_HashEntry *namePtr = procPtr->cmdPtr->hPtr; + + if (namePtr) { + /* + * This is a regular command. + */ + + char *procName = Tcl_GetHashKey(namePtr->tablePtr, namePtr); + char *nsName = procPtr->cmdPtr->nsPtr->fullName; + + ADD_PAIR("proc", Tcl_NewStringObj(nsName, -1)); + + if (strcmp(nsName, "::") != 0) { + Tcl_AppendToObj(lv[lc-1], "::", -1); + } + Tcl_AppendToObj(lv[lc-1], procName, -1); + } else if (procPtr->cmdPtr->clientData) { + ExtraFrameInfo *efiPtr = procPtr->cmdPtr->clientData; + int i; + + /* + * This is a non-standard command. Luckily, it's told us how to + * render extra information about its frame. + */ + + for (i=0 ; i<efiPtr->length ; i++) { + lv[lc++] = Tcl_NewStringObj(efiPtr->fields[i].name, -1); + if (efiPtr->fields[i].proc) { + lv[lc++] = + efiPtr->fields[i].proc(efiPtr->fields[i].clientData); + } else { + lv[lc++] = efiPtr->fields[i].clientData; + } + } + } + } + + /* * 'level'. Common to all frame types. Conditional on having an associated * _visible_ CallFrame. */ diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index e553103..60f3167 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.21 2008/03/26 20:08:56 dgp Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.22 2008/06/25 15:56:09 dgp Exp $ */ #include "tclInt.h" @@ -1215,7 +1215,7 @@ TclCompileDictAppendCmd( tokenPtr = TokenAfter(tokenPtr); } if (parsePtr->numWords > 4) { - TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-2, envPtr); + TclEmitInstInt1(INST_CONCAT1, parsePtr->numWords-3, envPtr); } /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index fbc0459..9c10b03 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.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: tclCompile.c,v 1.117.2.17 2008/01/25 16:43:52 dgp Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.117.2.18 2008/06/25 15:56:10 dgp Exp $ */ #include "tclInt.h" @@ -3342,7 +3342,7 @@ TclPrintSource( TclNewObj(bufferObj); PrintSourceToObj(bufferObj, stringPtr, maxChars); - fprintf(outFile, TclGetString(bufferObj)); + fprintf(outFile, "%s", TclGetString(bufferObj)); Tcl_DecrRefCount(bufferObj); } #endif /* TCL_COMPILE_DEBUG */ diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 3f1f445..86222d3 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -13,7 +13,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.285.2.32 2008/03/26 20:08:56 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.285.2.33 2008/06/25 15:56:10 dgp Exp $ */ #include "tclInt.h" @@ -851,23 +851,36 @@ TclFinalizeExecution(void) /* * Auxiliary code to insure that GrowEvaluationStack always returns correctly - * aligned memory. This assumes that TCL_ALLOCALIGN is a multiple of the - * wordsize 'sizeof(Tcl_Obj *)'. + * aligned memory. + * + * WALLOCALIGN represents the alignment reqs in words, just as TCL_ALLOCALIGN + * represents the reqs in bytes. This assumes that TCL_ALLOCALIGN is a + * multiple of the wordsize 'sizeof(Tcl_Obj *)'. */ #define WALLOCALIGN \ (TCL_ALLOCALIGN/sizeof(Tcl_Obj *)) +/* + * OFFSET computes how many words have to be skipped until the next aligned + * word. Note that we are only interested in the low order bits of ptr, so + * that any possible information loss in PTR2INT is of no consequence. + */ + static inline int OFFSET( void *ptr) { int mask = TCL_ALLOCALIGN-1; int base = PTR2INT(ptr) & mask; - return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj**); + return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj *); } -#define MEMSTART(markerPtr) \ +/* + * Given a marker, compute where the following aligned memory starts. + */ + +#define MEMSTART(markerPtr) \ ((markerPtr) + OFFSET(markerPtr)) diff --git a/generic/tclIO.c b/generic/tclIO.c index d9f2d39..5f33501 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.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: tclIO.c,v 1.121.2.9 2008/01/23 16:42:18 dgp Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.121.2.10 2008/06/25 15:56:11 dgp Exp $ */ #include "tclInt.h" @@ -221,6 +221,11 @@ static Tcl_ObjType tclChannelType = { #define SET_CHANNELSTATE(objPtr, storePtr) \ ((objPtr)->internalRep.otherValuePtr = (void *) (storePtr)) +#define BUSY_STATE(st,fl) \ + ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \ + (((st)->csPtrW) && ((fl) & TCL_WRITABLE))) + +#define MAX_CHANNEL_BUFFER_SIZE (1024*1024) /* *--------------------------------------------------------------------------- @@ -1313,7 +1318,8 @@ Tcl_CreateChannel( statePtr->scriptRecordPtr = NULL; statePtr->bufSize = CHANNELBUFFER_DEFAULT_SIZE; statePtr->timer = NULL; - statePtr->csPtr = NULL; + statePtr->csPtrR = NULL; + statePtr->csPtrW = NULL; statePtr->outputStage = NULL; if ((statePtr->encoding != NULL) && (statePtr->flags & TCL_WRITABLE)) { @@ -1474,13 +1480,18 @@ Tcl_StackChannel( */ if ((mask & TCL_WRITABLE) != 0) { - CopyState *csPtr; + CopyState *csPtrR; + CopyState *csPtrW; + + csPtrR = statePtr->csPtrR; + statePtr->csPtrR = NULL; - csPtr = statePtr->csPtr; - statePtr->csPtr = NULL; + csPtrW = statePtr->csPtrW; + statePtr->csPtrW = NULL; if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) { - statePtr->csPtr = csPtr; + statePtr->csPtrR = csPtrR; + statePtr->csPtrW = csPtrW; if (interp) { Tcl_AppendResult(interp, "could not flush channel \"", Tcl_GetChannelName(prevChan), "\"", NULL); @@ -1488,7 +1499,8 @@ Tcl_StackChannel( return NULL; } - statePtr->csPtr = csPtr; + statePtr->csPtrR = csPtrR; + statePtr->csPtrW = csPtrW; } /* @@ -1620,13 +1632,18 @@ Tcl_UnstackChannel( */ if (statePtr->flags & TCL_WRITABLE) { - CopyState *csPtr; + CopyState *csPtrR; + CopyState *csPtrW; + + csPtrR = statePtr->csPtrR; + statePtr->csPtrR = NULL; - csPtr = statePtr->csPtr; - statePtr->csPtr = NULL; + csPtrW = statePtr->csPtrW; + statePtr->csPtrW = NULL; if (Tcl_Flush((Tcl_Channel) chanPtr) != TCL_OK) { - statePtr->csPtr = csPtr; + statePtr->csPtrR = csPtrR; + statePtr->csPtrW = csPtrW; /* * TIP #219, Tcl Channel Reflection API. @@ -1644,7 +1661,8 @@ Tcl_UnstackChannel( return TCL_ERROR; } - statePtr->csPtr = csPtr; + statePtr->csPtrR = csPtrR; + statePtr->csPtrW = csPtrW; } /* @@ -3087,7 +3105,8 @@ Tcl_ClearChannelHandlers( * Cancel any pending copy operation. */ - StopCopy(statePtr->csPtr); + StopCopy(statePtr->csPtrR); + StopCopy(statePtr->csPtrW); /* * Must set the interest mask now to 0, otherwise infinite loops @@ -6698,7 +6717,7 @@ CheckChannelErrors( * retrieving and transforming the data to copy. */ - if ((statePtr->csPtr != NULL) && ((flags & CHANNEL_RAW_MODE) == 0)) { + if (BUSY_STATE(statePtr,flags) && ((flags & CHANNEL_RAW_MODE) == 0)) { Tcl_SetErrno(EBUSY); return -1; } @@ -6920,12 +6939,13 @@ Tcl_SetChannelBufferSize( ChannelState *statePtr; /* State of real channel structure. */ /* - * If the buffer size is smaller than 1 byte or larger than one MByte, do - * not accept the requested size and leave the current buffer size. + * Clip the buffer size to force it into the [1,1M] range */ - if (sz < 1 || sz > 1024*1024) { - return; + if (sz < 1) { + sz = 1; + } else if (sz > MAX_CHANNEL_BUFFER_SIZE) { + sz = MAX_CHANNEL_BUFFER_SIZE; } statePtr = ((Channel *) chan)->state; @@ -7092,12 +7112,10 @@ Tcl_GetChannelOption( * If we are in the middle of a background copy, use the saved flags. */ - if (statePtr->csPtr) { - if (chanPtr == statePtr->csPtr->readPtr) { - flags = statePtr->csPtr->readFlags; - } else { - flags = statePtr->csPtr->writeFlags; - } + if (statePtr->csPtrR) { + flags = statePtr->csPtrR->readFlags; + } else if (statePtr->csPtrW) { + flags = statePtr->csPtrW->writeFlags; } else { flags = statePtr->flags; } @@ -7307,7 +7325,7 @@ Tcl_SetChannelOption( * If the channel is in the middle of a background copy, fail. */ - if (statePtr->csPtr) { + if (statePtr->csPtrR || statePtr->csPtrW) { if (interp) { Tcl_AppendResult(interp, "unable to set channel options: " "background copy in progress", NULL); @@ -8429,14 +8447,14 @@ TclCopyChannel( inStatePtr = inPtr->state; outStatePtr = outPtr->state; - if (inStatePtr->csPtr) { + if (BUSY_STATE(inStatePtr,TCL_READABLE)) { if (interp) { Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(inChan), "\" is busy", NULL); } return TCL_ERROR; } - if (outStatePtr->csPtr) { + if (BUSY_STATE(outStatePtr,TCL_WRITABLE)) { if (interp) { Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(outChan), "\" is busy", NULL); @@ -8494,8 +8512,9 @@ TclCopyChannel( Tcl_IncrRefCount(cmdPtr); } csPtr->cmdPtr = cmdPtr; - inStatePtr->csPtr = csPtr; - outStatePtr->csPtr = csPtr; + + inStatePtr->csPtrR = csPtr; + outStatePtr->csPtrW = csPtr; /* * Start copying data between the channels. @@ -8578,23 +8597,33 @@ CopyData( goto writeError; } - /* - * Read up to bufSize bytes. - */ + if (cmdPtr && (mask == 0)) { + /* + * In async mode, we skip reading synchronously and fake an + * underflow instead to prime the readable fileevent. + */ - if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) { - sizeb = csPtr->bufSize; + size = 0; + underflow = 1; } else { - sizeb = csPtr->toRead; - } + /* + * Read up to bufSize bytes. + */ - if (inBinary || sameEncoding) { - size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb); - } else { - size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, - 0 /* No append */); + if ((csPtr->toRead == -1) || (csPtr->toRead > csPtr->bufSize)) { + sizeb = csPtr->bufSize; + } else { + sizeb = csPtr->toRead; + } + + if (inBinary || sameEncoding) { + size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb); + } else { + size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, + 0 /* No append */); + } + underflow = (size >= 0) && (size < sizeb); /* Input underflow */ } - underflow = (size >= 0) && (size < sizeb); /* Input underflow */ if (size < 0) { readError: @@ -8615,15 +8644,17 @@ CopyData( break; } else if (underflow) { /* - * We had an underflow on the read side. If we are at EOF, then - * the copying is done, otherwise set up a channel handler to - * detect when the channel becomes readable again. + * We had an underflow on the read side. If we are at EOF, and not + * in the synchronous part of an asynchronous fcopy, then the + * copying is done, otherwise set up a channel handler to detect + * when the channel becomes readable again. */ - if ((size == 0) && Tcl_Eof(inChan)) { + if ((size == 0) && Tcl_Eof(inChan) && !(cmdPtr && (mask == 0))) { break; } - if (! Tcl_Eof(inChan) && !(mask & TCL_READABLE)) { + if (((!Tcl_Eof(inChan)) || (cmdPtr && (mask == 0))) && + !(mask & TCL_READABLE)) { if (mask & TCL_WRITABLE) { Tcl_DeleteChannelHandler(outChan, CopyEventProc, csPtr); } @@ -8731,7 +8762,7 @@ CopyData( * don't starve the rest of the system. */ - if (cmdPtr) { + if (cmdPtr && (csPtr->toRead != 0)) { /* * The first time we enter this code, there won't be a channel * handler established yet, so do it here. @@ -9437,8 +9468,8 @@ StopCopy( } TclDecrRefCount(csPtr->cmdPtr); } - inStatePtr->csPtr = NULL; - outStatePtr->csPtr = NULL; + inStatePtr->csPtrR = NULL; + outStatePtr->csPtrW = NULL; ckfree((char *) csPtr); } diff --git a/generic/tclIO.h b/generic/tclIO.h index fad5eab..f5f33e8 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.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: tclIO.h,v 1.9.8.1 2007/12/06 07:08:37 dgp Exp $ + * RCS: @(#) $Id: tclIO.h,v 1.9.8.2 2008/06/25 15:56:11 dgp Exp $ */ /* @@ -219,7 +219,8 @@ typedef struct ChannelState { * handlers ("fileevent") on this channel. */ int bufSize; /* What size buffers to allocate? */ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ - CopyState *csPtr; /* State of background copy, or NULL. */ + CopyState *csPtrR; /* State of background copy for which channel is input, or NULL. */ + CopyState *csPtrW; /* State of background copy for which channel is output, or NULL. */ Channel *topChanPtr; /* Refers to topmost channel in a stack. Never * NULL. */ Channel *bottomChanPtr; /* Refers to bottommost channel in a stack. diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 23c3656..73100ac 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOCmd.c,v 1.40.2.9 2007/12/10 18:32:56 dgp Exp $ + * RCS: @(#) $Id: tclIOCmd.c,v 1.40.2.10 2008/06/25 15:56:11 dgp Exp $ */ #include "tclInt.h" @@ -1643,6 +1643,15 @@ Tcl_FcopyObjCmd( if (TclGetIntFromObj(interp, objv[i+1], &toRead) != TCL_OK) { return TCL_ERROR; } + if (toRead<0) { + /* + * Handle all negative sizes like -1, meaning 'copy all'. By + * resetting toRead we avoid changes in the core copying + * functions (which explicitly check for -1 and crash on any + * other negative value). + */ + toRead = -1; + } break; case FcopyCommand: cmdPtr = objv[i+1]; diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 6083931..b41d577 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIORChan.c,v 1.24.2.3 2008/03/07 22:05:04 dgp Exp $ + * RCS: @(#) $Id: tclIORChan.c,v 1.24.2.4 2008/06/25 15:56:11 dgp Exp $ */ #include <tclInt.h> @@ -85,7 +85,11 @@ typedef struct { Tcl_Channel chan; /* Back reference to generic channel * structure. */ Tcl_Interp *interp; /* Reference to the interpreter containing the - * Tcl level part of the channel. */ + * Tcl level part of the channel. NULL here + * signals the channel is dead because the + * interpreter/thread containing its Tcl + * command is gone. + */ #ifdef TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */ #endif @@ -338,6 +342,13 @@ typedef struct ForwardingEvent { struct ForwardingResult { Tcl_ThreadId src; /* Originating thread. */ Tcl_ThreadId dst; /* Thread the op was forwarded to. */ + Tcl_Interp* dsti; /* Interpreter in the thread the op was forwarded to. */ + /* + * Note regarding 'dsti' above: Its information is also available via the + * chain evPtr->rcPtr->interp, however, as can be seen, two more + * indirections are needed to retrieve it. And the evPtr may be gone, + * breaking the chain. + */ Tcl_Condition done; /* Condition variable the forwarder blocks * on. */ int result; /* TCL_OK or TCL_ERROR */ @@ -347,6 +358,17 @@ struct ForwardingResult { * results. */ }; +typedef struct ThreadSpecificData { + /* + * Table of all reflected channels owned by this thread. This is the + * per-thread version of the per-interpreter map. + */ + + ReflectedChannelMap* rcmPtr; +} ThreadSpecificData; + +static Tcl_ThreadDataKey dataKey; + /* * List of forwarded operations which have not completed yet, plus the mutex * to protect the access to this process global list. @@ -361,16 +383,15 @@ TCL_DECLARE_MUTEX(rcForwardMutex) * the event function executed by the thread receiving a forwarding event * (which executes the appropriate function and collects the result, if any). * - * The two ExitProcs are handlers so that things do not deadlock when either - * thread involved in the forwarding exits. They also clean things up so that - * we don't leak resources when threads go away. + * The ExitProc ensures that things do not deadlock when the sending thread + * involved in the forwarding exits. It also clean things up so that we don't + * leak resources when threads go away. */ static void ForwardOpToOwnerThread(ReflectedChannel *rcPtr, ForwardedOperation op, const VOID *param); static int ForwardProc(Tcl_Event *evPtr, int mask); static void SrcExitProc(ClientData clientData); -static void DstExitProc(ClientData clientData); #define FreeReceivedError(p) \ if ((p)->base.mustFree) { \ @@ -395,6 +416,10 @@ static void DstExitProc(ClientData clientData); (p)->base.msgStr = (char *) (emsg) static void ForwardSetObjError(ForwardParam *p, Tcl_Obj *objPtr); + +static ReflectedChannelMap * GetThreadReflectedChannelMap(void); +static void DeleteThreadReflectedChannelMap(ClientData clientData); + #endif /* TCL_THREADS */ #define SetChannelErrorStr(c,msgStr) \ @@ -434,11 +459,13 @@ static const char *msg_read_unsup = "{read not supported by Tcl driver}"; static const char *msg_read_toomuch = "{read delivered more than requested}"; static const char *msg_write_unsup = "{write not supported by Tcl driver}"; static const char *msg_write_toomuch = "{write wrote more than requested}"; +static const char *msg_write_nothing = "{write wrote nothing}"; static const char *msg_seek_beforestart = "{Tried to seek before origin}"; #ifdef TCL_THREADS -static const char *msg_send_originlost = "{Origin thread lost}"; -static const char *msg_send_dstlost = "{Destination thread lost}"; +static const char *msg_send_originlost = "{Channel thread lost}"; +static const char *msg_send_dstlost = "{Owner lost}"; #endif /* TCL_THREADS */ +static const char *msg_dstlost = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}"; /* * Main methods to plug into the 'chan' ensemble'. ================== @@ -695,6 +722,12 @@ TclChanCreateObjCmd( } } Tcl_SetHashValue(hPtr, chan); +#ifdef TCL_THREADS + rcmPtr = GetThreadReflectedChannelMap(); + hPtr = Tcl_CreateHashEntry(&rcmPtr->map, + chanPtr->state->channelName, &isNew); + Tcl_SetHashValue(hPtr, chan); +#endif /* * Return handle as result of command. @@ -1010,6 +1043,8 @@ ReflectClose( ReflectedChannel *rcPtr = (ReflectedChannel *) clientData; int result; /* Result code for 'close' */ Tcl_Obj *resObj; /* Result data for 'close' */ + ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */ + Tcl_HashEntry* hPtr; /* Entry in the above map */ if (interp == NULL) { /* @@ -1023,8 +1058,8 @@ ReflectClose( /* * THREADED => Forward this to the origin thread * - * Note: Have a thread delete handler for the origin thread. Use this - * to clean up the structure! + * Note: DeleteThreadReflectedChannelMap() is the thread exit handler for the origin + * thread. Use this to clean up the structure? Except if lost? */ #ifdef TCL_THREADS @@ -1090,6 +1125,32 @@ ReflectClose( Tcl_DecrRefCount(resObj); /* Remove reference we held from the * invoke */ + + /* + * Remove the channel from the map before releasing the memory, to + * prevent future accesses (like by 'postevent') from finding and + * dereferencing a dangling pointer. + * + * NOTE: The channel may not be in the map. This is ok, that happens + * when the channel was created in a different interpreter and/or + * thread and then was moved here. + */ + + rcmPtr = GetReflectedChannelMap (interp); + hPtr = Tcl_FindHashEntry (&rcmPtr->map, + Tcl_GetChannelName (rcPtr->chan)); + if (hPtr) { + Tcl_DeleteHashEntry (hPtr); + } +#ifdef TCL_THREADS + rcmPtr = GetThreadReflectedChannelMap(); + hPtr = Tcl_FindHashEntry (&rcmPtr->map, + Tcl_GetChannelName (rcPtr->chan)); + if (hPtr) { + Tcl_DeleteHashEntry (hPtr); + } +#endif + FreeReflectedChannel(rcPtr); #ifdef TCL_THREADS } @@ -1154,6 +1215,7 @@ ReflectInput( if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; + p.input.toRead = -1; } else { *errorCodePtr = EOK; } @@ -1248,6 +1310,7 @@ ReflectOutput( if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; + p.output.toWrite = -1; } else { *errorCodePtr = EOK; } @@ -1276,7 +1339,17 @@ ReflectOutput( Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ - if ((written == 0) || (toWrite < written)) { + if ((written == 0) && (toWrite > 0)) { + /* + * The handler claims to have written nothing of what it was + * given. That is bad. + */ + + SetChannelErrorStr(rcPtr->chan, msg_write_nothing); + *errorCodePtr = EINVAL; + return -1; + } + if (toWrite < written) { /* * The handler claims to have written more than it was given. That is * bad. Note that the I/O core would crash if we were to return this @@ -1336,6 +1409,7 @@ ReflectSeekWide( if (p.base.code != TCL_OK) { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; + p.seek.offset = -1; } else { *errorCodePtr = EOK; } @@ -2041,9 +2115,24 @@ InvokeTclMethod( int result; /* Result code of method invokation */ Tcl_Obj *resObj = NULL; /* Result of method invokation. */ + if (!rcPtr->interp) { + /* + * The channel is marked as dead. Bail out immediately, with an + * appropriate error. + */ + + if (resultObjPtr != NULL) { + resObj = Tcl_NewStringObj(msg_dstlost,-1); + *resultObjPtr = resObj; + Tcl_IncrRefCount(resObj); + } + return TCL_ERROR; + } + /* * NOTE (5): Decide impl. issue: Cache objects with method names? Needs * TSD data as reflections can be created in many different threads. + * NO: Caching of command resolutions means storage per channel. */ /* @@ -2217,11 +2306,25 @@ DeleteReflectedChannelMap( ReflectedChannelMap* rcmPtr; /* The map */ Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ + ReflectedChannel* rcPtr; + Tcl_Channel chan; + +#ifdef TCL_THREADS + ForwardingResult *resultPtr; + ForwardingEvent *evPtr; + ForwardParam *paramPtr; +#endif /* - * Delete all entries. The channels may have been closed alreay, or will + * Delete all entries. The channels may have been closed already, or will * be closed later, by the standard IO finalization of an interpreter - * under destruction. + * under destruction. Except for the channels which were moved to a + * different interpreter and/or thread. They do not exist from the IO + * systems point of view and will not get closed. Therefore mark all as + * dead so that any future access will cause a proper error. For channels + * in a different thread we actually do the same as + * DeleteThreadReflectedChannelMap(), just restricted to the channels of + * this interp. */ rcmPtr = clientData; @@ -2229,13 +2332,207 @@ DeleteReflectedChannelMap( hPtr != NULL; hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { + chan = (Tcl_Channel) Tcl_GetHashValue (hPtr); + rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan); + + rcPtr->interp = NULL; + Tcl_DeleteHashEntry(hPtr); } Tcl_DeleteHashTable(&rcmPtr->map); ckfree((char *) &rcmPtr->map); + +#ifdef TCL_THREADS + /* + * The origin interpreter for one or more reflected channels is gone. + */ + + /* + * Go through the list of pending results and cancel all whose events were + * destined for this interpreter. While this is in progress we block any + * other access to the list of pending results. + */ + + Tcl_MutexLock(&rcForwardMutex); + + for (resultPtr = forwardList; + resultPtr != NULL; + resultPtr = resultPtr->nextPtr) { + if (resultPtr->dsti != interp) { + /* Ignore results/events for other interpreters. */ + continue; + } + + /* + * The receiver for the event exited, before processing the event. We + * detach the result now, wake the originator up and signal failure. + */ + + evPtr = resultPtr->evPtr; + paramPtr = evPtr->param; + + evPtr->resultPtr = NULL; + resultPtr->evPtr = NULL; + resultPtr->result = TCL_ERROR; + + ForwardSetStaticError(paramPtr, msg_send_dstlost); + + Tcl_ConditionNotify(&resultPtr->done); + } + + /* + * Get the map of all channels handled by the current thread. This is a + * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go + * through the channels and remove all which were handled by this + * interpreter. They have already been marked as dead. + */ + + rcmPtr = GetThreadReflectedChannelMap(); + for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&hSearch)) { + + chan = (Tcl_Channel) Tcl_GetHashValue (hPtr); + rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan); + + if (rcPtr->interp != interp) { + /* Ignore entries for other interpreters */ + continue; + } + + Tcl_DeleteHashEntry(hPtr); + } + + Tcl_MutexUnlock(&rcForwardMutex); +#endif } #ifdef TCL_THREADS +/* + *---------------------------------------------------------------------- + * + * GetThreadReflectedChannelMap -- + * + * Gets and potentially initializes the reflected channel map for a + * thread. + * + * Results: + * A pointer to the map created, for use by the caller. + * + * Side effects: + * Initializes the reflected channel map for a thread. + * + *---------------------------------------------------------------------- + */ + +static ReflectedChannelMap * +GetThreadReflectedChannelMap() +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (!tsdPtr->rcmPtr) { + tsdPtr->rcmPtr = (ReflectedChannelMap *) ckalloc(sizeof(ReflectedChannelMap)); + Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS); + Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL); + } + + return tsdPtr->rcmPtr; +} + +/* + *---------------------------------------------------------------------- + * + * DeleteThreadReflectedChannelMap -- + * + * Deletes the channel table for a thread. This procedure is invoked when + * a thread is deleted. The channels have already been marked as dead, in + * DeleteReflectedChannelMap(). + * + * Results: + * None. + * + * Side effects: + * Deletes the hash table of channels. + * + *---------------------------------------------------------------------- + */ + +static void +DeleteThreadReflectedChannelMap( + ClientData clientData) /* The per-thread data structure. */ +{ + Tcl_HashSearch hSearch; /* Search variable. */ + Tcl_HashEntry *hPtr; /* Search variable. */ + Tcl_ThreadId self = Tcl_GetCurrentThread(); + + ReflectedChannelMap* rcmPtr; /* The map */ + Tcl_Channel chan; + ReflectedChannel* rcPtr; + ForwardingResult *resultPtr; + ForwardingEvent *evPtr; + ForwardParam *paramPtr; + + /* + * The origin thread for one or more reflected channels is gone. + * NOTE: If this function is called due to a thread getting killed the + * per-interp DeleteReflectedChannelMap is apparently not called. + */ + + /* + * Go through the list of pending results and cancel all whose events were + * destined for this thread. While this is in progress we block any + * other access to the list of pending results. + */ + + Tcl_MutexLock(&rcForwardMutex); + + for (resultPtr = forwardList; + resultPtr != NULL; + resultPtr = resultPtr->nextPtr) { + if (resultPtr->dst != self) { + /* Ignore results/events for other threads. */ + continue; + } + + /* + * The receiver for the event exited, before processing the event. We + * detach the result now, wake the originator up and signal failure. + */ + + evPtr = resultPtr->evPtr; + paramPtr = evPtr->param; + + evPtr->resultPtr = NULL; + resultPtr->evPtr = NULL; + resultPtr->result = TCL_ERROR; + + ForwardSetStaticError(paramPtr, msg_send_dstlost); + + Tcl_ConditionNotify(&resultPtr->done); + } + + /* + * Get the map of all channels handled by the current thread. This is a + * ReflectedChannelMap, but on a per-thread basis, not per-interp. Go + * through the channels, remove all, mark them as dead. + */ + + rcmPtr = GetThreadReflectedChannelMap(); + for (hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch); + hPtr != NULL; + hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) { + + chan = (Tcl_Channel) Tcl_GetHashValue (hPtr); + rcPtr = (ReflectedChannel *) Tcl_GetChannelInstanceData(chan); + + rcPtr->interp = NULL; + + Tcl_DeleteHashEntry(hPtr); + } + + Tcl_MutexUnlock(&rcForwardMutex); +} + static void ForwardOpToOwnerThread( ReflectedChannel *rcPtr, /* Channel instance */ @@ -2248,6 +2545,24 @@ ForwardOpToOwnerThread( int result; /* + * We gather the lock early. This allows us to check the liveness of the + * channel without interference from DeleteThreadReflectedChannelMap(). + */ + + Tcl_MutexLock(&rcForwardMutex); + + if (rcPtr->interp == NULL) { + /* + * The channel is marked as dead. Bail out immediately, with an + * appropriate error. Do not forget to unlock the mutex on this path. + */ + + ForwardSetStaticError((ForwardParam *)param, msg_send_dstlost); + Tcl_MutexUnlock(&rcForwardMutex); + return; + } + + /* * Create and initialize the event and data structures. */ @@ -2260,8 +2575,9 @@ ForwardOpToOwnerThread( evPtr->rcPtr = rcPtr; evPtr->param = (ForwardParam *) param; - resultPtr->src = Tcl_GetCurrentThread(); - resultPtr->dst = dst; + resultPtr->src = Tcl_GetCurrentThread(); + resultPtr->dst = dst; + resultPtr->dsti = rcPtr->interp; resultPtr->done = NULL; resultPtr->result = -1; resultPtr->evPtr = evPtr; @@ -2270,16 +2586,18 @@ ForwardOpToOwnerThread( * Now execute the forward. */ - Tcl_MutexLock(&rcForwardMutex); TclSpliceIn(resultPtr, forwardList); + /* Do not unlock here. That is done by the ConditionWait */ /* - * Ensure cleanup of the event if any of the two involved threads exits - * while this event is pending or in progress. + * Ensure cleanup of the event if the origin thread exits while this event + * is pending or in progress. Exitus of the destination thread is handled + * by DeleteThreadReflectionChannelMap(), this is set up by + * GetThreadReflectedChannelMap(). This is what we use the 'forwardList' + * (see above) for. */ Tcl_CreateThreadExitHandler(SrcExitProc, (ClientData) evPtr); - Tcl_CreateThreadExitHandler(DstExitProc, (ClientData) evPtr); /* * Queue the event and poke the other thread's notifier. @@ -2298,6 +2616,9 @@ ForwardOpToOwnerThread( * NOTE (1): Is it possible that the current thread goes away while * waiting here? IOW Is it possible that "SrcExitProc" is called while * we are here? See complementary note (2) in "SrcExitProc" + * + * The ConditionWait unlocks the mutex during the wait and relocks it + * immediately after. */ Tcl_ConditionWait(&resultPtr->done, &rcForwardMutex, NULL); @@ -2305,6 +2626,7 @@ ForwardOpToOwnerThread( /* * Unlink result from the forwarder list. + * No need to lock. Either still locked, or locked by the ConditionWait */ TclSpliceOut(resultPtr, forwardList); @@ -2316,14 +2638,13 @@ ForwardOpToOwnerThread( Tcl_ConditionFinalize(&resultPtr->done); /* - * Kill the cleanup handlers now, and the result structure as well, before + * Kill the cleanup handler now, and the result structure as well, before * returning the success code. * * Note: The event structure has already been deleted. */ Tcl_DeleteThreadExitHandler(SrcExitProc, (ClientData) evPtr); - Tcl_DeleteThreadExitHandler(DstExitProc, (ClientData) evPtr); result = resultPtr->result; ckfree((char*) resultPtr); @@ -2353,6 +2674,8 @@ ForwardProc( Tcl_Interp *interp = rcPtr->interp; ForwardParam *paramPtr = evPtr->param; Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */ + ReflectedChannelMap* rcmPtr; /* Map of reflected channels with handlers in this interp */ + Tcl_HashEntry* hPtr; /* Entry in the above map */ /* * Ignore the event if no one is waiting for its result anymore. @@ -2386,8 +2709,22 @@ ForwardProc( * Freeing is done here, in the origin thread, because the argv[] * objects belong to this thread. Deallocating them in a different * thread is not allowed + * + * We remove the channel from both interpreter and thread maps before + * releasing the memory, to prevent future accesses (like by + * 'postevent') from finding and dereferencing a dangling pointer. */ + rcmPtr = GetReflectedChannelMap (interp); + hPtr = Tcl_FindHashEntry (&rcmPtr->map, + Tcl_GetChannelName (rcPtr->chan)); + Tcl_DeleteHashEntry (hPtr); + + rcmPtr = GetThreadReflectedChannelMap(); + hPtr = Tcl_FindHashEntry (&rcmPtr->map, + Tcl_GetChannelName (rcPtr->chan)); + Tcl_DeleteHashEntry (hPtr); + FreeReflectedChannel(rcPtr); break; @@ -2649,33 +2986,6 @@ SrcExitProc( } static void -DstExitProc( - ClientData clientData) -{ - ForwardingEvent *evPtr = (ForwardingEvent *) clientData; - ForwardingResult *resultPtr = evPtr->resultPtr; - ForwardParam *paramPtr = evPtr->param; - - /* - * NOTE (3): It is not clear if the event still exists when this handler - * is called. We might have to use 'resultPtr' as our clientData instead. - */ - - /* - * The receiver for the event exited, before processing the event. We - * detach the result now, wake the originator up and signal failure. - */ - - evPtr->resultPtr = NULL; - resultPtr->evPtr = NULL; - resultPtr->result = TCL_ERROR; - - ForwardSetStaticError(paramPtr, msg_send_dstlost); - - Tcl_ConditionNotify(&resultPtr->done); -} - -static void ForwardSetObjError( ForwardParam *paramPtr, Tcl_Obj *obj) diff --git a/generic/tclInt.h b/generic/tclInt.h index c3b06f1..271e607 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.310.2.25 2008/01/25 16:43:53 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.310.2.26 2008/06/25 15:56:12 dgp Exp $ */ #ifndef _TCLINT @@ -3768,11 +3768,15 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, */ #ifdef _MSC_VER -#define TclIsInfinite(d) ( ! (_finite((d))) ) -#define TclIsNaN(d) (_isnan((d))) +# define TclIsInfinite(d) ( ! (_finite((d))) ) +# define TclIsNaN(d) (_isnan((d))) #else -#define TclIsInfinite(d) ( (d) > DBL_MAX || (d) < -DBL_MAX ) -#define TclIsNaN(d) ((d) != (d)) +# define TclIsInfinite(d) ( (d) > DBL_MAX || (d) < -DBL_MAX ) +# ifdef NO_ISNAN +# define TclIsNaN(d) ((d) != (d)) +# else +# define TclIsNaN(d) (isnan(d)) +# endif #endif /* diff --git a/generic/tclInterp.c b/generic/tclInterp.c index f25e0d9..7ac8230 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.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: tclInterp.c,v 1.74.2.7 2008/01/31 02:57:52 dgp Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.74.2.8 2008/06/25 15:56:13 dgp Exp $ */ #include "tclInt.h" @@ -2061,9 +2061,9 @@ SlaveBgerror( NULL); return TCL_ERROR; } - TclSetBgErrorHandler(interp, objv[0]); + TclSetBgErrorHandler(slaveInterp, objv[0]); } - Tcl_SetObjResult(interp, TclGetBgErrorHandler(interp)); + Tcl_SetObjResult(interp, TclGetBgErrorHandler(slaveInterp)); return TCL_OK; } diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 816943e..8072f5e 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -23,7 +23,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclNamesp.c,v 1.134.2.16 2008/03/07 22:05:05 dgp Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.134.2.17 2008/06/25 15:56:13 dgp Exp $ */ #include "tclInt.h" @@ -4296,45 +4296,58 @@ Tcl_SetNamespaceUnknownHandler( Tcl_Namespace *nsPtr, /* Namespace which is being updated. */ Tcl_Obj *handlerPtr) /* The new handler, or NULL to reset. */ { - int lstlen; + int lstlen = 0; Namespace *currNsPtr = (Namespace *)nsPtr; - if (currNsPtr->unknownHandlerPtr != NULL) { - /* - * Remove old handler first. - */ + /* + * Ensure that we check for errors *first* before we change anything. + */ - Tcl_DecrRefCount(currNsPtr->unknownHandlerPtr); - currNsPtr->unknownHandlerPtr = NULL; + if (handlerPtr != NULL) { + if (TclListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) { + /* + * Not a list. + */ + + return TCL_ERROR; + } + if (lstlen > 0) { + /* + * We are going to be saving this handler. Increment the reference + * count before decrementing the refcount on the previous handler, + * so that nothing strange can happen if we are told to set the + * handler to the previous value. + */ + + Tcl_IncrRefCount(handlerPtr); + } } /* - * If NULL or an empty list is passed, then reset to the default - * handler. + * Remove old handler next. */ - if (handlerPtr == NULL) { - currNsPtr->unknownHandlerPtr = NULL; - } else if (TclListObjLength(interp, handlerPtr, &lstlen) != TCL_OK) { - /* - * Not a list. - */ + if (currNsPtr->unknownHandlerPtr != NULL) { + Tcl_DecrRefCount(currNsPtr->unknownHandlerPtr); + } - return TCL_ERROR; - } else if (lstlen == 0) { + /* + * Install the new handler. + */ + + if (lstlen > 0) { /* - * Empty list - reset to default. + * Just store the handler. It already has the correct reference count. */ - currNsPtr->unknownHandlerPtr = NULL; + currNsPtr->unknownHandlerPtr = handlerPtr; } else { /* - * Increment ref count and store. The reference count is decremented - * either in the code above, or when the namespace is deleted. + * If NULL or an empty list is passed, this resets to the default + * handler. */ - Tcl_IncrRefCount(handlerPtr); - currNsPtr->unknownHandlerPtr = handlerPtr; + currNsPtr->unknownHandlerPtr = NULL; } return TCL_OK; } @@ -6939,6 +6952,9 @@ Tcl_LogCommandInfo( } } + if (length < 0) { + length = strlen(command); + } overflow = (length > limit); Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( "\n %s\n\"%.*s%s\"", ((iPtr->errorInfo == NULL) diff --git a/generic/tclObj.c b/generic/tclObj.c index b680e60..9ee219d 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -13,12 +13,13 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.122.2.8 2007/11/21 06:44:32 dgp Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.122.2.9 2008/06/25 15:56:13 dgp Exp $ */ #include "tclInt.h" #include "tommath.h" #include <float.h> +#include <math.h> /* * Table of all object types. diff --git a/generic/tclParse.c b/generic/tclParse.c index 1ea471c..dd29350 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParse.c,v 1.52.2.8 2008/01/25 16:43:53 dgp Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.52.2.9 2008/06/25 15:56:13 dgp Exp $ */ #include "tclInt.h" @@ -954,9 +954,12 @@ ParseComment( char type; int scanned; - scanned = TclParseAllWhiteSpace(p, numBytes); - p += scanned; - numBytes -= scanned; + do { + scanned = ParseWhiteSpace(p, numBytes, + &parsePtr->incomplete, &type); + p += scanned; + numBytes -= scanned; + } while (numBytes && (*p == '\n') && (p++,numBytes--)); if ((numBytes == 0) || (*p != '#')) { break; @@ -1871,7 +1874,7 @@ Tcl_SubstObj( int length, tokensLeft, code; Tcl_Token *endTokenPtr; Tcl_Obj *result, *errMsg = NULL; - CONST char *p = TclGetStringFromObj(objPtr, &length); + const char *p = TclGetStringFromObj(objPtr, &length); Tcl_Parse *parsePtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 73f4b0d..59ccfbe 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.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: tclPathObj.c,v 1.63.2.1 2007/11/21 06:30:54 dgp Exp $ + * RCS: @(#) $Id: tclPathObj.c,v 1.63.2.2 2008/06/25 15:56:13 dgp Exp $ */ #include "tclInt.h" @@ -1596,7 +1596,16 @@ Tcl_FSGetTranslatedPath( srcFsPathPtr = PATHOBJ(pathPtr); if (srcFsPathPtr->translatedPathPtr == NULL) { if (PATHFLAGS(pathPtr) != 0) { - retObj = Tcl_FSGetNormalizedPath(interp, pathPtr); + /* + * We lack a translated path result, but we have a directory + * (cwdPtr) and a tail (normPathPtr), and if we join the + * translated version of cwdPtr to normPathPtr, we'll get the + * translated result we need, and can store it for future use. + */ + retObj = Tcl_FSJoinToPath(Tcl_FSGetTranslatedPath(interp, + srcFsPathPtr->cwdPtr), 1, &(srcFsPathPtr->normPathPtr)); + srcFsPathPtr->translatedPathPtr = retObj; + Tcl_IncrRefCount(retObj); } else { /* * It is a pure absolute, normalized path object. This is @@ -1759,6 +1768,16 @@ Tcl_FSGetNormalizedPath( if (pathType == TCL_PATH_RELATIVE) { Tcl_Obj *origDir = fsPathPtr->cwdPtr; + + /* + * NOTE: here we are (dangerously?) assuming that origDir points + * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType . The + * pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr); + * above that set the pathType value should have established + * that, but it's far less clear on what basis we know there's + * been no shimmering since then. + */ + FsPath *origDirFsPathPtr = PATHOBJ(origDir); fsPathPtr->cwdPtr = origDirFsPathPtr->cwdPtr; @@ -1872,7 +1891,20 @@ Tcl_FSGetNormalizedPath( * might loop back through here. */ - if (path[0] != '\0') { + if (path[0] == '\0') { + /* + * Special handling for the empty string value. This one is + * very weird with [file normalize {}] => {}. (The reasoning + * supporting this is unknown to DGP, but he fears changing it.) + * Attempt here to keep the expectations of other parts of + * Tcl_Filesystem code about state of the FsPath fields satisfied. + * + * In particular, capture the cwd value and save so it can be + * stored in the cwdPtr field below. + */ + useThisCwd = Tcl_FSGetCwd(interp); + + } else { /* * We don't ask for the type of 'pathPtr' here, because that is * not correct for our purposes when we have a path like '~'. Tcl diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 809f23f..a2cc3a4 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.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: tclPkg.c,v 1.27.2.5 2007/11/21 16:27:00 dgp Exp $ + * RCS: @(#) $Id: tclPkg.c,v 1.27.2.6 2008/06/25 15:56:13 dgp Exp $ * * TIP #268. * Heavily rewritten to handle the extend version numbers, and extended @@ -1868,6 +1868,8 @@ Tcl_PkgInitStubsCheck( } if (count == 1) { if (0 != strncmp(version, actualVersion, strlen(version))) { + /* Construct error message */ + Tcl_PkgPresent(interp, "Tcl", version, 1); return NULL; } } else { diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 25202a5..0b8d22d 100755 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStrToD.c,v 1.30.2.2 2008/03/13 20:29:37 dgp Exp $ + * RCS: @(#) $Id: tclStrToD.c,v 1.30.2.3 2008/06/25 15:56:13 dgp Exp $ * *---------------------------------------------------------------------- */ @@ -61,6 +61,13 @@ typedef unsigned int fpu_control_t __attribute__ ((__mode__ (__HI__))); # define ADJUST_FPU_CONTROL_WORD #endif +/* Sun ProC needs sunmath for rounding control on x86 like gcc above. + * + * + */ +#if defined(__sun) && defined(__i386) && !defined(__GNUC__) +#include <sunmath.h> +#endif /* * HP's PA_RISC architecture uses 7ff4000000000000 to represent a quiet NaN. * Everyone else uses 7ff8000000000000. (Why, HP, why?) @@ -1309,6 +1316,9 @@ MakeLowPrecisionDouble( _FPU_GETCW(oldRoundingMode); _FPU_SETCW(roundTo53Bits); #endif +#if defined(__sun) && defined(__i386) && !defined(__GNUC__) + ieee_flags("set","precision","double",NULL); +#endif /* * Test for the easy cases. @@ -1381,6 +1391,9 @@ MakeLowPrecisionDouble( #if defined(__GNUC__) && defined(__i386) _FPU_SETCW(oldRoundingMode); #endif +#if defined(__sun) && defined(__i386) && !defined(__GNUC__) + ieee_flags("clear","precision",NULL,NULL); +#endif return retval; } @@ -1427,6 +1440,9 @@ MakeHighPrecisionDouble( _FPU_GETCW(oldRoundingMode); _FPU_SETCW(roundTo53Bits); #endif +#if defined(__sun) && defined(__i386) && !defined(__GNUC__) + ieee_flags("set","precision","double",NULL); +#endif /* * Quick checks for over/underflow. @@ -1485,6 +1501,9 @@ MakeHighPrecisionDouble( #if defined(__GNUC__) && defined(__i386) _FPU_SETCW(oldRoundingMode); #endif +#if defined(__sun) && defined(__i386) && !defined(__GNUC__) + ieee_flags("clear","precision",NULL,NULL); +#endif return retval; } diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 6855272..2f5dd21 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -33,7 +33,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclStringObj.c,v 1.65.2.4 2008/03/07 22:05:06 dgp Exp $ */ + * RCS: @(#) $Id: tclStringObj.c,v 1.65.2.5 2008/06/25 15:56:13 dgp Exp $ */ #include "tclInt.h" #include "tommath.h" @@ -2003,8 +2003,8 @@ Tcl_AppendFormatToObj( allocSegment = 1; Tcl_IncrRefCount(segment); - if ((isNegative || gotPlus) && (useBig || (ch == 'd'))) { - Tcl_AppendToObj(segment, (isNegative ? "-" : "+"), 1); + if ((isNegative || gotPlus || gotSpace) && (useBig || (ch == 'd'))) { + Tcl_AppendToObj(segment, (isNegative ? "-" : gotPlus ? "+" : " "), 1); } if (gotHash) { diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c index a73cb58..e17b239 100644 --- a/generic/tclStubLib.c +++ b/generic/tclStubLib.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: tclStubLib.c,v 1.15.2.4 2007/11/13 13:07:42 dgp Exp $ + * RCS: @(#) $Id: tclStubLib.c,v 1.15.2.5 2008/06/25 15:56:15 dgp Exp $ */ /* @@ -123,6 +123,8 @@ Tcl_InitStubs( p++; q++; } if (*p) { + /* Construct error message */ + Tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL); return NULL; } } else { diff --git a/library/init.tcl b/library/init.tcl index 14d1f0a..bc1c417 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -3,7 +3,7 @@ # Default system startup file for Tcl-based applications. Defines # "unknown" procedure and auto-load facilities. # -# RCS: @(#) $Id: init.tcl,v 1.91.2.10 2008/03/07 22:05:06 dgp Exp $ +# RCS: @(#) $Id: init.tcl,v 1.91.2.11 2008/06/25 15:56:15 dgp Exp $ # # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. @@ -17,7 +17,7 @@ if {[info commands package] == ""} { error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]" } -package require -exact Tcl 8.5.2 +package require -exact Tcl 8.5.3b1 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile index 3a44c20..abe46f1 100644 --- a/macosx/GNUmakefile +++ b/macosx/GNUmakefile @@ -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: GNUmakefile,v 1.5.2.3 2008/03/13 14:47:31 dgp Exp $ +# RCS: @(#) $Id: GNUmakefile,v 1.5.2.4 2008/06/25 15:56:15 dgp Exp $ # ######################################################################################################## @@ -76,7 +76,7 @@ OBJ_DIR = ${OBJROOT}/${BUILD_STYLE} empty := space := ${empty} ${empty} -objdir := $(subst ${space},\ ,${OBJ_DIR}) +objdir = $(subst ${space},\ ,${OBJ_DIR}) develop_make_args := BUILD_STYLE=Development CONFIGURE_ARGS=--enable-symbols deploy_make_args := BUILD_STYLE=Deployment INSTALL_TARGET=install-strip \ diff --git a/macosx/README b/macosx/README index 1ec0c50..53006b6 100644 --- a/macosx/README +++ b/macosx/README @@ -1,7 +1,7 @@ Tcl Mac OS X README ------------------- -RCS: @(#) $Id: README,v 1.12.2.2 2007/09/06 18:20:32 dgp Exp $ +RCS: @(#) $Id: README,v 1.12.2.3 2008/06/25 15:56:15 dgp Exp $ This is the README file for the Mac OS X/Darwin version of Tcl. @@ -91,14 +91,17 @@ take care to only use the project matching your DevTools and OS version: * Tcl.pbproj for Xcode or ProjectBuilder on 10.3 and earlier, this has a 'Tcl' target that simply calls through to the tcl/macosx/GNUMakefile. * Tcl.xcode for Xcode 2.4 on 10.4 and Xcode 2.5 on 10.4 and later, which - additionally has a native 'tcltest' target useful for debugging, this - target's 'Debug' build configuration has ZeroLink and Fix&Continue - enabled, use the 'DebugNoFixZL' build configuration if you need a debug - build without these features. The following additional build - configurations are available for the 'Tcl' and 'tcltest' targets: + additionally has native 'tcltest' and 'tests' targets for debugging and + running the testsuite, these targets' 'Debug' build configuration has + ZeroLink and Fix&Continue enabled, use the 'DebugNoFixZL' build + configuration if you need a debug build without these features. The + following build configurations are available: 'DebugUnthreaded': debug build with threading turned off. + 'DebugNoCF': debug build with corefoundation turned off. + 'DebugNoCFUnthreaded': debug build with corefoundation & threading off. 'DebugMemCompile': debug build with memory and bytecode debugging on. 'DebugLeaks': debug build with PURIFY defined. + 'DebugGCov': debug build with generation of gcov data files enabled. 'Debug64bit': builds the targets as 64bit with debugging enabled, requires a 64bit capable processor (i.e. G5 or Core2/Xeon). 'ReleaseUniversal': builds the targets as universal binaries for the @@ -111,10 +114,17 @@ take care to only use the project matching your DevTools and OS version: 'ReleasePPC10.2.8SDK': builds for PowerPC with gcc-3.3 against the 10.2.8 SDK, useful to verify on Tiger that building on Jaguar would succeed. - * Tcl.xcodeproj for Xcode 3.0 on 10.5 and later, which has the following - additional build configuration: + * Tcl.xcodeproj for Xcode 3.1 on 10.5 and later, which has the following + additional build configurations: 'ReleaseUniversal10.5SDK': same as 'ReleaseUniversal' but builds against the 10.5 SDK on Leopard (with 10.5 deployment target). + 'Debug gcc42': same as 'Debug' but builds with gcc 4.2. + 'Debug llvmgcc42': same as 'Debug' but builds with llvm-gcc 4.2. + 'ReleaseUniversal gcc42': same as 'ReleaseUniversal' but builds with + gcc 4.2. + 'ReleaseUniversal llvmgcc42': same as 'ReleaseUniversal' but builds + with llvm-gcc 4.2. + Note that all non-SDK configurations have 10.5 deployment target. Notes about the native targets of the Xcode projects: * the Xcode projects refer to the toplevel tcl source directory through the diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj index a9e7056..70f1782 100644 --- a/macosx/Tcl.xcode/project.pbxproj +++ b/macosx/Tcl.xcode/project.pbxproj @@ -931,7 +931,7 @@ F966C06F08F281DC005CB29B /* Frameworks */, 1AB674ADFE9D54B511CA2CBB /* Products */, ); - comments = "Copyright (c) 2004-2007 Daniel A. Steffen <das@users.sourceforge.net>\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.6.2.2 2007/11/16 07:20:55 dgp Exp $\n"; + comments = "Copyright (c) 2004-2007 Daniel A. Steffen <das@users.sourceforge.net>\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.6.2.3 2008/06/25 15:56:15 dgp Exp $\n"; name = Tcl; path = .; sourceTree = SOURCE_ROOT; @@ -1950,12 +1950,14 @@ files = ( ); inputPaths = ( + "${TARGET_TEMP_DIR}/.none", ); outputPaths = ( + "${TARGET_BUILD_DIR}/${EXECUTABLE_NAME}", ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/bash; - shellScript = "if [ -e \"${BUILT_PRODUCTS_DIR}/tclsh\" ]; then\n mv -f \"${BUILT_PRODUCTS_DIR}/tclsh\" \"${BUILT_PRODUCTS_DIR}/tclsh${VERSION}\"\nfi\ngnumake -C \"${TCL_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${BUILT_PRODUCTS_DIR}/tclsh${VERSION}\" ]; then\n mv -f \"${BUILT_PRODUCTS_DIR}/tclsh${VERSION}\" \"${BUILT_PRODUCTS_DIR}/tclsh\"\nfi\nif [ -e \"${BUILT_PRODUCTS_DIR}/tcltest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tcltest\"\nfi\necho \"Done\"\nexit ${result}\n"; + shellScript = "if [ -e \"${TARGET_BUILD_DIR}/tclsh\" ]; then\n mv -f \"${TARGET_BUILD_DIR}/tclsh\" \"${TARGET_BUILD_DIR}/tclsh${VERSION}\"\nfi\ngnumake -C \"${TCL_SRCROOT}/macosx\" -j \"$(sysctl -n hw.activecpu)\" \"$(echo \"${ACTION}\" | sed -e s/build// -e s/clean/distclean/ -e s/..\\*/\\&-/)${MAKE_TARGET}\" CFLAGS_WARNING=\"${WARNING_CFLAGS}\" CFLAGS_OPTIMIZE=\"-O${GCC_OPTIMIZATION_LEVEL}\" SYMROOT=\"${BUILT_PRODUCTS_DIR}\" OBJ_DIR=\"${OBJECT_FILE_DIR}\" INSTALL_ROOT=\"${DSTROOT}\" PREFIX=\"${PREFIX}\" BINDIR=\"${BINDIR}\" LIBDIR=\"${FRAMEWORK_INSTALL_PATH}\" MANDIR=\"${MANDIR}\" EXTRA_CONFIGURE_ARGS=\"${CONFIGURE_ARGS}\" ${EXTRA_MAKE_FLAGS}\nresult=$?\nif [ -e \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" ]; then\n mv -f \"${TARGET_BUILD_DIR}/tclsh${VERSION}\" \"${TARGET_BUILD_DIR}/tclsh\"\nfi\nif [ -e \"${BUILT_PRODUCTS_DIR}/tcltest\" ]; then\n\trm -f \"${BUILT_PRODUCTS_DIR}/tcltest\"\nfi\necho \"Done\"\nrm -f \"${SCRIPT_INPUT_FILE_0}\"\nexit ${result}\n"; }; F9A5C5F508F651A2008AE941 /* ShellScript */ = { isa = PBXShellScriptBuildPhase; @@ -2156,6 +2158,7 @@ isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; }; name = ReleaseUniversal; }; @@ -2190,6 +2193,7 @@ isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; }; name = DebugMemCompile; }; @@ -2220,10 +2224,51 @@ }; name = DebugMemCompile; }; + F9359B250DF212DA00E04F67 /* DebugGCov */ = { + isa = XCBuildConfiguration; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; + buildSettings = { + GCC_GENERATE_TEST_COVERAGE_FILES = YES; + GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = YES; + MACOSX_DEPLOYMENT_TARGET = 10.2; + OTHER_LDFLAGS = ( + "$(OTHER_LDFLAGS)", + "-lgcov", + ); + PREBINDING = NO; + }; + name = DebugGCov; + }; + F9359B260DF212DA00E04F67 /* DebugGCov */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; + }; + name = DebugGCov; + }; + F9359B270DF212DA00E04F67 /* DebugGCov */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tcltest; + }; + name = DebugGCov; + }; + F9359B280DF212DA00E04F67 /* DebugGCov */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tests; + TCLTEST_OPTIONS = "-notfile http.test"; + TCL_LIBRARY = "$(TCL_SRCROOT)/library"; + TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; + }; + name = DebugGCov; + }; F95CC8AC09158F3100EA5ACE /* Debug */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; }; name = Debug; }; @@ -2231,6 +2276,7 @@ isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; }; name = Release; }; @@ -2238,6 +2284,7 @@ isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; }; name = DebugNoFixZL; }; @@ -2372,6 +2419,7 @@ isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; }; name = Debug64bit; }; @@ -2404,10 +2452,81 @@ }; name = Debug64bit; }; + F987512F0DE7B57E00B1C9EC /* DebugNoCF */ = { + isa = XCBuildConfiguration; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; + buildSettings = { + CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-corefoundation"; + MACOSX_DEPLOYMENT_TARGET = 10.2; + PREBINDING = NO; + }; + name = DebugNoCF; + }; + F98751300DE7B57E00B1C9EC /* DebugNoCF */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; + }; + name = DebugNoCF; + }; + F98751310DE7B57E00B1C9EC /* DebugNoCF */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tcltest; + }; + name = DebugNoCF; + }; + F98751320DE7B57E00B1C9EC /* DebugNoCF */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tests; + TCLTEST_OPTIONS = ""; + TCL_LIBRARY = "$(TCL_SRCROOT)/library"; + TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; + }; + name = DebugNoCF; + }; + F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { + isa = XCBuildConfiguration; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; + buildSettings = { + CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads --disable-corefoundation"; + MACOSX_DEPLOYMENT_TARGET = 10.2; + PREBINDING = NO; + }; + name = DebugNoCFUnthreaded; + }; + F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; + }; + name = DebugNoCFUnthreaded; + }; + F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tcltest; + }; + name = DebugNoCFUnthreaded; + }; + F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tests; + TCLTEST_OPTIONS = ""; + TCL_LIBRARY = "$(TCL_SRCROOT)/library"; + TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; + }; + name = DebugNoCFUnthreaded; + }; F99EE73B0BE835310060D4AF /* DebugUnthreaded */ = { isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; }; name = DebugUnthreaded; }; @@ -2415,6 +2534,7 @@ isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; }; name = DebugLeaks; }; @@ -2479,6 +2599,7 @@ isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; }; name = ReleaseUniversal10.4uSDK; }; @@ -2516,6 +2637,7 @@ buildSettings = { LDFLAGS = "-force_cpusubtype_ALL $(LDFLAGS)"; PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; }; name = ReleasePPC10.3.9SDK; }; @@ -2543,6 +2665,7 @@ isa = XCBuildConfiguration; buildSettings = { PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; }; name = ReleasePPC10.2.8SDK; }; @@ -2583,8 +2706,11 @@ F95CC8AC09158F3100EA5ACE /* Debug */, F95CC8AE09158F3100EA5ACE /* DebugNoFixZL */, F99EE73B0BE835310060D4AF /* DebugUnthreaded */, + F98751300DE7B57E00B1C9EC /* DebugNoCF */, + F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F93084370BB93D2800CD0B9E /* DebugMemCompile */, F99EE73C0BE835310060D4AF /* DebugLeaks */, + F9359B260DF212DA00E04F67 /* DebugGCov */, F97AED1B0B660B2100310EA2 /* Debug64bit */, F95CC8AD09158F3100EA5ACE /* Release */, F91BCC4F093152310042A6BF /* ReleaseUniversal */, @@ -2601,8 +2727,11 @@ F95CC8B109158F3100EA5ACE /* Debug */, F95CC8B309158F3100EA5ACE /* DebugNoFixZL */, F99EE73D0BE835310060D4AF /* DebugUnthreaded */, + F98751310DE7B57E00B1C9EC /* DebugNoCF */, + F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F93084380BB93D2800CD0B9E /* DebugMemCompile */, F99EE73E0BE835310060D4AF /* DebugLeaks */, + F9359B270DF212DA00E04F67 /* DebugGCov */, F97AED1C0B660B2100310EA2 /* Debug64bit */, F95CC8B209158F3100EA5ACE /* Release */, F91BCC50093152310042A6BF /* ReleaseUniversal */, @@ -2619,8 +2748,11 @@ F95CC8B609158F3100EA5ACE /* Debug */, F95CC8B809158F3100EA5ACE /* DebugNoFixZL */, F99EE7410BE835310060D4AF /* DebugUnthreaded */, + F987512F0DE7B57E00B1C9EC /* DebugNoCF */, + F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F930843A0BB93D2800CD0B9E /* DebugMemCompile */, F99EE7420BE835310060D4AF /* DebugLeaks */, + F9359B250DF212DA00E04F67 /* DebugGCov */, F97AED1E0B660B2100310EA2 /* Debug64bit */, F95CC8B709158F3100EA5ACE /* Release */, F91BCC51093152310042A6BF /* ReleaseUniversal */, @@ -2637,8 +2769,11 @@ F97258A90A86873D00096C78 /* Debug */, F97258AB0A86873D00096C78 /* DebugNoFixZL */, F99EE73F0BE835310060D4AF /* DebugUnthreaded */, + F98751320DE7B57E00B1C9EC /* DebugNoCF */, + F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F93084390BB93D2800CD0B9E /* DebugMemCompile */, F99EE7400BE835310060D4AF /* DebugLeaks */, + F9359B280DF212DA00E04F67 /* DebugGCov */, F97AED1D0B660B2100310EA2 /* Debug64bit */, F97258AA0A86873D00096C78 /* Release */, F97258AC0A86873D00096C78 /* ReleaseUniversal */, diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj index 3a3b57c..b26e78c 100644 --- a/macosx/Tcl.xcodeproj/project.pbxproj +++ b/macosx/Tcl.xcodeproj/project.pbxproj @@ -3,7 +3,7 @@ archiveVersion = 1; classes = { }; - objectVersion = 42; + objectVersion = 45; objects = { /* Begin PBXBuildFile section */ @@ -933,7 +933,7 @@ F966C06F08F281DC005CB29B /* Frameworks */, 1AB674ADFE9D54B511CA2CBB /* Products */, ); - comments = "Copyright (c) 2004-2008 Daniel A. Steffen <das@users.sourceforge.net>\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.21.2.8 2008/03/28 16:48:06 dgp Exp $\n"; + comments = "Copyright (c) 2004-2008 Daniel A. Steffen <das@users.sourceforge.net>\n\nSee the file \"license.terms\" for information on usage and redistribution of\nthis file, and for a DISCLAIMER OF ALL WARRANTIES.\n\nRCS: @(#) $Id: project.pbxproj,v 1.21.2.9 2008/06/25 15:56:16 dgp Exp $\n"; name = Tcl; path = .; sourceTree = SOURCE_ROOT; @@ -1899,10 +1899,10 @@ 08FB7793FE84155DC02AAC07 /* Project object */ = { isa = PBXProject; attributes = { - BuildIndependentTargetsInParallel = NO; + BuildIndependentTargetsInParallel = YES; }; buildConfigurationList = F95CC8B509158F3100EA5ACE /* Build configuration list for PBXProject "Tcl" */; - compatibilityVersion = "Xcode 2.4"; + compatibilityVersion = "Xcode 3.1"; hasScannedForEncodings = 1; mainGroup = 08FB7794FE84155DC02AAC07 /* Tcl */; projectDirPath = ""; @@ -2185,18 +2185,9 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = ( - ppc, - ppc64, - i386, - x86_64, - ); - CFLAGS = "-arch ppc -arch ppc64 -arch i386 -arch x86_64 $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; + CFLAGS = "-arch i386 -arch x86_64 -arch ppc -arch ppc64 $(CFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; - OTHER_LDFLAGS = ( - "-Wl,-no_arch_warnings", - "$(OTHER_LDFLAGS)", - ); PREBINDING = NO; }; name = ReleaseUniversal; @@ -2237,6 +2228,47 @@ }; name = DebugMemCompile; }; + F9359B250DF212DA00E04F67 /* DebugGCov */ = { + isa = XCBuildConfiguration; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; + buildSettings = { + GCC_GENERATE_TEST_COVERAGE_FILES = YES; + GCC_INSTRUMENT_PROGRAM_FLOW_ARCS = YES; + MACOSX_DEPLOYMENT_TARGET = 10.5; + OTHER_LDFLAGS = ( + "$(OTHER_LDFLAGS)", + "-lgcov", + ); + PREBINDING = NO; + }; + name = DebugGCov; + }; + F9359B260DF212DA00E04F67 /* DebugGCov */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; + }; + name = DebugGCov; + }; + F9359B270DF212DA00E04F67 /* DebugGCov */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tcltest; + }; + name = DebugGCov; + }; + F9359B280DF212DA00E04F67 /* DebugGCov */ = { + isa = XCBuildConfiguration; + buildSettings = { + CODE_SIGN_IDENTITY = ""; + PRODUCT_NAME = tests; + TCLTEST_OPTIONS = "-notfile http.test"; + TCL_LIBRARY = "$(TCL_SRCROOT)/library"; + TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; + }; + name = DebugGCov; + }; F95CC8AC09158F3100EA5ACE /* Debug */ = { isa = XCBuildConfiguration; buildSettings = { @@ -2273,7 +2305,6 @@ ); GCC_SYMBOLS_PRIVATE_EXTERN = NO; PRODUCT_NAME = tcltest; - ZERO_LINK = YES; }; name = Debug; }; @@ -2305,7 +2336,7 @@ baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { MACOSX_DEPLOYMENT_TARGET = 10.5; - PREBINDING = YES; + PREBINDING = NO; }; name = Release; }; @@ -2433,6 +2464,78 @@ }; name = Debug64bit; }; + F987512F0DE7B57E00B1C9EC /* DebugNoCF */ = { + isa = XCBuildConfiguration; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; + buildSettings = { + CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-corefoundation"; + MACOSX_DEPLOYMENT_TARGET = 10.5; + PREBINDING = NO; + }; + name = DebugNoCF; + }; + F98751300DE7B57E00B1C9EC /* DebugNoCF */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; + }; + name = DebugNoCF; + }; + F98751310DE7B57E00B1C9EC /* DebugNoCF */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tcltest; + }; + name = DebugNoCF; + }; + F98751320DE7B57E00B1C9EC /* DebugNoCF */ = { + isa = XCBuildConfiguration; + buildSettings = { + CODE_SIGN_IDENTITY = ""; + PRODUCT_NAME = tests; + TCLTEST_OPTIONS = ""; + TCL_LIBRARY = "$(TCL_SRCROOT)/library"; + TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; + }; + name = DebugNoCF; + }; + F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { + isa = XCBuildConfiguration; + baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; + buildSettings = { + CONFIGURE_ARGS = "$(CONFIGURE_ARGS) --disable-threads --disable-corefoundation"; + MACOSX_DEPLOYMENT_TARGET = 10.5; + PREBINDING = NO; + }; + name = DebugNoCFUnthreaded; + }; + F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tclsh; + SKIP_INSTALL = NO; + }; + name = DebugNoCFUnthreaded; + }; + F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { + isa = XCBuildConfiguration; + buildSettings = { + PRODUCT_NAME = tcltest; + }; + name = DebugNoCFUnthreaded; + }; + F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */ = { + isa = XCBuildConfiguration; + buildSettings = { + CODE_SIGN_IDENTITY = ""; + PRODUCT_NAME = tests; + TCLTEST_OPTIONS = ""; + TCL_LIBRARY = "$(TCL_SRCROOT)/library"; + TEST_RIG = "$(OBJROOT)/$(CONFIGURATION)/tcltest"; + }; + name = DebugNoCFUnthreaded; + }; F9988AB10D814C6500B6B03B /* Debug gcc42 */ = { isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; @@ -2463,7 +2566,6 @@ ); GCC_SYMBOLS_PRIVATE_EXTERN = NO; PRODUCT_NAME = tcltest; - ZERO_LINK = YES; }; name = "Debug gcc42"; }; @@ -2482,8 +2584,8 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE8330B65C87F00310EA2 /* Tcl-Debug.xcconfig */; buildSettings = { - GCC = "$(DEVELOPER_DIR)/usr/bin/llvm-gcc"; - GCC_VERSION = 4.2; + CC = "$(DEVELOPER_DIR)/usr/bin/llvm-gcc-4.2"; + GCC_VERSION = com.apple.compilers.llvmgcc42; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; }; @@ -2509,7 +2611,6 @@ ); GCC_SYMBOLS_PRIVATE_EXTERN = NO; PRODUCT_NAME = tcltest; - ZERO_LINK = YES; }; name = "Debug llvmgcc42"; }; @@ -2528,19 +2629,10 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = ( - ppc, - ppc64, - i386, - x86_64, - ); - CFLAGS = "-arch ppc -arch ppc64 -arch i386 -arch x86_64 $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; + CFLAGS = "-arch i386 -arch x86_64 -arch ppc -arch ppc64 $(CFLAGS)"; GCC_VERSION = 4.2; MACOSX_DEPLOYMENT_TARGET = 10.5; - OTHER_LDFLAGS = ( - "-Wl,-no_arch_warnings", - "$(OTHER_LDFLAGS)", - ); PREBINDING = NO; }; name = "ReleaseUniversal gcc42"; @@ -2575,21 +2667,16 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = ( - ppc, - i386, - x86_64, - ); - CFLAGS = "-arch ppc -arch i386 -arch x86_64 $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; + CC = "$(DEVELOPER_DIR)/usr/bin/llvm-gcc-4.2"; + CFLAGS = "-arch i386 -arch x86_64 -arch ppc -arch ppc64 $(CFLAGS)"; DEBUG_INFORMATION_FORMAT = dwarf; - GCC = "$(DEVELOPER_DIR)/usr/bin/llvm-gcc"; GCC_OPTIMIZATION_LEVEL = 4; - GCC_VERSION = 4.2; + GCC_VERSION = com.apple.compilers.llvmgcc42; MACOSX_DEPLOYMENT_TARGET = 10.5; - OTHER_CFLAGS = "-emit-llvm"; - OTHER_LDFLAGS = ( - "-Wl,-no_arch_warnings", - "$(OTHER_LDFLAGS)", + OTHER_CFLAGS = ( + "$(OTHER_CFLAGS)", + "-emit-llvm", ); PREBINDING = NO; TCL_CONFIGURE_ARGS = "$(TCL_CONFIGURE_ARGS) --disable-dtrace"; @@ -2716,13 +2803,8 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = ( - ppc, - ppc64, - i386, - x86_64, - ); - CFLAGS = "-arch ppc -arch ppc64 -arch i386 -arch x86_64 $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; + CFLAGS = "-arch i386 -arch x86_64 -arch ppc -arch ppc64 $(CFLAGS)"; CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.4; OTHER_LDFLAGS = ( @@ -2730,7 +2812,7 @@ "$(OTHER_LDFLAGS)", ); PREBINDING = NO; - SDKROOT = /Developer/SDKs/MacOSX10.4u.sdk; + SDKROOT = macosx10.4; }; name = ReleaseUniversal10.4uSDK; }; @@ -2759,7 +2841,7 @@ CPPFLAGS = "-arch ppc -isysroot $(SDKROOT) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.3; PREBINDING = YES; - SDKROOT = /Developer/SDKs/MacOSX10.3.9.sdk; + SDKROOT = "$(DEVELOPER_SDK_DIR)/MacOSX10.3.9.sdk"; }; name = ReleasePPC10.3.9SDK; }; @@ -2791,7 +2873,7 @@ LDFLAGS = "-L$(SDKROOT)/usr/lib/gcc/darwin/$(GCC_VERSION) -Wl,-syslibroot,$(SDKROOT)"; MACOSX_DEPLOYMENT_TARGET = 10.2; PREBINDING = YES; - SDKROOT = /Developer/SDKs/MacOSX10.2.8.sdk; + SDKROOT = "$(DEVELOPER_SDK_DIR)/MacOSX10.2.8.sdk"; WARNING_CFLAGS = ( "$(WARNING_CFLAGS_GCC3)", "-Wno-long-double", @@ -2829,17 +2911,12 @@ isa = XCBuildConfiguration; baseConfigurationReference = F97AE82B0B65C69B00310EA2 /* Tcl-Release.xcconfig */; buildSettings = { - ARCHS = ( - ppc, - ppc64, - i386, - x86_64, - ); - CFLAGS = "-arch ppc -arch ppc64 -arch i386 -arch x86_64 $(CFLAGS)"; + ARCHS = "$(ARCHS_STANDARD_32_64_BIT)"; + CFLAGS = "-arch i386 -arch x86_64 -arch ppc -arch ppc64 $(CFLAGS)"; CPPFLAGS = "-isysroot $(SDKROOT) $(CPPFLAGS)"; MACOSX_DEPLOYMENT_TARGET = 10.5; PREBINDING = NO; - SDKROOT = /Developer/SDKs/MacOSX10.5.sdk; + SDKROOT = macosx10.5; }; name = ReleaseUniversal10.5SDK; }; @@ -2854,8 +2931,11 @@ F9988AB60D814C7500B6B03B /* Debug llvmgcc42 */, F95CC8AE09158F3100EA5ACE /* DebugNoFixZL */, F99EE73B0BE835310060D4AF /* DebugUnthreaded */, + F98751300DE7B57E00B1C9EC /* DebugNoCF */, + F98751340DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F93084370BB93D2800CD0B9E /* DebugMemCompile */, F99EE73C0BE835310060D4AF /* DebugLeaks */, + F9359B260DF212DA00E04F67 /* DebugGCov */, F97AED1B0B660B2100310EA2 /* Debug64bit */, F95CC8AD09158F3100EA5ACE /* Release */, F91BCC4F093152310042A6BF /* ReleaseUniversal */, @@ -2877,8 +2957,11 @@ F9988AB70D814C7500B6B03B /* Debug llvmgcc42 */, F95CC8B309158F3100EA5ACE /* DebugNoFixZL */, F99EE73D0BE835310060D4AF /* DebugUnthreaded */, + F98751310DE7B57E00B1C9EC /* DebugNoCF */, + F98751350DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F93084380BB93D2800CD0B9E /* DebugMemCompile */, F99EE73E0BE835310060D4AF /* DebugLeaks */, + F9359B270DF212DA00E04F67 /* DebugGCov */, F97AED1C0B660B2100310EA2 /* Debug64bit */, F95CC8B209158F3100EA5ACE /* Release */, F91BCC50093152310042A6BF /* ReleaseUniversal */, @@ -2900,8 +2983,11 @@ F9988AB50D814C7500B6B03B /* Debug llvmgcc42 */, F95CC8B809158F3100EA5ACE /* DebugNoFixZL */, F99EE7410BE835310060D4AF /* DebugUnthreaded */, + F987512F0DE7B57E00B1C9EC /* DebugNoCF */, + F98751330DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F930843A0BB93D2800CD0B9E /* DebugMemCompile */, F99EE7420BE835310060D4AF /* DebugLeaks */, + F9359B250DF212DA00E04F67 /* DebugGCov */, F97AED1E0B660B2100310EA2 /* Debug64bit */, F95CC8B709158F3100EA5ACE /* Release */, F91BCC51093152310042A6BF /* ReleaseUniversal */, @@ -2923,8 +3009,11 @@ F9988AB80D814C7500B6B03B /* Debug llvmgcc42 */, F97258AB0A86873D00096C78 /* DebugNoFixZL */, F99EE73F0BE835310060D4AF /* DebugUnthreaded */, + F98751320DE7B57E00B1C9EC /* DebugNoCF */, + F98751360DE7B5A200B1C9EC /* DebugNoCFUnthreaded */, F93084390BB93D2800CD0B9E /* DebugMemCompile */, F99EE7400BE835310060D4AF /* DebugLeaks */, + F9359B280DF212DA00E04F67 /* DebugGCov */, F97AED1D0B660B2100310EA2 /* Debug64bit */, F97258AA0A86873D00096C78 /* Release */, F97258AC0A86873D00096C78 /* ReleaseUniversal */, diff --git a/tests/chanio.test b/tests/chanio.test index 3a8dab1..0d2fe22 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: chanio.test,v 1.1.2.3 2007/12/10 18:32:57 dgp Exp $ +# RCS: @(#) $Id: chanio.test,v 1.1.2.4 2008/06/25 15:56:16 dgp Exp $ if {[catch {package require tcltest 2}]} { chan puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -4858,7 +4858,7 @@ test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} { lappend l [chan configure $f -buffersize] chan close $f set l -} {4096 10000 1 1 1 100000 100000} +} {4096 10000 1 1 1 100000 1048576} test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed @@ -5019,22 +5019,22 @@ test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} { chan close $f1 set x } {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1} -test chan-io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { +test chan-io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} { file delete $path(test1) set f [open $path(test1) w] chan configure $f -buffersize -10 set x [chan configure $f -buffersize] chan close $f set x -} 4096 -test chan-io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} { +} 1 +test chan-io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} { file delete $path(test1) set f [open $path(test1) w] chan configure $f -buffersize 10000000 set x [chan configure $f -buffersize] chan close $f set x -} 4096 +} 1048576 test chan-io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { file delete $path(test1) set f [open $path(test1) w] @@ -6541,13 +6541,47 @@ test chan-io-52.4 {TclCopyChannel} {fcopy} { chan close $f2 lappend result [file size $path(test1)] } {0 0 40} -test chan-io-52.5 {TclCopyChannel} {fcopy} { +test chan-io-52.5 {TclCopyChannel, all} {fcopy} { + file delete $path(test1) + set f1 [open $thisScript] + set f2 [open $path(test1) w] + chan configure $f1 -translation lf -blocking 0 + chan configure $f2 -translation lf -blocking 0 + chan copy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified. + set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] + chan close $f1 + chan close $f2 + set s1 [file size $thisScript] + set s2 [file size $path(test1)] + if {"$s1" == "$s2"} { + lappend result ok + } + set result +} {0 0 ok} +test chan-io-52.5a {TclCopyChannel, all, other negative value} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] chan configure $f1 -translation lf -blocking 0 chan configure $f2 -translation lf -blocking 0 - chan copy $f1 $f2 -size -1 + chan copy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all + set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] + chan close $f1 + chan close $f2 + set s1 [file size $thisScript] + set s2 [file size $path(test1)] + if {"$s1" == "$s2"} { + lappend result ok + } + set result +} {0 0 ok} +test chan-io-52.5b {TclCopyChannel, all, wrapped to ngative value} {fcopy} { + file delete $path(test1) + set f1 [open $thisScript] + set f2 [open $path(test1) w] + chan configure $f1 -translation lf -blocking 0 + chan configure $f2 -translation lf -blocking 0 + chan copy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]] chan close $f1 chan close $f2 @@ -6887,6 +6921,211 @@ test chan-io-53.7 {CopyData: Flooding chan copy from pipe} {stdio openpipe fcopy # -1=error 0=script error N=number of bytes expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1 } {3450} +test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup { + # copy progress callback. errors out intentionally + proc ::cmd args { + lappend ::RES "CMD $args" + error !STOP + } + # capture callback error here + proc ::bgerror args { + lappend ::RES "bgerror/OK $args" + set ::forever has-been-reached + return + } + # Files we use for our channels + set foo [makeFile ashgdfashdgfasdhgfasdhgf foo] + set bar [makeFile {} bar] + # Channels to copy between + set f [open $foo r] ; fconfigure $f -translation binary + set g [open $bar w] ; fconfigure $g -translation binary -buffering none +} -constraints {stdio openpipe fcopy} -body { + # Record input size, so that result is always defined + lappend ::RES [file size $bar] + # Run the copy. Should not invoke -command now. + chan copy $f $g -size 2 -command ::cmd + # Check that -command was not called synchronously + set sbs [file size $bar] + lappend ::RES [expr {($sbs > 0) ? "sync/FAIL" : "sync/OK"}] $sbs + # Now let the async part happen. Should capture the error in cmd + # via bgerror. If not break the event loop via timer. + set token [after 1000 { + lappend ::RES {bgerror/FAIL timeout} + set ::forever has-been-reached + }] + vwait ::forever + catch {after cancel $token} + # Report + set ::RES +} -cleanup { + chan close $f + chan close $g + catch {unset ::RES} + catch {unset ::forever} + rename ::cmd {} + rename ::bgerror {} + removeFile foo + removeFile bar +} -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}} +test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} -setup { + # copy progress callback. errors out intentionally + proc ::cmd args { + lappend ::RES "CMD $args" + set ::forever has-been-reached + return + } + # Files we use for our channels + set foo [makeFile ashgdfashdgfasdhgfasdhgf foo] + set bar [makeFile {} bar] + # Channels to copy between + set f [open $foo r] ; chan configure $f -translation binary + set g [open $bar w] ; chan configure $g -translation binary -buffering none +} -constraints {stdio openpipe fcopy} -body { + # Initialize and force eof on the input. + chan seek $f 0 end ; chan read $f 1 + set ::RES [chan eof $f] + # Run the copy. Should not invoke -command now. + chan copy $f $g -size 2 -command ::cmd + # Check that -command was not called synchronously + lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}] + # Now let the async part happen. Should capture the eof in cmd + # If not break the event loop via timer. + set token [after 1000 { + lappend ::RES {cmd/FAIL timeout} + set ::forever has-been-reached + }] + vwait ::forever + catch {after cancel $token} + # Report + set ::RES +} -cleanup { + chan close $f + chan close $g + catch {unset ::RES} + catch {unset ::forever} + rename ::cmd {} + removeFile foo + removeFile bar +} -result {1 sync/OK {CMD 0}} +test chan-io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup { + set out [makeFile {} out] + set err [makeFile {} err] + set pipe [open "|[list [info nameofexecutable] 2> $err]" r+] + chan configure $pipe -translation binary -buffering line + chan puts $pipe { + chan configure stdout -translation binary -buffering line + chan puts stderr Waiting... + after 1000 + foreach x {a b c} { + chan puts stderr Looping... + chan puts $x + after 500 + } + proc bye args { + if {[chan gets stdin line]<0} { + chan puts stderr "CHILD: EOF detected, exiting" + exit + } else { + chan puts stderr "CHILD: ignoring line: $line" + } + } + chan puts stderr Now-sleeping-forever + chan event stdin readable bye + vwait forever + } + proc ::done args { + set ::forever OK + return + } + set ::forever {} + set out [open $out w] +} -constraints {stdio openpipe fcopy} -body { + chan copy $pipe $out -size 6 -command ::done + set token [after 5000 { + set ::forever {fcopy hangs} + }] + vwait ::forever + catch {after cancel $token} + set ::forever +} -cleanup { + chan close $pipe + rename ::done {} + after 1000; # Allow Windows time to figure out that the + # process is gone + catch {removeFile out} + catch {removeFile err} + catch {unset ::forever} +} -result OK +test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup { + set err [makeFile {} err] + set pipe [open "|[list [info nameofexecutable] 2> $err]" r+] + chan configure $pipe -translation binary -buffering line + chan puts $pipe { + chan configure stderr -buffering line + # Kill server when pipe closed by invoker. + proc bye args { + if {![chan eof stdin]} { chan gets stdin ; return } + chan puts stderr BYE + exit + } + # Server code. Bi-directional copy between 2 sockets. + proc geof {sok} { + chan puts stderr DONE/$sok + chan close $sok + } + proc new {sok args} { + chan puts stderr NEW/$sok + global l srv + chan configure $sok -translation binary -buffering none + lappend l $sok + if {[llength $l]==2} { + chan close $srv + foreach {a b} $l break + chan copy $a $b -command [list geof $a] + chan copy $b $a -command [list geof $b] + chan puts stderr 2COPY + } + chan puts stderr ... + } + chan puts stderr SRV + set l {} + set srv [socket -server new 9999] + chan puts stderr WAITING + chan event stdin readable bye + chan puts OK + vwait forever + } + # wait for OK from server. + chan gets $pipe + # Now the two clients. + proc ::done {sock} { + if {[chan eof $sock]} { chan close $sock ; return } + lappend ::forever [chan gets $sock] + return + } + set a [socket 127.0.0.1 9999] + set b [socket 127.0.0.1 9999] + chan configure $a -translation binary -buffering none + chan configure $b -translation binary -buffering none + chan event $a readable [list ::done $a] + chan event $b readable [list ::done $b] +} -constraints {stdio openpipe fcopy} -body { + # Now pass data through the server in both directions. + set ::forever {} + chan puts $a AB + vwait ::forever + chan puts $b BA + vwait ::forever + set ::forever +} -cleanup { + catch {chan close $a} + catch {chan close $b} + chan close $pipe + rename ::done {} + after 1000 ;# Give Windows time to kill the process + removeFile err + catch {unset ::forever} +} -result {AB BA} test chan-io-54.1 {Recursive channel events} {socket fileevent} { # This test checks to see if file events are delivered during recursive @@ -7459,8 +7698,8 @@ test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} {} { # ### ### ### ######### ######### ######### # cleanup -foreach file [list fooBar longfile script output test1 pipe my_script foo \ - bar test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { +foreach file [list fooBar longfile script output test1 pipe my_script \ + test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { removeFile $file } cleanupTests diff --git a/tests/clock.test b/tests/clock.test index cbbc758..2c792b7 100644 --- a/tests/clock.test +++ b/tests/clock.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: clock.test,v 1.79.2.2 2008/03/07 22:05:06 dgp Exp $ +# RCS: @(#) $Id: clock.test,v 1.79.2.3 2008/06/25 15:56:17 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -35464,6 +35464,8 @@ test clock-33.4a {clock milliseconds} { concat {} } {} test clock-33.5 {clock clicks tests, millisecond timing test} { + # This test can fail on a system that is so heavily loaded that + # the test takes >60 ms to run. set start [clock clicks -milli] after 10 set end [clock clicks -milli] @@ -35474,6 +35476,8 @@ test clock-33.5 {clock clicks tests, millisecond timing test} { "test should have taken 0-60 ms, actually took [expr $end - $start]"} } {ok} test clock-33.5a {clock tests, millisecond timing test} { + # This test can fail on a system that is so heavily loaded that + # the test takes >60 ms to run. set start [clock milliseconds] after 10 set end [clock milliseconds] @@ -35491,12 +35495,16 @@ test clock-33.7 {clock clicks, milli with too much abbreviation} { } {1 {ambiguous option "-": must be -milliseconds or -microseconds}} test clock-33.8 {clock clicks test, microsecond timing test} { + # This test can fail on a system that is so heavily loaded that + # the test takes >60 ms to run. set start [clock clicks -micro] after 10 set end [clock clicks -micro] expr {($end > $start) && (($end - $start) <= 60000)} } {1} test clock-33.8a {clock test, microsecond timing test} { + # This test can fail on a system that is so heavily loaded that + # the test takes >60 ms to run. set start [clock microseconds] after 10 set end [clock microseconds] @@ -36628,6 +36636,14 @@ test clock-62.1 {Bug 1902423} {*}{ -result ok } +test clock-63.1 {Incorrect use of internal ConvertLocalToUTC command} {*}{ + -body { + ::tcl::clock::ConvertLocalToUTC {immaterial stuff} {} 12345 + } + -returnCodes error + -result {key "localseconds" not found in dictionary} +} + # cleanup namespace delete ::testClock diff --git a/tests/dict.test b/tests/dict.test index daecb70..a715ee5 100644 --- a/tests/dict.test +++ b/tests/dict.test @@ -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: dict.test,v 1.20.2.3 2008/03/26 20:09:00 dgp Exp $ +# RCS: @(#) $Id: dict.test,v 1.20.2.4 2008/06/25 15:56:17 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -414,6 +414,9 @@ test dict-13.9 {dict append command: write failure} { catch {unset dictVar} set result } {1 {can't set "dictVar": variable is array}} +test dict-13.10 {compiled dict command: crash case} { + apply {{} {dict append dictVar a o k}} +} {a ok} test dict-14.1 {dict for command: syntax} { list [catch {dict for} msg] $msg diff --git a/tests/event.test b/tests/event.test index 7f8e980..807a3dd 100644 --- a/tests/event.test +++ b/tests/event.test @@ -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: event.test,v 1.24.2.2 2008/03/10 19:33:13 dgp Exp $ +# RCS: @(#) $Id: event.test,v 1.24.2.3 2008/06/25 15:56:17 dgp Exp $ package require tcltest 2 namespace import -force ::tcltest::* @@ -205,7 +205,7 @@ test event-5.3 {HandleBgErrors: [Bug 1670155]} -setup { rename demo {} rename trial {} } -result {} -test event-5.3 {Default [interp bgerror] handler} -body { +test event-5.3.1 {Default [interp bgerror] handler} -body { ::tcl::Bgerror } -returnCodes error -match glob -result {*msg options*} test event-5.4 {Default [interp bgerror] handler} -body { diff --git a/tests/format.test b/tests/format.test index ecefa73..d3b6221 100644 --- a/tests/format.test +++ b/tests/format.test @@ -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: format.test,v 1.24.6.1 2008/01/23 16:42:20 dgp Exp $ +# RCS: @(#) $Id: format.test,v 1.24.6.2 2008/06/25 15:56:18 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -496,6 +496,12 @@ test format-15.3 {testing %0..s 0 padding for chars/strings} { test format-15.4 {testing %0..s 0 padding for chars/strings} { format %05c 61 } {0000=} +test format-15.5 {testing %d space padding for integers} { + format "(% 1d) (% 1d)" 10 -10 +} {( 10) (-10)} +test format-15.6 {testing %d plus padding for integers} { + format "(%+1d) (%+1d)" 10 -10 +} {(+10) (-10)} set a "0123456789" set b "" diff --git a/tests/info.test b/tests/info.test index adcc68a..2d86de5 100644 --- a/tests/info.test +++ b/tests/info.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: info.test,v 1.44.2.2 2007/09/11 21:33:01 dgp Exp $ +# RCS: @(#) $Id: info.test,v 1.44.2.3 2008/06/25 15:56:18 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -748,13 +748,13 @@ test info-22.2 {info frame, bad level absolute} {!singleTestInterp} { } {bad level "9"} test info-22.3 {info frame, current, relative} { info frame 0 -} {type eval line 2 cmd {info frame 0}} +} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest} test info-22.4 {info frame, current, relative, nested} { set res [info frame 0] -} {type eval line 2 cmd {info frame 0}} +} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest} test info-22.5 {info frame, current, absolute} {!singleTestInterp} { reduce [info frame 7] -} {type eval line 2 cmd {info frame 7}} +} {type eval line 2 cmd {info frame 7} proc ::tcltest::RunTest} test info-22.6 {info frame, global, relative} {!singleTestInterp} { reduce [info frame -6] } {type source line 758 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0} @@ -787,14 +787,14 @@ test info-23.3 {eval'd info frame, literal} { eval { info frame 0 } -} {type eval line 2 cmd {info frame 0}} +} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest} test info-23.4 {eval'd info frame, semi-dynamic} { eval info frame 0 -} {type eval line 1 cmd {info frame 0}} +} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest} test info-23.5 {eval'd info frame, dynamic} { set script {info frame 0} eval $script -} {type eval line 1 cmd {info frame 0}} +} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest} test info-23.6 {eval'd info frame, trace} {knownBug !singleTestInterp} { set script {etrace} join [eval $script] \n @@ -982,7 +982,7 @@ test info-31.5 {for, script in variable} { test info-31.6 {eval, script in variable} { eval $body set res -} {type eval line 3 cmd {info frame 0}} +} {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest} # ------------------------------------------------------------------------- diff --git a/tests/interp.test b/tests/interp.test index af5bbc6..0e96b1d 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -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: interp.test,v 1.51.2.2 2008/03/07 22:05:08 dgp Exp $ +# RCS: @(#) $Id: interp.test,v 1.51.2.3 2008/06/25 15:56:18 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -3446,6 +3446,29 @@ test interp-36.6 {SlaveBgerror returns handler} -setup { interp delete slave } -result {foo bar soom} +test interp-36.7 {SlaveBgerror sets error handler of slave [1999035]} -setup { + interp create slave + slave alias handler handler + slave bgerror handler + variable result {untouched} + proc handler {args} { + variable result + set result [lindex $args 0] + } +} -body { + slave eval { + variable done {} + after 0 error foo + after 10 [list ::set [namespace which -variable done] {}] + vwait [namespace which -variable done] + } + set result +} -cleanup { + variable result {} + unset result + interp delete slave +} -result foo + # cleanup foreach i [interp slaves] { interp delete $i diff --git a/tests/io.test b/tests/io.test index 490fa97..8168d7b 100644 --- a/tests/io.test +++ b/tests/io.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: io.test,v 1.76.2.3 2007/12/10 18:32:58 dgp Exp $ +# RCS: @(#) $Id: io.test,v 1.76.2.4 2008/06/25 15:56:18 dgp Exp $ if {[catch {package require tcltest 2}]} { puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -4858,7 +4858,7 @@ test io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} { lappend l [fconfigure $f -buffersize] close $f set l -} {4096 10000 1 1 1 100000 100000} +} {4096 10000 1 1 1 100000 1048576} test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed @@ -5019,22 +5019,22 @@ test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} { close $f1 set x } {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1} -test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { +test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -buffersize -10 set x [fconfigure $f -buffersize] close $f set x -} 4096 -test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} { +} 1 +test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -buffersize 10000000 set x [fconfigure $f -buffersize] close $f set x -} 4096 +} 1048576 test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { file delete $path(test1) set f [open $path(test1) w] @@ -6541,13 +6541,47 @@ test io-52.4 {TclCopyChannel} {fcopy} { close $f2 lappend result [file size $path(test1)] } {0 0 40} -test io-52.5 {TclCopyChannel} {fcopy} { +test io-52.5 {TclCopyChannel, all} {fcopy} { + file delete $path(test1) + set f1 [open $thisScript] + set f2 [open $path(test1) w] + fconfigure $f1 -translation lf -blocking 0 + fconfigure $f2 -translation lf -blocking 0 + fcopy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified. + set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] + close $f1 + close $f2 + set s1 [file size $thisScript] + set s2 [file size $path(test1)] + if {"$s1" == "$s2"} { + lappend result ok + } + set result +} {0 0 ok} +test io-52.5a {TclCopyChannel, all, other negative value} {fcopy} { + file delete $path(test1) + set f1 [open $thisScript] + set f2 [open $path(test1) w] + fconfigure $f1 -translation lf -blocking 0 + fconfigure $f2 -translation lf -blocking 0 + fcopy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all + set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] + close $f1 + close $f2 + set s1 [file size $thisScript] + set s2 [file size $path(test1)] + if {"$s1" == "$s2"} { + lappend result ok + } + set result +} {0 0 ok} +test io-52.5b {TclCopyChannel, all, wrapped to negative value} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] fconfigure $f1 -translation lf -blocking 0 fconfigure $f2 -translation lf -blocking 0 - fcopy $f1 $f2 -size -1 + fcopy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 @@ -6887,6 +6921,211 @@ test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio openpipe fcopy} { # -1=error 0=script error N=number of bytes expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1 } {3450} +test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup { + # copy progress callback. errors out intentionally + proc ::cmd args { + lappend ::RES "CMD $args" + error !STOP + } + # capture callback error here + proc ::bgerror args { + lappend ::RES "bgerror/OK $args" + set ::forever has-been-reached + return + } + # Files we use for our channels + set foo [makeFile ashgdfashdgfasdhgfasdhgf foo] + set bar [makeFile {} bar] + # Channels to copy between + set f [open $foo r] ; fconfigure $f -translation binary + set g [open $bar w] ; fconfigure $g -translation binary -buffering none +} -constraints {stdio openpipe fcopy} -body { + # Record input size, so that result is always defined + lappend ::RES [file size $bar] + # Run the copy. Should not invoke -command now. + fcopy $f $g -size 2 -command ::cmd + # Check that -command was not called synchronously + set sbs [file size $bar] + lappend ::RES [expr {($sbs > 0) ? "sync/FAIL" : "sync/OK"}] $sbs + # Now let the async part happen. Should capture the error in cmd + # via bgerror. If not break the event loop via timer. + set token [after 1000 { + lappend ::RES {bgerror/FAIL timeout} + set ::forever has-been-reached + }] + vwait ::forever + catch {after cancel $token} + # Report + set ::RES +} -cleanup { + close $f + close $g + catch {unset ::RES} + catch {unset ::forever} + rename ::cmd {} + rename ::bgerror {} + removeFile foo + removeFile bar +} -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}} +test io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} -setup { + # copy progress callback. errors out intentionally + proc ::cmd args { + lappend ::RES "CMD $args" + set ::forever has-been-reached + return + } + # Files we use for our channels + set foo [makeFile ashgdfashdgfasdhgfasdhgf foo] + set bar [makeFile {} bar] + # Channels to copy between + set f [open $foo r] ; fconfigure $f -translation binary + set g [open $bar w] ; fconfigure $g -translation binary -buffering none +} -constraints {stdio openpipe fcopy} -body { + # Initialize and force eof on the input. + seek $f 0 end ; read $f 1 + set ::RES [eof $f] + # Run the copy. Should not invoke -command now. + fcopy $f $g -size 2 -command ::cmd + # Check that -command was not called synchronously + lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}] + # Now let the async part happen. Should capture the eof in cmd + # If not break the event loop via timer. + set token [after 1000 { + lappend ::RES {cmd/FAIL timeout} + set ::forever has-been-reached + }] + vwait ::forever + catch {after cancel $token} + # Report + set ::RES +} -cleanup { + close $f + close $g + catch {unset ::RES} + catch {unset ::forever} + rename ::cmd {} + removeFile foo + removeFile bar +} -result {1 sync/OK {CMD 0}} +test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup { + set out [makeFile {} out] + set err [makeFile {} err] + set pipe [open "|[list [info nameofexecutable] 2> $err]" r+] + fconfigure $pipe -translation binary -buffering line + puts $pipe { + fconfigure stdout -translation binary -buffering line + puts stderr Waiting... + after 1000 + foreach x {a b c} { + puts stderr Looping... + puts $x + after 500 + } + proc bye args { + if {[gets stdin line]<0} { + puts stderr "CHILD: EOF detected, exiting" + exit + } else { + puts stderr "CHILD: ignoring line: $line" + } + } + puts stderr Now-sleeping-forever + fileevent stdin readable bye + vwait forever + } + proc ::done args { + set ::forever OK + return + } + set ::forever {} + set out [open $out w] +} -constraints {stdio openpipe fcopy} -body { + fcopy $pipe $out -size 6 -command ::done + set token [after 5000 { + set ::forever {fcopy hangs} + }] + vwait ::forever + catch {after cancel $token} + set ::forever +} -cleanup { + close $pipe + rename ::done {} + after 1000; # Give Windows time to kill the process + catch {close $out} + catch {removeFile out} + catch {removeFile err} + catch {unset ::forever} +} -result OK +test io-53.10 {Bug 1350564, multi-directional fcopy} -setup { + set err [makeFile {} err] + set pipe [open "|[list [info nameofexecutable] 2> $err]" r+] + fconfigure $pipe -translation binary -buffering line + puts $pipe { + fconfigure stderr -buffering line + # Kill server when pipe closed by invoker. + proc bye args { + if {![eof stdin]} { gets stdin ; return } + puts stderr BYE + exit + } + # Server code. Bi-directional copy between 2 sockets. + proc geof {sok} { + puts stderr DONE/$sok + close $sok + } + proc new {sok args} { + puts stderr NEW/$sok + global l srv + fconfigure $sok -translation binary -buffering none + lappend l $sok + if {[llength $l]==2} { + close $srv + foreach {a b} $l break + fcopy $a $b -command [list geof $a] + fcopy $b $a -command [list geof $b] + puts stderr 2COPY + } + puts stderr ... + } + puts stderr SRV + set l {} + set srv [socket -server new 9999] + puts stderr WAITING + fileevent stdin readable bye + puts OK + vwait forever + } + # wait for OK from server. + gets $pipe + # Now the two clients. + proc ::done {sock} { + if {[eof $sock]} { close $sock ; return } + lappend ::forever [gets $sock] + return + } + set a [socket 127.0.0.1 9999] + set b [socket 127.0.0.1 9999] + fconfigure $a -translation binary -buffering none + fconfigure $b -translation binary -buffering none + fileevent $a readable [list ::done $a] + fileevent $b readable [list ::done $b] +} -constraints {stdio openpipe fcopy} -body { + # Now pass data through the server in both directions. + set ::forever {} + puts $a AB + vwait ::forever + puts $b BA + vwait ::forever + set ::forever +} -cleanup { + catch {close $a} + catch {close $b} + close $pipe + rename ::done {} + after 1000 ;# Give Windows time to kill the process + removeFile err + catch {unset ::forever} +} -result {AB BA} test io-54.1 {Recursive channel events} {socket fileevent} { # This test checks to see if file events are delivered during recursive @@ -7459,8 +7698,8 @@ test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} { # ### ### ### ######### ######### ######### # cleanup -foreach file [list fooBar longfile script output test1 pipe my_script foo \ - bar test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { +foreach file [list fooBar longfile script output test1 pipe my_script \ + test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { removeFile $file } cleanupTests diff --git a/tests/ioCmd.test b/tests/ioCmd.test index d808db0..17b9d58 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: ioCmd.test,v 1.31.2.4 2008/03/13 14:47:33 dgp Exp $ +# RCS: @(#) $Id: ioCmd.test,v 1.31.2.5 2008/06/25 15:56:18 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -758,6 +758,11 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g # --- --- --- --------- --------- --------- # Helper commands to record the arguments to handler methods. +# Stored in a script so that the threads and interpreters needing this +# code do not need their own copy but can access this variable. + +set helperscript { + proc note {item} {global res; lappend res $item; return} proc track {} {upvar args item; note $item; return} proc notes {items} {foreach i $items {note $i}} @@ -785,6 +790,10 @@ proc onfinal {} { if {[lindex $hargs 0] ne "finalize"} {return} return -code return "" } +} + +# Set everything up in the main thread. +eval $helperscript # --- --- --- --------- --------- --------- # method finalize @@ -1039,7 +1048,7 @@ test iocmd-24.6 {chan write, bad result, zero-length write} -match glob -body { close $c rename foo {} set res -} -result {{write rc* snarf} 1 {write wrote more than requested}} +} -result {{write rc* snarf} 1 {write wrote nothing}} test iocmd-24.7 {chan write, failed write, error return} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code error BOOM!} @@ -1795,6 +1804,102 @@ test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body { rename foo {} set res } -result {{watch rc* write} {} TOCK {} {watch rc* {}}} +test iocmd-31.8 {chan postevent after close throws error} -match glob -setup { + proc foo {args} {oninit; onfinal; track; return} + proc dummy args { return } + set c [chan create {r w} foo] + fileevent $c readable dummy +} -body { + close $c + chan postevent $c read +} -cleanup { + rename foo {} + rename dummy {} +} -returnCodes error -result {can not find reflected channel named "rc*"} + +# --- === *** ########################### +# 'Pull the rug' tests. Create channel in a interpreter A, move to +# other interpreter B, destroy the origin interpreter (A) before or +# during access from B. Must not crash, must return proper errors. + +test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body { + + set ida [interp create];#puts <<$ida>> + set idb [interp create];#puts <<$idb>> + + # Magic to get the test* commands in the slaves + load {} Tcltest $ida + load {} Tcltest $idb + + # Set up channel in interpreter + interp eval $ida $helperscript + set chan [interp eval $ida { + proc foo {args} {oninit seek; onfinal; track; return} + set chan [chan create {r w} foo] + fconfigure $chan -buffering none + set chan + }] + + # Move channel to 2nd interpreter. + interp eval $ida [list testchannel cut $chan] + interp eval $idb [list testchannel splice $chan] + + # Kill origin interpreter, then access channel from 2nd interpreter. + interp delete $ida + + set res {} + lappend res [catch {interp eval $idb [list puts $chan shoo]} msg] $msg + lappend res [catch {interp eval $idb [list tell $chan]} msg] $msg + lappend res [catch {interp eval $idb [list seek $chan 1]} msg] $msg + lappend res [catch {interp eval $idb [list gets $chan]} msg] $msg + lappend res [catch {interp eval $idb [list close $chan]} msg] $msg + set res + +} -constraints {testchannel} \ + -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}} + +test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -match glob -body { + + set ida [interp create];#puts <<$ida>> + set idb [interp create];#puts <<$idb>> + + # Magic to get the test* commands in the slaves + load {} Tcltest $ida + load {} Tcltest $idb + + # Set up channel in thread + set chan [interp eval $ida $helperscript] + set chan [interp eval $ida { + proc foo {args} { + oninit; onfinal; track; + # destroy interpreter during channel access + # Actually not possible for an interp to destory itself. + interp delete {} + return} + set chan [chan create {r w} foo] + fconfigure $chan -buffering none + set chan + }] + + # Move channel to 2nd thread. + interp eval $ida [list testchannel cut $chan] + interp eval $idb [list testchannel splice $chan] + + # Run access from interpreter B, this will give us a synchronous + # response. + + interp eval $idb [list set chan $chan] + interp eval $idb [list set mid $tcltest::mainThread] + set res [interp eval $idb { + # wait a bit, give the main thread the time to start its event + # loop to wait for the response from B + after 2000 + catch { puts $chan shoo } res + set res + }] + set res +} -constraints {testchannel impossible} \ + -result {Owner lost} # ### ### ### ######### ######### ######### ## Same tests as above, but exercising the code forwarding and @@ -3184,6 +3289,90 @@ test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body { } -constraints {testchannel testthread} \ -result {{can not find reflected channel named "rc*"}} +# --- === *** ########################### +# 'Pull the rug' tests. Create channel in a thread A, move to other +# thread B, destroy the origin thread (A) before or during access from +# B. Must not crash, must return proper errors. + +test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body { + + #puts <<$tcltest::mainThread>>main + set tida [testthread create];#puts <<$tida>> + set tidb [testthread create];#puts <<$tidb>> + + # Set up channel in thread + testthread send $tida $helperscript + set chan [testthread send $tida { + proc foo {args} {oninit seek; onfinal; track; return} + set chan [chan create {r w} foo] + fconfigure $chan -buffering none + set chan + }] + + # Move channel to 2nd thread. + testthread send $tida [list testchannel cut $chan] + testthread send $tidb [list testchannel splice $chan] + + # Kill origin thread, then access channel from 2nd thread. + testthread send -async $tida {testthread exit} + after 100 + + set res {} + lappend res [catch {testthread send $tidb [list puts $chan shoo]} msg] $msg + + lappend res [catch {testthread send $tidb [list tell $chan]} msg] $msg + lappend res [catch {testthread send $tidb [list seek $chan 1]} msg] $msg + lappend res [catch {testthread send $tidb [list gets $chan]} msg] $msg + lappend res [catch {testthread send $tidb [list close $chan]} msg] $msg + tcltest::threadReap + set res + +} -constraints {testchannel testthread} \ + -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}} + +test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body { + + #puts <<$tcltest::mainThread>>main + set tida [testthread create];#puts <<$tida>> + set tidb [testthread create];#puts <<$tidb>> + + # Set up channel in thread + set chan [testthread send $tida $helperscript] + set chan [testthread send $tida { + proc foo {args} { + oninit; onfinal; track; + # destroy thread during channel access + testthread exit + return} + set chan [chan create {r w} foo] + fconfigure $chan -buffering none + set chan + }] + + # Move channel to 2nd thread. + testthread send $tida [list testchannel cut $chan] + testthread send $tidb [list testchannel splice $chan] + + # Run access from thread B, wait for response from A (A is not + # using event loop at this point, so the event pile up in the + # queue. + + testthread send $tidb [list set chan $chan] + testthread send $tidb [list set mid $tcltest::mainThread] + testthread send -async $tidb { + # wait a bit, give the main thread the time to start its event + # loop to wait for the response from B + after 2000 + catch { puts $chan shoo } res + testthread send -async $mid [list set ::res $res] + } + vwait ::res + + tcltest::threadReap + set res +} -constraints {testchannel testthread} \ + -result {Owner lost} + # ### ### ### ######### ######### ######### # ### ### ### ######### ######### ######### diff --git a/tests/mathop.test b/tests/mathop.test index c784b51..833a79a 100644 --- a/tests/mathop.test +++ b/tests/mathop.test @@ -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: mathop.test,v 1.8.2.2 2007/10/16 03:50:33 dgp Exp $ +# RCS: @(#) $Id: mathop.test,v 1.8.2.3 2008/06/25 15:56:18 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -1202,12 +1202,12 @@ test mathop-25.5 { exp operator } {TestOp ** 1 5} 1 test mathop-25.6 { exp operator } {TestOp ** 5 1} 5 test mathop-25.7 { exp operator } {TestOp ** 4 3 2 1} 262144 test mathop-25.8 { exp operator } {TestOp ** 5.5 4} 915.0625 -test mathop-25.9 { exp operator } {TestOp ** 6 3.5} 529.0897844411664 +test mathop-25.9 { exp operator } {TestOp ** 16 3.5} 16384.0 test mathop-25.10 { exp operator } {TestOp ** 3.5 0} 1.0 test mathop-25.11 { exp operator } {TestOp ** 378 0} 1 test mathop-25.12 { exp operator } {TestOp ** 7.8 1} 7.8 test mathop-25.13 { exp operator } {TestOp ** 748 1} 748 -test mathop-25.14 { exp operator } {TestOp ** 6.3 -1} 0.15873015873015872 +test mathop-25.14 { exp operator } {TestOp ** 1.6 -1} 0.625 test mathop-25.15 { exp operator } {TestOp ** 683 -1} 0 test mathop-25.16 { exp operator } {TestOp ** 1 -1} 1 test mathop-25.17 { exp operator } {TestOp ** -1 -1} -1 diff --git a/tests/namespace.test b/tests/namespace.test index 0fe16d3..16dc19e 100644 --- a/tests/namespace.test +++ b/tests/namespace.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: namespace.test,v 1.66.2.3 2007/11/21 06:30:57 dgp Exp $ +# RCS: @(#) $Id: namespace.test,v 1.66.2.4 2008/06/25 15:56:19 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -2619,6 +2619,15 @@ test namespace-52.11 {unknown: with TCL_EVAL_INVOKE} -setup { rename unknown.save ::unknown namespace eval :: [list namespace unknown $handler] } -result SUCCESS +test namespace-52.12 {unknown: error case must not reset handler} -body { + namespace eval foo { + namespace unknown ok + catch {namespace unknown {{}{}{}}} + namespace unknown + } +} -cleanup { + namespace delete foo +} -result ok # cleanup catch {rename cmd1 {}} diff --git a/tests/parse.test b/tests/parse.test index fd8afe0..2b6bdc2 100644 --- a/tests/parse.test +++ b/tests/parse.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parse.test,v 1.27.2.2 2007/06/05 14:09:38 dgp Exp $ +# RCS: @(#) $Id: parse.test,v 1.27.2.3 2008/06/25 15:56:19 dgp Exp $ if {[catch {package require tcltest 2.0.2}]} { puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required." @@ -884,6 +884,10 @@ test parse-15.59 {CommandComplete procedure} { # Test for Tcl Bug 684744 info complete [encoding convertfrom identity "\x00;if 1 \{"] } 0 +test parse-15.60 {CommandComplete procedure} { + # Test for Tcl Bug 1968882 + info complete \\\n +} 0 test parse-16.1 {Tcl_EvalEx, check termOffset is set correctly for non TCL_OK cases, bug 2535} { subst {[eval {return foo}]bar} diff --git a/unix/Makefile.in b/unix/Makefile.in index 116e793..d96c8c0 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -4,7 +4,7 @@ # "./configure", which is a configuration script generated by the "autoconf" # program (constructs like "@foo@" will get replaced in the actual Makefile. # -# RCS: @(#) $Id: Makefile.in,v 1.207.2.15 2008/03/13 14:47:34 dgp Exp $ +# RCS: @(#) $Id: Makefile.in,v 1.207.2.16 2008/06/25 15:56:20 dgp Exp $ VERSION = @TCL_VERSION@ MAJOR_VERSION = @TCL_MAJOR_VERSION@ @@ -883,7 +883,7 @@ Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in clean: rm -f *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \ - errors tclsh tcltest lib.exp Tcl + errors tclsh tcltest lib.exp Tcl @DTRACE_HDR@ cd dltest ; $(MAKE) clean distclean: clean @@ -1449,7 +1449,7 @@ tclMacOSXNotify.o: $(MAC_OSX_DIR)/tclMacOSXNotify.c # DTrace support -$(TCL_OBJS): @DTRACE_HDR@ +$(TCL_OBJS) $(STUB_LIB_OBJS) $(TCLSH_OBJS) $(TCLTEST_OBJS) $(XTTEST_OBJS): @DTRACE_HDR@ $(DTRACE_HDR): $(DTRACE_SRC) $(DTRACE) -h $(DTRACE_SWITCHES) -o $@ -s $(DTRACE_SRC) diff --git a/unix/configure b/unix/configure index 099969b..018276f 100755 --- a/unix/configure +++ b/unix/configure @@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".2" +TCL_PATCH_LEVEL=".3b1" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ @@ -7439,14 +7439,6 @@ fi CFLAGS="$CFLAGS -fno-inline" fi - - # XIM peeking works under XFree86. - -cat >>confdefs.h <<\_ACEOF -#define PEEK_XCLOSEIM 1 -_ACEOF - - ;; GNU*) SHLIB_CFLAGS="-fPIC" @@ -8429,14 +8421,27 @@ else if test "$GCC" = yes; then - { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 -echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;} + case $system in + SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) + do64bit_ok=yes + CFLAGS="$CFLAGS -m64" + LDFLAGS="$LDFLAGS -m64";; + *) + { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5 +echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};; + esac else do64bit_ok=yes - CFLAGS="$CFLAGS -xarch=amd64" - LDFLAGS="$LDFLAGS -xarch=amd64" + case $system in + SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*) + CFLAGS="$CFLAGS -m64" + LDFLAGS="$LDFLAGS -m64";; + *) + CFLAGS="$CFLAGS -xarch=amd64" + LDFLAGS="$LDFLAGS -xarch=amd64";; + esac fi @@ -8452,6 +8457,175 @@ fi fi + #-------------------------------------------------------------------- + # On Solaris 5.x i386 with the sunpro compiler we need to link + # with sunmath to get floating point rounding control + #-------------------------------------------------------------------- + if test "$GCC" = yes; then + use_sunmath=no +else + + arch=`isainfo` + echo "$as_me:$LINENO: checking whether to use -lsunmath for fp rounding control" >&5 +echo $ECHO_N "checking whether to use -lsunmath for fp rounding control... $ECHO_C" >&6 + if test "$arch" = "amd64 i386"; then + + echo "$as_me:$LINENO: result: yes" >&5 +echo "${ECHO_T}yes" >&6 + MATH_LIBS="-lsunmath $MATH_LIBS" + if test "${ac_cv_header_sunmath_h+set}" = set; then + echo "$as_me:$LINENO: checking for sunmath.h" >&5 +echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6 +if test "${ac_cv_header_sunmath_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +fi +echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5 +echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6 +else + # Is the header compilable? +echo "$as_me:$LINENO: checking sunmath.h usability" >&5 +echo $ECHO_N "checking sunmath.h usability... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +$ac_includes_default +#include <sunmath.h> +_ACEOF +rm -f conftest.$ac_objext +if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 + (eval $ac_compile) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest.$ac_objext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + ac_header_compiler=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +ac_header_compiler=no +fi +rm -f conftest.err conftest.$ac_objext conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_compiler" >&5 +echo "${ECHO_T}$ac_header_compiler" >&6 + +# Is the header present? +echo "$as_me:$LINENO: checking sunmath.h presence" >&5 +echo $ECHO_N "checking sunmath.h presence... $ECHO_C" >&6 +cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <sunmath.h> +_ACEOF +if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5 + (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } >/dev/null; then + if test -s conftest.err; then + ac_cpp_err=$ac_c_preproc_warn_flag + ac_cpp_err=$ac_cpp_err$ac_c_werror_flag + else + ac_cpp_err= + fi +else + ac_cpp_err=yes +fi +if test -z "$ac_cpp_err"; then + ac_header_preproc=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_header_preproc=no +fi +rm -f conftest.err conftest.$ac_ext +echo "$as_me:$LINENO: result: $ac_header_preproc" >&5 +echo "${ECHO_T}$ac_header_preproc" >&6 + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in + yes:no: ) + { echo "$as_me:$LINENO: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&5 +echo "$as_me: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&2;} + { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the compiler's result" >&5 +echo "$as_me: WARNING: sunmath.h: proceeding with the compiler's result" >&2;} + ac_header_preproc=yes + ;; + no:yes:* ) + { echo "$as_me:$LINENO: WARNING: sunmath.h: present but cannot be compiled" >&5 +echo "$as_me: WARNING: sunmath.h: present but cannot be compiled" >&2;} + { echo "$as_me:$LINENO: WARNING: sunmath.h: check for missing prerequisite headers?" >&5 +echo "$as_me: WARNING: sunmath.h: check for missing prerequisite headers?" >&2;} + { echo "$as_me:$LINENO: WARNING: sunmath.h: see the Autoconf documentation" >&5 +echo "$as_me: WARNING: sunmath.h: see the Autoconf documentation" >&2;} + { echo "$as_me:$LINENO: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&5 +echo "$as_me: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&2;} + { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the preprocessor's result" >&5 +echo "$as_me: WARNING: sunmath.h: proceeding with the preprocessor's result" >&2;} + { echo "$as_me:$LINENO: WARNING: sunmath.h: in the future, the compiler will take precedence" >&5 +echo "$as_me: WARNING: sunmath.h: in the future, the compiler will take precedence" >&2;} + ( + cat <<\_ASBOX +## ------------------------------ ## +## Report this to the tcl lists. ## +## ------------------------------ ## +_ASBOX + ) | + sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac +echo "$as_me:$LINENO: checking for sunmath.h" >&5 +echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6 +if test "${ac_cv_header_sunmath_h+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + ac_cv_header_sunmath_h=$ac_header_preproc +fi +echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5 +echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6 + +fi + + + use_sunmath=yes + +else + + echo "$as_me:$LINENO: result: no" >&5 +echo "${ECHO_T}no" >&6 + use_sunmath=no + +fi + + +fi + + # Note: need the LIBS below, otherwise Tk won't find Tcl's # symbols when dynamically loaded into tclsh. @@ -8466,24 +8640,42 @@ fi LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} if test "$do64bit_ok" = yes; then - # We need to specify -static-libgcc or we need to - # add the path to the sparv9 libgcc. - SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" - # for finding sparcv9 libgcc, get the regular libgcc - # path, remove so name and append 'sparcv9' - #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." - #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" + if test "$arch" = "sparcv9 sparc"; then + + # We need to specify -static-libgcc or we need to + # add the path to the sparv9 libgcc. + SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" + # for finding sparcv9 libgcc, get the regular libgcc + # path, remove so name and append 'sparcv9' + #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." + #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" + +else + if test "$arch" = "amd64 i386"; then + + SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" + +fi fi +fi + + +else + + if test "$use_sunmath" = yes; then + textmode=textoff else + textmode=text +fi case $system in SunOS-5.[1-9][0-9]*) - SHLIB_LD='${CC} -G -z text ${LDFLAGS}';; + SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";; *) - SHLIB_LD='/usr/ccs/bin/ld -G -z text';; + SHLIB_LD="/usr/ccs/bin/ld -G -z $textmode";; esac CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' @@ -16650,6 +16842,75 @@ done #-------------------------------------------------------------------- +# Check for support of isnan() function or macro +#-------------------------------------------------------------------- + +echo "$as_me:$LINENO: checking isnan" >&5 +echo $ECHO_N "checking isnan... $ECHO_C" >&6 +if test "${tcl_cv_isnan+set}" = set; then + echo $ECHO_N "(cached) $ECHO_C" >&6 +else + + cat >conftest.$ac_ext <<_ACEOF +/* confdefs.h. */ +_ACEOF +cat confdefs.h >>conftest.$ac_ext +cat >>conftest.$ac_ext <<_ACEOF +/* end confdefs.h. */ +#include <math.h> +int +main () +{ + +isnan(0.0); /* Generates an error if isnan is missing */ + + ; + return 0; +} +_ACEOF +rm -f conftest.$ac_objext conftest$ac_exeext +if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 + (eval $ac_link) 2>conftest.er1 + ac_status=$? + grep -v '^ *+' conftest.er1 >conftest.err + rm -f conftest.er1 + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } && + { ac_try='test -z "$ac_c_werror_flag" + || test ! -s conftest.err' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; } && + { ac_try='test -s conftest$ac_exeext' + { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 + (eval $ac_try) 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); }; }; then + tcl_cv_isnan=yes +else + echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +tcl_cv_isnan=no +fi +rm -f conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +echo "$as_me:$LINENO: result: $tcl_cv_isnan" >&5 +echo "${ECHO_T}$tcl_cv_isnan" >&6 +if test $tcl_cv_isnan = no; then + +cat >>confdefs.h <<\_ACEOF +#define NO_ISNAN 1 +_ACEOF + +fi + +#-------------------------------------------------------------------- # Darwin specific API checks and defines #-------------------------------------------------------------------- @@ -18365,6 +18626,15 @@ _ACEOF DTRACE_HDR="\${DTRACE_HDR}" if test "`uname -s`" != "Darwin" ; then DTRACE_OBJ="\${DTRACE_OBJ}" + if test "`uname -s`" = "SunOS" -a "$SHARED_BUILD" = "0" ; then + # Need to create an intermediate object file to ensure tclDTrace.o + # gets included when linking against the static tcl library. + STLIB_LD='stlib_ld () { /usr/ccs/bin/ld -r -o $${1%.a}.o "$${@:2}" && '"${STLIB_LD}"' $${1} $${1%.a}.o ; } && stlib_ld' + # Force use of Sun ar and ranlib, the GNU versions choke on + # tclDTrace.o and the combined object file above. + AR='/usr/ccs/bin/ar' + RANLIB='/usr/ccs/bin/ranlib' + fi fi fi echo "$as_me:$LINENO: result: $tcl_ok" >&5 diff --git a/unix/configure.in b/unix/configure.in index 2fa6d1f..69ffb39 100644 --- a/unix/configure.in +++ b/unix/configure.in @@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to dnl generate the file "configure", which is run during Tcl installation dnl to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.157.2.17 2008/03/13 20:29:39 dgp Exp $ +# RCS: @(#) $Id: configure.in,v 1.157.2.18 2008/06/25 15:56:26 dgp Exp $ AC_INIT([tcl],[8.5]) AC_PREREQ(2.59) @@ -27,7 +27,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".2" +TCL_PATCH_LEVEL=".3b1" VERSION=${TCL_VERSION} #------------------------------------------------------------------------ @@ -492,6 +492,18 @@ SC_ENABLE_LANGINFO AC_CHECK_FUNCS(chflags) #-------------------------------------------------------------------- +# Check for support of isnan() function or macro +#-------------------------------------------------------------------- + +AC_CACHE_CHECK([isnan], tcl_cv_isnan, [ + AC_TRY_LINK([#include <math.h>], [ +isnan(0.0); /* Generates an error if isnan is missing */ +], tcl_cv_isnan=yes, tcl_cv_isnan=no)]) +if test $tcl_cv_isnan = no; then + AC_DEFINE(NO_ISNAN, 1, [Do we have a usable 'isnan'?]) +fi + +#-------------------------------------------------------------------- # Darwin specific API checks and defines #-------------------------------------------------------------------- @@ -651,6 +663,15 @@ if test $tcl_ok = yes; then DTRACE_HDR="\${DTRACE_HDR}" if test "`uname -s`" != "Darwin" ; then DTRACE_OBJ="\${DTRACE_OBJ}" + if test "`uname -s`" = "SunOS" -a "$SHARED_BUILD" = "0" ; then + # Need to create an intermediate object file to ensure tclDTrace.o + # gets included when linking against the static tcl library. + STLIB_LD='stlib_ld () { /usr/ccs/bin/ld -r -o $${1%.a}.o "$${@:2}" && '"${STLIB_LD}"' $${1} $${1%.a}.o ; } && stlib_ld' + # Force use of Sun ar and ranlib, the GNU versions choke on + # tclDTrace.o and the combined object file above. + AR='/usr/ccs/bin/ar' + RANLIB='/usr/ccs/bin/ranlib' + fi fi fi AC_MSG_RESULT([$tcl_ok]) diff --git a/unix/tcl.m4 b/unix/tcl.m4 index 0b69ba0..1659a12 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -1454,10 +1454,6 @@ dnl AC_CHECK_TOOL(AR, ar) # files in compat/*.c is being linked in. AS_IF([test x"${USE_COMPAT}" != x],[CFLAGS="$CFLAGS -fno-inline"]) - - # XIM peeking works under XFree86. - AC_DEFINE(PEEK_XCLOSEIM, 1, [May we use XIM peeking safely?]) - ;; GNU*) SHLIB_CFLAGS="-fPIC" @@ -1922,15 +1918,46 @@ dnl AC_CHECK_TOOL(AR, ar) ]) ], [AS_IF([test "$arch" = "amd64 i386"], [ AS_IF([test "$GCC" = yes], [ - AC_MSG_WARN([64bit mode not supported with GCC on $system]) + case $system in + SunOS-5.1[[1-9]]*|SunOS-5.[[2-9]][[0-9]]*) + do64bit_ok=yes + CFLAGS="$CFLAGS -m64" + LDFLAGS="$LDFLAGS -m64";; + *) + AC_MSG_WARN([64bit mode not supported with GCC on $system]);; + esac ], [ do64bit_ok=yes - CFLAGS="$CFLAGS -xarch=amd64" - LDFLAGS="$LDFLAGS -xarch=amd64" + case $system in + SunOS-5.1[[1-9]]*|SunOS-5.[[2-9]][[0-9]]*) + CFLAGS="$CFLAGS -m64" + LDFLAGS="$LDFLAGS -m64";; + *) + CFLAGS="$CFLAGS -xarch=amd64" + LDFLAGS="$LDFLAGS -xarch=amd64";; + esac ]) ], [AC_MSG_WARN([64bit mode not supported for $arch])])]) ]) - + + #-------------------------------------------------------------------- + # On Solaris 5.x i386 with the sunpro compiler we need to link + # with sunmath to get floating point rounding control + #-------------------------------------------------------------------- + AS_IF([test "$GCC" = yes],[use_sunmath=no],[ + arch=`isainfo` + AC_MSG_CHECKING([whether to use -lsunmath for fp rounding control]) + AS_IF([test "$arch" = "amd64 i386"], [ + AC_MSG_RESULT([yes]) + MATH_LIBS="-lsunmath $MATH_LIBS" + AC_CHECK_HEADER(sunmath.h) + use_sunmath=yes + ], [ + AC_MSG_RESULT([no]) + use_sunmath=no + ]) + ]) + # Note: need the LIBS below, otherwise Tk won't find Tcl's # symbols when dynamically loaded into tclsh. @@ -1943,20 +1970,25 @@ dnl AC_CHECK_TOOL(AR, ar) CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS} AS_IF([test "$do64bit_ok" = yes], [ - # We need to specify -static-libgcc or we need to - # add the path to the sparv9 libgcc. - SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" - # for finding sparcv9 libgcc, get the regular libgcc - # path, remove so name and append 'sparcv9' - #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." - #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" + AS_IF([test "$arch" = "sparcv9 sparc"], [ + # We need to specify -static-libgcc or we need to + # add the path to the sparv9 libgcc. + SHLIB_LD="$SHLIB_LD -m64 -mcpu=v9 -static-libgcc" + # for finding sparcv9 libgcc, get the regular libgcc + # path, remove so name and append 'sparcv9' + #v9gcclibdir="`gcc -print-file-name=libgcc_s.so` | ..." + #CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir" + ], [AS_IF([test "$arch" = "amd64 i386"], [ + SHLIB_LD="$SHLIB_LD -m64 -static-libgcc" + ])]) ]) ], [ + AS_IF([test "$use_sunmath" = yes], [textmode=textoff],[textmode=text]) case $system in SunOS-5.[[1-9]][[0-9]]*) - SHLIB_LD='${CC} -G -z text ${LDFLAGS}';; + SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";; *) - SHLIB_LD='/usr/ccs/bin/ld -G -z text';; + SHLIB_LD="/usr/ccs/bin/ld -G -z $textmode";; esac CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}' LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}' diff --git a/unix/tcl.spec b/unix/tcl.spec index 2953d45..ee05ed9 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -1,11 +1,11 @@ -# $Id: tcl.spec,v 1.27.2.7 2008/03/07 22:05:10 dgp Exp $ +# $Id: tcl.spec,v 1.27.2.8 2008/06/25 15:56:27 dgp Exp $ # This file is the basis for a binary Tcl RPM for Linux. %{!?directory:%define directory /usr/local} Name: tcl Summary: Tcl scripting language development environment -Version: 8.5.2 +Version: 8.5.3b1 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index 986c721..8848a62 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -289,6 +289,9 @@ /* Do we have getwd() */ #undef NO_GETWD +/* Do we have a usable 'isnan'? */ +#undef NO_ISNAN + /* Do we have <limits.h>? */ #undef NO_LIMITS_H @@ -337,9 +340,6 @@ /* Define to the version of this package. */ #undef PACKAGE_VERSION -/* May we use XIM peeking safely? */ -#undef PEEK_XCLOSEIM - /* Is this a static build? */ #undef STATIC_BUILD diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index 69367b5..d81228b 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.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: tclUnixTime.c,v 1.30.2.2 2007/11/12 19:18:24 dgp Exp $ + * RCS: @(#) $Id: tclUnixTime.c,v 1.30.2.3 2008/06/25 15:56:27 dgp Exp $ */ #include "tclInt.h" @@ -603,9 +603,8 @@ NativeGetTime( ClientData clientData) { struct timeval tv; - struct timezone tz; - (void) gettimeofday(&tv, &tz); + (void) gettimeofday(&tv, NULL); timePtr->sec = tv.tv_sec; timePtr->usec = tv.tv_usec; } diff --git a/win/configure b/win/configure index afe600c..78c8160 100755 --- a/win/configure +++ b/win/configure @@ -1272,7 +1272,7 @@ SHELL=/bin/sh TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".2" +TCL_PATCH_LEVEL=".3b1" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 @@ -3984,7 +3984,7 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6 CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\"" RC="\"${MSSDK}/bin/rc.exe\"" - CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" + CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}" # Do not use -O2 for Win64 - this has proved buggy in code gen. CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}" lflags="-nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" @@ -4122,6 +4122,9 @@ _ACEOF MAKE_EXE="\${CC} -Fe\$@" LIBPREFIX="" + CFLAGS_DEBUG="${CFLAGS_DEBUG} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE" + CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE" + EXTRA_CFLAGS="" CFLAGS_WARNING="-W3" LDFLAGS_DEBUG="-debug:full" diff --git a/win/configure.in b/win/configure.in index 846e59f..1ebd570 100644 --- a/win/configure.in +++ b/win/configure.in @@ -3,7 +3,7 @@ # generate the file "configure", which is run during Tcl installation # to configure the system for the local environment. # -# RCS: @(#) $Id: configure.in,v 1.92.2.8 2008/03/07 22:05:11 dgp Exp $ +# RCS: @(#) $Id: configure.in,v 1.92.2.9 2008/06/25 15:56:27 dgp Exp $ AC_INIT(../generic/tcl.h) AC_PREREQ(2.59) @@ -16,7 +16,7 @@ SHELL=/bin/sh TCL_VERSION=8.5 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=5 -TCL_PATCH_LEVEL=".2" +TCL_PATCH_LEVEL=".3b1" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.3 diff --git a/win/makefile.vc b/win/makefile.vc index 3fda014..a08d6e7 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -1,4 +1,4 @@ -#------------------------------------------------------------------------------ +#------------------------------------------------------------- -*- makefile -*- # makefile.vc -- # # Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+) @@ -10,9 +10,10 @@ # Copyright (c) 1998-2000 Ajuba Solutions. # Copyright (c) 2001-2005 ActiveState Corporation. # Copyright (c) 2001-2004 David Gravereaux. +# Copyright (c) 2003-2008 Pat Thoyts. # #------------------------------------------------------------------------------ -# RCS: @(#) $Id: makefile.vc,v 1.160.2.9 2008/01/23 16:42:26 dgp Exp $ +# RCS: @(#) $Id: makefile.vc,v 1.160.2.10 2008/06/25 15:56:27 dgp Exp $ #------------------------------------------------------------------------------ # Check to see we are configured to build with MSVC (MSDEVDIR or MSVCDIR) @@ -410,6 +411,9 @@ cdebug = -O2 $(OPTIMIZATIONS) !else cdebug = !endif +!if $(SYMBOLS) +cdebug = $(cdebug) -Zi +!endif !else if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64" ### Warnings are too many, can't support warnings into errors. cdebug = -Zi -Od $(DEBUGFLAGS) @@ -440,7 +444,8 @@ TCL_DEFINES = -DTCL_PIPE_DLL=\"$(TCLPIPEDLLNAME)\" -DTCL_TOMMATH -DMP_PREC=4 -Di BASE_CFLAGS = $(cflags) $(cdebug) $(crt) $(TCL_INCLUDES) $(TCL_DEFINES) CON_CFLAGS = $(cflags) $(cdebug) $(crt) -DCONSOLE TCL_CFLAGS = $(BASE_CFLAGS) $(OPTDEFINES) -STUB_CFLAGS = $(cflags) $(cdebug) $(OPTDEFINES) +### Stubs files should not be compiled with -GL +STUB_CFLAGS = $(cflags) $(cdebug:-GL=) $(OPTDEFINES) #--------------------------------------------------------------------- @@ -451,6 +456,9 @@ STUB_CFLAGS = $(cflags) $(cdebug) $(OPTDEFINES) ldebug = -debug:full -debugtype:cv !else ldebug = -release -opt:ref -opt:icf,3 +!if $(SYMBOLS) +ldebug = $(ldebug) -debug:full -debugtype:cv +!endif !endif ### Declarations common to all linker options @@ -525,7 +533,7 @@ test: setup $(TCLTEST) dlls $(CAT32) runtest: setup $(TCLTEST) dlls $(CAT32) set TCL_LIBRARY=$(ROOT)/library - $(TCLTEST) + $(DEBUGGER) $(TCLTEST) setup: @if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) @@ -566,7 +574,9 @@ $(TCLPIPEDLL): $(WINDIR)\stub16.c $(_VC_MANIFEST_EMBED_DLL) !if $(STATIC_BUILD) -!if !$(TCL_USE_STATIC_PACKAGES) +!if $(TCL_USE_STATIC_PACKAGES) +$(TCLDDELIB): +!else $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinDde.obj !endif @@ -580,7 +590,9 @@ $(TCLDDELIB): $(TMP_DIR)\tclWinDde.obj $(TCLSTUBLIB) !endif !if $(STATIC_BUILD) -!if !$(TCL_USE_STATIC_PACKAGES) +!if $(TCL_USE_STATIC_PACKAGES) +$(TCLREGLIB): +!else $(TCLREGLIB): $(TMP_DIR)\tclWinReg.obj $(lib32) -nologo -out:$@ $(TMP_DIR)\tclWinReg.obj !endif @@ -985,7 +997,9 @@ install-libraries: tclConfig install-msgs install-tzdata "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform\shell-$(PKG_SHELL_VER).tm" @echo Installing $(TCLDDELIBNAME) !if $(STATIC_BUILD) +!if !$(TCL_USE_STATIC_PACKAGES) @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\" +!endif !else @$(CPY) "$(TCLDDELIB)" "$(LIB_INSTALL_DIR)\dde$(DDEDOTVERSION)\" @$(CPY) "$(ROOT)\library\dde\pkgIndex.tcl" \ @@ -993,7 +1007,9 @@ install-libraries: tclConfig install-msgs install-tzdata !endif @echo Installing $(TCLREGLIBNAME) !if $(STATIC_BUILD) +!if !$(TCL_USE_STATIC_PACKAGES) @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\" +!endif !else @$(CPY) "$(TCLREGLIB)" "$(LIB_INSTALL_DIR)\reg$(REGDOTVERSION)\" @$(CPY) "$(ROOT)\library\reg\pkgIndex.tcl" \ diff --git a/win/rules.vc b/win/rules.vc index 2c9ad20..1dfc7e1 100644 --- a/win/rules.vc +++ b/win/rules.vc @@ -11,7 +11,7 @@ # Copyright (c) 2003-2007 Patrick Thoyts # #------------------------------------------------------------------------------ -# RCS: @(#) $Id: rules.vc,v 1.29.2.4 2007/12/10 18:33:38 dgp Exp $ +# RCS: @(#) $Id: rules.vc,v 1.29.2.5 2008/06/25 15:56:27 dgp Exp $ #------------------------------------------------------------------------------ !ifndef _RULES_VC @@ -214,6 +214,7 @@ _VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -ou STATIC_BUILD = 0 TCL_THREADS = 0 DEBUG = 0 +SYMBOLS = 0 PROFILE = 0 MSVCRT = 0 LOIMPACT = 0 @@ -251,6 +252,12 @@ DEBUG = 1 !else DEBUG = 0 !endif +!if [nmakehlp -f $(OPTS) "pdbs"] +!message *** Doing pdbs +SYMBOLS = 1 +!else +SYMBOLS = 0 +!endif !if [nmakehlp -f $(OPTS) "profile"] !message *** Doing profile PROFILE = 1 @@ -523,6 +530,12 @@ Failed to find tcl.h. The TCLDIR macro does not appear correct. !if [echo PKG_SHELL_VER = \>> versions.vc] \ && [nmakehlp -V ..\library\platform\pkgIndex.tcl "platform::shell" >> versions.vc] !endif +!if [echo PKG_DDE_VER = \>> versions.vc] \ + && [nmakehlp -V ..\library\dde\pkgIndex.tcl "dde " >> versions.vc] +!endif +!if [echo PKG_REG_VER =\>> versions.vc] \ + && [nmakehlp -V ..\library\reg\pkgIndex.tcl registry >> versions.vc] +!endif !endif !include versions.vc @@ -549,8 +562,8 @@ TCLSH = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe" TCLSTUBLIB = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib" TCLIMPLIB = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\lib -TCLREGLIB = "$(_TCLDIR)\lib\tclreg11$(SUFX:t=).lib" -TCLDDELIB = "$(_TCLDIR)\lib\tcldde12$(SUFX:t=).lib" +TCLREGLIB = "$(_TCLDIR)\lib\tclreg12$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\lib\tcldde13$(SUFX:t=).lib" COFFBASE = \must\have\tcl\sources\to\build\this\target TCLTOOLSDIR = \must\have\tcl\sources\to\build\this\target TCL_INCLUDES = -I"$(_TCLDIR)\include" @@ -562,8 +575,8 @@ TCLSH = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe" TCLSTUBLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib" TCLIMPLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib" TCL_LIBRARY = $(_TCLDIR)\library -TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg11$(SUFX:t=).lib" -TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde12$(SUFX:t=).lib" +TCLREGLIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg12$(SUFX:t=).lib" +TCLDDELIB = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde13$(SUFX:t=).lib" COFFBASE = "$(_TCLDIR)\win\coffbase.txt" TCLTOOLSDIR = $(_TCLDIR)\tools TCL_INCLUDES = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win" @@ -622,7 +622,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \ -I\"${MSSDK}/Include/crt\" -I\"${MSSDK}/Include/crt/sys\"" RC="\"${MSSDK}/bin/rc.exe\"" - CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}d" + CFLAGS_DEBUG="-nologo -Zi -Od ${runtime}" # Do not use -O2 for Win64 - this has proved buggy in code gen. CFLAGS_OPTIMIZE="-nologo -O1 ${runtime}" lflags="-nologo -MACHINE:${MACHINE} -LIBPATH:\"${MSSDK}/Lib/${MACHINE}\"" @@ -747,6 +747,9 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [ MAKE_EXE="\${CC} -Fe\[$]@" LIBPREFIX="" + CFLAGS_DEBUG="${CFLAGS_DEBUG} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE" + CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE" + EXTRA_CFLAGS="" CFLAGS_WARNING="-W3" LDFLAGS_DEBUG="-debug:full" diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 6c74b6c..ec8745b 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.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: tclWinChan.c,v 1.49 2007/04/16 13:36:36 dkf Exp $ + * RCS: @(#) $Id: tclWinChan.c,v 1.49.2.1 2008/06/25 15:56:27 dgp Exp $ */ #include "tclWinInt.h" @@ -575,7 +575,7 @@ FileWideSeekProc( return -1; } } - return (Tcl_LongAsWide(newPos) | (Tcl_LongAsWide(newPosHigh) << 32)); + return (((Tcl_WideInt)((unsigned)newPos)) | (Tcl_LongAsWide(newPosHigh) << 32)); } /* diff --git a/win/tclWinFile.c b/win/tclWinFile.c index c1b10da..a02de7f 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.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: tclWinFile.c,v 1.93.2.1 2007/07/01 17:31:27 dgp Exp $ + * RCS: @(#) $Id: tclWinFile.c,v 1.93.2.2 2008/06/25 15:56:27 dgp Exp $ */ /* #define _WIN32_WINNT 0x0500 */ @@ -123,6 +123,7 @@ typedef struct _REPARSE_DATA_BUFFER { WORD SubstituteNameLength; WORD PrintNameOffset; WORD PrintNameLength; + ULONG Flags; WCHAR PathBuffer[1]; } SymbolicLinkReparseBuffer; struct { @@ -445,18 +446,18 @@ WinSymLinkDirectory( memset(reparseBuffer, 0, sizeof(DUMMY_REPARSE_BUFFER)); reparseBuffer->ReparseTag = IO_REPARSE_TAG_MOUNT_POINT; - reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength = + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength = wcslen(nativeTarget) * sizeof(WCHAR); reparseBuffer->Reserved = 0; - reparseBuffer->SymbolicLinkReparseBuffer.PrintNameLength = 0; - reparseBuffer->SymbolicLinkReparseBuffer.PrintNameOffset = - reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength + reparseBuffer->MountPointReparseBuffer.PrintNameLength = 0; + reparseBuffer->MountPointReparseBuffer.PrintNameOffset = + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength + sizeof(WCHAR); - memcpy(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, nativeTarget, + memcpy(reparseBuffer->MountPointReparseBuffer.PathBuffer, nativeTarget, sizeof(WCHAR) - + reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength); + + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength); reparseBuffer->ReparseDataLength = - reparseBuffer->SymbolicLinkReparseBuffer.SubstituteNameLength+12; + reparseBuffer->MountPointReparseBuffer.SubstituteNameLength+12; return NativeWriteReparse(linkDirPath, reparseBuffer); } @@ -604,12 +605,12 @@ WinReadLinkDirectory( */ offset = 0; - if (reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[0] == L'\\') { + if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') { /* * Check whether this is a mounted volume. */ - if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, + if (wcsncmp(reparseBuffer->MountPointReparseBuffer.PathBuffer, L"\\??\\Volume{",11) == 0) { char drive; @@ -618,7 +619,7 @@ WinReadLinkDirectory( * to fix here. It doesn't seem very well documented. */ - reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer[1]=L'\\'; + reparseBuffer->MountPointReparseBuffer.PathBuffer[1]=L'\\'; /* * Check if a corresponding drive letter exists, and use that @@ -626,7 +627,7 @@ WinReadLinkDirectory( */ drive = TclWinDriveLetterForVolMountPoint( - reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer); + reparseBuffer->MountPointReparseBuffer.PathBuffer); if (drive != -1) { char driveSpec[3] = { '\0', ':', '\0' @@ -649,14 +650,14 @@ WinReadLinkDirectory( */ goto invalidError; - } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer + } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer .PathBuffer, L"\\\\?\\",4) == 0) { /* * Strip off the prefix. */ offset = 4; - } else if (wcsncmp(reparseBuffer->SymbolicLinkReparseBuffer + } else if (wcsncmp(reparseBuffer->MountPointReparseBuffer .PathBuffer, L"\\??\\",4) == 0) { /* * Strip off the prefix. @@ -667,8 +668,8 @@ WinReadLinkDirectory( } Tcl_WinTCharToUtf((const char *) - reparseBuffer->SymbolicLinkReparseBuffer.PathBuffer, - (int) reparseBuffer->SymbolicLinkReparseBuffer + reparseBuffer->MountPointReparseBuffer.PathBuffer, + (int) reparseBuffer->MountPointReparseBuffer .SubstituteNameLength, &ds); copy = Tcl_DStringValue(&ds)+offset; @@ -775,7 +776,6 @@ NativeWriteReparse( TclWinConvertError(GetLastError()); return -1; } - hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_WRITE, 0, NULL, OPEN_EXISTING, FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL); |