summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorstanton <stanton>1998-11-11 04:08:12 (GMT)
committerstanton <stanton>1998-11-11 04:08:12 (GMT)
commit131c68d85079ca5a553b28fef489cf29b79f1176 (patch)
tree7e89676f31bb688b2686f508446e3282e7148a05
parent0a41c61107c36da0a8e4ca0fc259149e3bc1956d (diff)
downloadtcl-131c68d85079ca5a553b28fef489cf29b79f1176.zip
tcl-131c68d85079ca5a553b28fef489cf29b79f1176.tar.gz
tcl-131c68d85079ca5a553b28fef489cf29b79f1176.tar.bz2
merged 8.0.4 into 8.1
-rw-r--r--changes51
-rw-r--r--doc/library.n13
-rw-r--r--doc/pkgMkIndex.n82
-rw-r--r--generic/tcl.h8
-rw-r--r--generic/tclCmdIL.c13
-rw-r--r--generic/tclIO.c16
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclListObj.c3
-rw-r--r--generic/tclNotify.c8
-rw-r--r--generic/tclResolve.c7
-rw-r--r--generic/tclTest.c20
-rw-r--r--generic/tclTestProcBodyObj.c4
-rw-r--r--library/auto.tcl11
-rw-r--r--library/init.tcl54
-rw-r--r--library/package.tcl488
-rw-r--r--mac/MW_TclAppleScriptHeader.pch3
-rw-r--r--mac/MW_TclHeader.pch15
-rw-r--r--mac/tclMac.h10
-rw-r--r--mac/tclMacAppInit.c9
-rw-r--r--mac/tclMacCommonDefines.h90
-rw-r--r--mac/tclMacResource.c81
-rw-r--r--mac/tclMacTest.c6
-rw-r--r--tests/autoMkindex.test8
-rw-r--r--tests/cmdIL.test26
-rw-r--r--tests/http.test4
-rw-r--r--tests/httpold.test10
-rw-r--r--tests/interp.test10
-rw-r--r--tests/io.test31
-rw-r--r--tests/parse.test132
-rw-r--r--tests/registry.test7
-rw-r--r--tests/resource.test25
-rw-r--r--tests/safe.test7
-rw-r--r--tests/winPipe.test9
-rw-r--r--unix/Makefile.in4
-rw-r--r--unix/configure.in24
-rw-r--r--unix/tclConfig.sh.in5
-rw-r--r--unix/tclUnixTest.c7
-rw-r--r--win/makefile.vc59
-rw-r--r--win/tclWinInit.c14
39 files changed, 727 insertions, 650 deletions
diff --git a/changes b/changes
index 5e8f335..bed23b2 100644
--- a/changes
+++ b/changes
@@ -1,6 +1,6 @@
Recent user-visible changes to Tcl:
-RCS: @(#) $Id: changes,v 1.1.2.9 1998/11/11 01:44:46 stanton Exp $
+RCS: @(#) $Id: changes,v 1.1.2.10 1998/11/11 04:08:12 stanton Exp $
1. No more [command1] [command2] construct for grouping multiple
commands on a single command line.
@@ -3622,7 +3622,54 @@ Windows, MYDLLNAME.DLL was sourced, and mydllname.dll loaded. (EMS)
10/5/98 (new feature) Created a new Tcl_Obj type, "procbody". This object's
internal representation holds a pointer to a Proc structure. Extended
-TclCreateProc to take both strings and "procbody" (EMS)
+TclCreateProc to take both strings and "procbody". (EMS)
+
+10/13/98 (bug fix) The "info complete" command can now handle strings
+with NULLs embedded. Thanks to colin@field.medicine.adelaide.edu.au
+for providing this fix. (RJ)
+
+10/13/98 (bug fix) The "lsort -dictionary" command did not properly
+handle some numbers starting with 0. Thanks to Richard Hipp
+<drh@acm.org> for submitting the fix to Scriptics. (RJ)
+
+10/13/98 (bug fix) The function Tcl_SetListObj was creating an invalid
+Tcl_Obj if the list had zero elements (despite what the comments said
+it would do). Thanks to Sebastian Wangnick for reporting the
+problem. (RJ)
+
+10/20/98 (new feature) Added tcl_platform(debug) element to the
+tcl_platform array on Windows platform. The existence of the debug
+element of the tcl_platform array indicates that the particular Tcl
+shell has been compiled with debug information. Using
+"info exists tcl_platform(debug)" a Tcl script can direct the interpreter
+to load debug versions of DLLs with the load command. (SKS)
+
+10/20/98 (feature change) The Makefile and configure scripts have been
+changed for IRIX to build n32 binaries instead of the old 32 abi
+format. If you have extensions built with the o32 abi's you will need
+to update them to n32 for them to work with Tcl. (RJ)
+*** POTENTIAL INCOMPATIBILITY ***
+
+10/23/98 (bug fix) tcl_findLibrary had a stray ] in one of the pathnames
+it searched for the initialization script. tclInitScript.h was incorrectly
+adding the parent of tcl_library to tcl_pkgPath. This logic was moved
+into init.tcl, and the initialization of auto_path was documented.
+Thanks to Donald Porter and Tom Silva for related patches. (BW)
+
+10/29/98 (bug fix) Fixed Tcl_NotifyChannel to use Tcl_Preserve instead
+of Tcl_RegisterChannel so that 1) unregistered channels do not get
+closed after their first fileevent, and 2) errors that occur during
+close in a fileevent script are actually reflected by the close command. (BW)
+
+10/30/98 (bug fix) Overhaul of pkg_mkIndex to deal with transitive
+package requires and packages split among scripts and binary files.
+Also fixed ommision of global for errorInfo in tcl_findLibrary. (BW)
+
+11/08/98 (bug fix) Fixed TclMacRegisterResourceFork to always detect
+the case where a file is opened a second time with the same
+permissions. In IM, it claims that this will always cause the same
+FileRef to be returned, but in MacOS 8.1+, this is no longer the case,
+so we have to test for this explicitly.
======== Changes for 8.0 go above this line ========
======== Changes for 8.1 go below this line ========
diff --git a/doc/library.n b/doc/library.n
index ef1c40d..3adda68 100644
--- a/doc/library.n
+++ b/doc/library.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: library.n,v 1.1.2.1 1998/09/24 23:58:33 stanton Exp $
+'\" RCS: @(#) $Id: library.n,v 1.1.2.2 1998/11/11 04:08:14 stanton Exp $
.so man.macros
.TH library n "8.0" Tcl "Tcl Built-In Commands"
.BS
@@ -238,17 +238,24 @@ any commands.
\fBauto_path\fR
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations.
+This variable is initialized during startup to contain, in order:
+the directories listed in the TCLLIBPATH environment variable,
+the directory named by the $tcl_library variable,
+the parent directory of $tcl_library,
+the directories listed in the $tcl_pkgPath variable.
.TP
\fBenv(TCL_LIBRARY)\fR
If set, then it specifies the location of the directory containing
-library scripts (the value of this variable will be returned by
+library scripts (the value of this variable will be
+assigned to the \fBtcl_library\fR variable and therefore returned by
the command \fBinfo library\fR). If this variable isn't set then
a default value is used.
.TP
\fBenv(TCLLIBPATH)\fR
If set, then it must contain a valid Tcl list giving directories to
search during auto-load operations.
-This variable is only used if \fBauto_path\fR is not defined.
+This variable is only used when
+initializing the \fBauto_path\fR variable.
.TP
\fBtcl_nonwordchars\fR
.VS
diff --git a/doc/pkgMkIndex.n b/doc/pkgMkIndex.n
index 7a454fb..2c7fa0f 100644
--- a/doc/pkgMkIndex.n
+++ b/doc/pkgMkIndex.n
@@ -4,18 +4,18 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: pkgMkIndex.n,v 1.1.2.2 1998/09/24 23:58:34 stanton Exp $
+'\" RCS: @(#) $Id: pkgMkIndex.n,v 1.1.2.3 1998/11/11 04:08:14 stanton Exp $
'\"
.so man.macros
-.TH pkg_mkIndex n 7.6 Tcl "Tcl Built-In Commands"
+.TH pkg_mkIndex n 8.0 Tcl "Tcl Built-In Commands"
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
pkg_mkIndex \- Build an index for automatic loading of packages
.SH SYNOPSIS
.nf
-.VS 8.1
-\fBpkg_mkIndex ?\fI-direct\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
+.VS 8.0.3
+\fBpkg_mkIndex ?\fI-direct\fR? ?\fI-verbose\fR? \fIdir\fR ?\fIpattern pattern ...\fR?
.VE
.fi
.BE
@@ -41,12 +41,14 @@ Create the index by invoking \fBpkg_mkIndex\fR.
The \fIdir\fR argument gives the name of a directory and each
\fIpattern\fR argument is a \fBglob\fR-style pattern that selects
script or binary files in \fIdir\fR.
-.VS 8.1
+.VS 8.0.3
The default pattern is \fB*.tcl\fR and \fB*.[info sharedlibextension]\fR.
If the optional \fI-direct\fR argument is given, the generated index
will manage to load the package immediately upon \fBpackage require\fR
instead of delaying loading until actual use of one of the commands.
.VE
+.RS
+.LP
\fBPkg_mkIndex\fR will create a file \fBpkgIndex.tcl\fR in \fIdir\fR
with package information about all the files given by the \fIpattern\fR
arguments.
@@ -54,6 +56,11 @@ It does this by loading each file and seeing what packages
and new commands appear (this is why it is essential to have
\fBpackage provide\fR commands or \fBTcl_PkgProvide\fR calls
in the files, as described above).
+If you have a package split among scripts and binary files,
+or if you have dependencies among files,
+you may have to adjust the order in which \fBpkg_mkIndex\fR processes
+the files. See COMPLEX CASES below.
+.RE
.IP [3]
Install the package as a subdirectory of one of the directories given by
the \fBtcl_pkgPath\fR variable. If \fB$tcl_pkgPath\fR contains more
@@ -70,7 +77,7 @@ directory in \fB$tcl_pkgPath\fR it will automatically be found during
.RS
.LP
If you install the package anywhere else, then you must ensure that
-the directory contain the package is in the \fBauto_path\fR global variable
+the directory containing the package is in the \fBauto_path\fR global variable
or an immediate subdirectory of one of the directories in \fBauto_path\fR.
\fBAuto_path\fR contains a list of directories that are searched
by both the auto-loader and the package loader; by default it
@@ -130,22 +137,22 @@ commands for each version of each available package; these commands
invoke \fBpackage provide\fR commands to announce the
availability of the package, and they setup auto-loader
information to load the files of the package.
-.VS
+.VS 8.0.3
Unless the \fI-direct\fR flag was provided when the \fBpkgIndex.tcl\fR
was generated,
.VE
a given file of a given version of a given package isn't
actually loaded until the first time one of its commands
is invoked.
-Thus, after invoking \fBpackage require\fR you
-.VS 8.1
+Thus, after invoking \fBpackage require\fR you
+.VS 8.0.3
may
.VE
not see
the package's commands in the interpreter, but you will be able
to invoke the commands and they will be auto-loaded.
-.VS 8.1
+.VS 8.0.3
.SH "DIRECT LOADING"
.PP
Some packages, for instance packages which use namespaces and export
@@ -156,5 +163,60 @@ package's command. This mode is enabled when generating the package
index by specifying the \fI-direct\fR argument.
.VE
+.SH "COMPLEX CASES"
+Most complex cases of dependencies among scripts
+and binary files, and packages being split among scripts and
+binary files are handled OK. However, you may have to adjust
+the order in which files are processed by \fBpkg_mkIndex\fR.
+The only case that is not supported is a package that is
+provided by more than one binary file.
+These issues are described in detail below.
+.PP
+If each script or file contains one package, and packages
+are only contained in one file, then things are easy.
+You simply specify all files to be indexed in any order
+with some glob patterns.
+.PP
+In general, it is OK for scripts to have dependencies on other
+packages.
+If scripts contain \fBpackage require\fP commands, these are
+stubbed out in the interpreter used to process the scripts,
+so these do not cause problems.
+If scripts call into other packages in global code,
+these calls are handled by a stub \fBunknown\fP command.
+However, if scripts make variable references to other package's
+variables in global code, these will cause errors. That is
+also bad coding style.
+.PP
+If binary files have dependencies on other packages, things
+can become tricky because it is not possible to stub out
+the C-level \fBTcl_PkgRequire\fP API.
+For example, suppose the BLT package requires Tk, and expresses
+this with a call to \fBTcl_PkgRequire\fP in its \fBBlt_Init\fP routine.
+To support this, you must run \fBpkg_mkIndex\fR in a shell that
+has Tk loaded. \fBpkg_mkIndex\fR will load any packages listed by
+\fBinfo loaded\fP into the interpreter used to process files.
+In most cases this will satisfy the \fBTcl_PkgRequire\fP calls
+made by binary files.
+.PP
+If you are indexing two binary files and one depends on the other,
+you should specify the one that has dependencies last.
+This way the one without dependencies will get loaded and indexed,
+and then the package it provides
+will be available when the second file is processed.
+.PP
+You cannot have the same package provided by two different binary
+files. Well, you can, but they cannot be indexed by \fBpkg_mkIndex\fR
+and it seems like a poor design choice anyway. The problem is that
+once the package is provided by the first binary file, then that
+masks the provide made by the other binary file. If you
+absolutely must do this, you'll have to run \fBpkg_mkIndex\fR on
+each different file, save the resulting pkgIndex.tcl files,
+and merge the results.
+.PP
+If you have a package that is split across scripts and a binary file,
+then you must specify the scripts first; otherwise the package loaded from
+the binary file may mask the package defined by the scripts.
+
.SH KEYWORDS
auto-load, index, package, version
diff --git a/generic/tcl.h b/generic/tcl.h
index 319e3ba..783246e 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -7,11 +7,12 @@
* Copyright (c) 1987-1994 The Regents of the University of California.
* Copyright (c) 1993-1996 Lucent Technologies.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
*
* 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.1.2.4 1998/11/04 04:39:52 stanton Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.1.2.5 1998/11/11 04:08:15 stanton Exp $
*/
#ifndef _TCL
@@ -25,12 +26,13 @@
* library/init.tcl (only if major.minor changes, not patchlevel)
* unix/configure.in
* unix/pkginfo
- * win/makefile.bc
- * win/makefile.vc
+ * win/makefile.bc (only if major.minor changes, not patchlevel)
+ * win/makefile.vc (only if major.minor changes, not patchlevel)
* win/pkgIndex.tcl (for tclregNN.dll)
* README
* mac/README
* win/README
+ * win/README.binary
* unix/README
*
* The release level should be 0 for alpha, 1 for beta, and 2 for
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 6b4cc39..f26580d 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -9,11 +9,12 @@
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1993-1997 Lucent Technologies.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
*
* 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.1.2.3 1998/10/21 20:40:04 stanton Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.1.2.4 1998/11/11 04:08:15 stanton Exp $
*/
#include "tclInt.h"
@@ -782,19 +783,17 @@ InfoCompleteCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- char *command;
-
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "command");
return TCL_ERROR;
}
- command = Tcl_GetString(objv[2]);
- if (Tcl_CommandComplete(command)) {
+ if (TclObjCommandComplete(objv[2])) {
Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
} else {
Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
}
+
return TCL_OK;
}
@@ -2890,11 +2889,11 @@ DictionaryCompare(left, right)
*/
zeros = 0;
- while ((*right == '0') && (*(right + 1) != '\0')) {
+ while ((*right == '0') && (isdigit(UCHAR(right[1])))) {
right++;
zeros--;
}
- while ((*left == '0') && (*(left + 1) != '\0')) {
+ while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
left++;
zeros++;
}
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 0faffff..42fcf44 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.1.2.2 1998/09/24 23:58:51 stanton Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.1.2.3 1998/11/11 04:08:16 stanton Exp $
*/
#include "tclInt.h"
@@ -5546,13 +5546,10 @@ Tcl_NotifyChannel(channel, mask)
NextChannelHandler nh;
/*
- * Prevent the event handler from deleting the channel by incrementing
- * the channel's ref count. Case in point: ChannelEventScriptInvoker()
- * was evaling a script (owned by the channel) which caused the channel
- * to be closed and then the byte codes no longer existed.
+ * Preserve the channel struct in case the script closes it.
*/
- Tcl_RegisterChannel(NULL, channel);
+ Tcl_Preserve((ClientData) channel);
/*
* If we are flushing in the background, be sure to call FlushChannel
@@ -5600,12 +5597,7 @@ Tcl_NotifyChannel(channel, mask)
UpdateInterest(chanPtr);
}
- /*
- * No longer need to protect the channel from being deleted.
- * After this point it is unsafe to use the value of "channel".
- */
-
- Tcl_UnregisterChannel((Tcl_Interp *) NULL, channel);
+ Tcl_Release((ClientData) channel);
tsdPtr->nestedHandlerPtr = nh.nestedHandlerPtr;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 0babdfd..55eaaad 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -6,11 +6,12 @@
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1993-1997 Lucent Technologies.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
*
* 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.1.2.7 1998/10/21 20:40:06 stanton Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.1.2.8 1998/11/11 04:08:21 stanton Exp $
*/
#ifndef _TCLINT
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 931c821..27b8145 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -5,11 +5,12 @@
* type.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclListObj.c,v 1.1.2.2 1998/09/24 23:58:55 stanton Exp $
+ * RCS: @(#) $Id: tclListObj.c,v 1.1.2.3 1998/11/11 04:08:22 stanton Exp $
*/
#include "tclInt.h"
diff --git a/generic/tclNotify.c b/generic/tclNotify.c
index 4d85b66..b58a347 100644
--- a/generic/tclNotify.c
+++ b/generic/tclNotify.c
@@ -8,11 +8,12 @@
* tcl*Notify.c files in each platform directory.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNotify.c,v 1.1.2.2 1998/09/24 23:58:59 stanton Exp $
+ * RCS: @(#) $Id: tclNotify.c,v 1.1.2.3 1998/11/11 04:08:22 stanton Exp $
*/
#include "tclInt.h"
@@ -458,8 +459,11 @@ Tcl_DeleteEvents(proc, clientData)
if (tsdPtr->firstEventPtr == evPtr) {
tsdPtr->firstEventPtr = evPtr->nextPtr;
if (evPtr->nextPtr == (Tcl_Event *) NULL) {
- tsdPtr->lastEventPtr = (Tcl_Event *) NULL;
+ tsdPtr->lastEventPtr = prevPtr;
}
+ if (tsdPtr->markerEventPtr == evPtr) {
+ tsdPtr->markerEventPtr = prevPtr;
+ }
} else {
prevPtr->nextPtr = evPtr->nextPtr;
}
diff --git a/generic/tclResolve.c b/generic/tclResolve.c
index 230e93f..446149b 100644
--- a/generic/tclResolve.c
+++ b/generic/tclResolve.c
@@ -9,15 +9,10 @@
*
* Copyright (c) 1998 Lucent Technologies, Inc.
*
- * Originally implemented by
- * Michael J. McLennan
- * Bell Labs Innovations for Lucent Technologies
- * mmclennan@lucent.com
- *
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclResolve.c,v 1.1.2.1 1998/09/24 23:59:02 stanton Exp $
+ * RCS: @(#) $Id: tclResolve.c,v 1.1.2.2 1998/11/11 04:08:22 stanton Exp $
*/
#include "tclInt.h"
diff --git a/generic/tclTest.c b/generic/tclTest.c
index b408fee..eee8c37 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.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: tclTest.c,v 1.1.2.4 1998/11/11 01:44:54 stanton Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.1.2.5 1998/11/11 04:08:22 stanton Exp $
*/
#define TCL_TEST
@@ -3963,14 +3963,18 @@ TeststatprocCmd (dummy, interp, argc, argv)
return retVal;
}
-
+/* Be careful in the compares in these tests, since the Macintosh puts a
+ * leading : in the beginning of non-absolute paths before passing them
+ * into the file command procedures.
+ */
+
static int
TestStatProc1(path, buf)
CONST char *path;
TclStat_ *buf;
{
buf->st_size = 1234;
- return (strcmp("testStat1%.fil", path) ? -1 : 0);
+ return ((strstr(path, "testStat1%.fil") == NULL) ? -1 : 0);
}
@@ -3980,7 +3984,7 @@ TestStatProc2(path, buf)
TclStat_ *buf;
{
buf->st_size = 2345;
- return (strcmp("testStat2%.fil", path) ? -1 : 0);
+ return ((strstr(path, "testStat2%.fil") == NULL) ? -1 : 0);
}
@@ -3990,7 +3994,7 @@ TestStatProc3(path, buf)
TclStat_ *buf;
{
buf->st_size = 3456;
- return (strcmp("testStat3%.fil", path) ? -1 : 0);
+ return ((strstr(path, "testStat3%.fil") == NULL) ? -1 : 0);
}
/*
@@ -4073,7 +4077,7 @@ TestAccessProc1(path, mode)
CONST char *path;
int mode;
{
- return (strcmp("testAccess1%.fil", path) ? -1 : 0);
+ return ((strstr(path, "testAccess1%.fil") == NULL) ? -1 : 0);
}
@@ -4082,7 +4086,7 @@ TestAccessProc2(path, mode)
CONST char *path;
int mode;
{
- return (strcmp("testAccess2%.fil", path) ? -1 : 0);
+ return ((strstr(path, "testAccess2%.fil") == NULL) ? -1 : 0);
}
@@ -4091,7 +4095,7 @@ TestAccessProc3(path, mode)
CONST char *path;
int mode;
{
- return (strcmp("testAccess3%.fil", path) ? -1 : 0);
+ return ((strstr(path, "testAccess3%.fil") == NULL) ? -1 : 0);
}
/*
diff --git a/generic/tclTestProcBodyObj.c b/generic/tclTestProcBodyObj.c
index bfd2dcc..38eb189 100644
--- a/generic/tclTestProcBodyObj.c
+++ b/generic/tclTestProcBodyObj.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: tclTestProcBodyObj.c,v 1.1.2.1 1998/10/06 02:59:05 stanton Exp $
+ * RCS: @(#) $Id: tclTestProcBodyObj.c,v 1.1.2.2 1998/11/11 04:08:24 stanton Exp $
*/
#include "tclInt.h"
@@ -50,6 +50,8 @@ static int ProcBodyTestInitInternal _ANSI_ARGS_((Tcl_Interp *interp,
int isSafe));
static int RegisterCommand _ANSI_ARGS_((Tcl_Interp* interp,
char *namespace, CONST CmdTable *cmdTablePtr));
+int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp * interp));
+int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp * interp));
/*
* List of commands to create when the package is loaded; must go after the
diff --git a/library/auto.tcl b/library/auto.tcl
index 6e731fc..6f5e4e6 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -3,7 +3,7 @@
# utility procs formerly in init.tcl dealing with auto execution
# of commands and can be auto loaded themselves.
#
-# RCS: @(#) $Id: auto.tcl,v 1.1.2.3 1998/10/05 18:46:03 stanton Exp $
+# RCS: @(#) $Id: auto.tcl,v 1.1.2.4 1998/11/11 04:08:24 stanton Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -25,7 +25,8 @@ proc auto_reset {} {
global auto_execs auto_index auto_oldpath
foreach p [info procs] {
if {[info exists auto_index($p)] && ![string match auto_* $p]
- && ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup tcl_findLibrary
+ && ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup
+ tcl_findLibrary pkg_compareExtension
tclMacPkgSearch tclPkgUnknown} $p] < 0)} {
rename $p {}
}
@@ -50,7 +51,7 @@ proc auto_reset {} {
proc tcl_findLibrary {basename version patch initScript enVarName varName} {
upvar #0 $varName the_library
- global env
+ global env errorInfo
set dirs {}
set errors {}
@@ -87,12 +88,12 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
lappend dirs [file join $grandParentDir lib $basename$version]
lappend dirs [file join $parentDir library]
lappend dirs [file join $grandParentDir library]
- if [string match {*[ab]*} $patch] {
+ if {[string match {*[ab]*} $patch]} {
set ver $patch
} else {
set ver $version
}
- lappend dirs [file join $grandParentDir] $basename$ver library]
+ lappend dirs [file join $grandParentDir $basename$ver library]
lappend dirs [file join [file dirname $grandParentDir] $basename$ver library]
}
foreach i $dirs {
diff --git a/library/init.tcl b/library/init.tcl
index fd1d8ad..8e9d3f3 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.1.2.2 1998/09/24 23:59:06 stanton Exp $
+# RCS: @(#) $Id: init.tcl,v 1.1.2.3 1998/11/11 04:08:24 stanton Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -18,41 +18,43 @@ if {[info commands package] == ""} {
package require -exact Tcl 8.1
# Compute the auto path to use in this interpreter.
-# (auto_path could be already set, in safe interps for instance
-# and some variables are usually exist might not be there, proceed
-# with caution)
+# The values on the path come from several locations:
+#
+# The environment variable TCLLIBPATH
+#
+# tcl_library, which is the directory containing this init.tcl script.
+# tclInitScript.h searches around for the directory containing this
+# init.tcl and defines tcl_library to that location before sourcing it.
+#
+# The parent directory of tcl_library. Adding the parent
+# means that packages in peer directories will be found automatically.
+#
+# tcl_pkgPath, which is set by the platform-specific initialization routines
+# On UNIX it is compiled in
+# On Windows it comes from the registry
+# On Macintosh it is "Tool Command Language" in the Extensions folder
if {![info exists auto_path]} {
- if {[catch {set auto_path $env(TCLLIBPATH)}]} {
+ if {[info exist env(TCLLIBPATH)]} {
+ set auto_path $env(TCLLIBPATH)
+ } else {
set auto_path ""
}
-
- if {[lsearch -exact $auto_path $tcl_library] < 0} {
- lappend auto_path $tcl_library
- }
-
- set __dir [file dirname $tcl_library]
-
+}
+foreach __dir [list [info library] [file dirname [info library]]] {
if {[lsearch -exact $auto_path $__dir] < 0} {
lappend auto_path $__dir
}
-
- # Add directories from the tcl_pkgPath
- # (we might want to check the potential candidates in tcl_libPath too,
- # and check that those dirs refer to compatible tcl versions
- # (ie if they end with tcl7.6 we should prbably not add them))
-
- if {[info exist tcl_pkgPath]} {
- foreach __dir $tcl_pkgPath {
- if {[lsearch -exact $auto_path $__dir] < 0} {
- lappend auto_path $__dir
- }
+}
+if {[info exist tcl_pkgPath]} {
+ foreach __dir $tcl_pkgPath {
+ if {[lsearch -exact $auto_path $__dir] < 0} {
+ lappend auto_path $__dir
}
}
-
- unset __dir
}
-
+unset __dir
+
# Windows specific end of initialization
if {(![interp issafe]) && ($tcl_platform(platform) == "windows")} {
diff --git a/library/package.tcl b/library/package.tcl
index 70e9064..e44c0b2 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -3,7 +3,7 @@
# utility procs formerly in init.tcl which can be loaded on demand
# for package management.
#
-# RCS: @(#) $Id: package.tcl,v 1.1.2.3 1998/10/05 18:46:03 stanton Exp $
+# RCS: @(#) $Id: package.tcl,v 1.1.2.4 1998/11/11 04:08:25 stanton Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -12,6 +12,39 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
+# pkg_compareExtension --
+#
+# Used internally by pkg_mkIndex to compare the extension of a file to
+# a given extension. On Windows, it uses a case-insensitive comparison
+# because the file system can be file insensitive.
+#
+# Arguments:
+# fileName name of a file whose extension is compared
+# ext (optional) The extension to compare against; you must
+# provide the starting dot.
+# Defaults to [info sharedlibextension]
+#
+# Results:
+# Returns 1 if the extension matches, 0 otherwise
+
+if {$::tcl_platform(platform) == "windows"} {
+ proc pkg_compareExtension { fileName {ext {}} } {
+ if {[string compare $ext {}] == 0} {
+ set ext [info sharedlibextension]
+ }
+ return [expr {[string compare \
+ [string tolower [file extension $fileName]] \
+ [string tolower $ext]] == 0}]
+ }
+} else {
+ proc pkg_compareExtension { fileName {ext {}} } {
+ if {[string compare $ext {}] == 0} {
+ set ext [info sharedlibextension]
+ }
+ return [expr {[string compare [file extension $fileName] $ext] == 0}]
+ }
+}
+
# pkg_mkIndex --
# This procedure creates a package index in a given directory. The
# package index consists of a "pkgIndex.tcl" file whose contents are
@@ -25,19 +58,9 @@
# loaded when "package require" is executed, rather
# than lazily when the first reference to an exported
# procedure in the package is made.
-# -nopkgrequire (optional) If this flag is present, "package require"
-# commands are ignored. This flag is useful in some
-# situations, for example when there is a circularity
-# in package requires (package a requires package b,
-# which in turns requires package a).
# -verbose (optional) Verbose output; the name of each file that
# was successfully rocessed is printed out. Additionally,
-# if processing of a file failed a message is printed
-# out; a file failure may not indicate that the indexing
-# has failed, since pkg_mkIndex stores the list of failed
-# files and tries again. The second time the processing
-# may succeed, for example if a required package has been
-# indexed by a previous pass.
+# if processing of a file failed a message is printed.
# dir - Name of the directory in which to create the index.
# args - Any number of additional arguments, each giving
# a glob pattern that matches the names of one or
@@ -46,7 +69,7 @@
proc pkg_mkIndex {args} {
global errorCode errorInfo
- set usage {"pkg_mkIndex ?-nopkgrequire? ?-direct? ?-verbose? dir ?pattern ...?"};
+ set usage {"pkg_mkIndex ?-direct? ?-verbose? dir ?pattern ...?"};
set argCount [llength $args]
if {$argCount < 1} {
@@ -55,7 +78,6 @@ proc pkg_mkIndex {args} {
set more ""
set direct 0
- set noPkgRequire 0
set doVerbose 0
for {set idx 0} {$idx < $argCount} {incr idx} {
set flag [lindex $args $idx]
@@ -65,25 +87,16 @@ proc pkg_mkIndex {args} {
incr idx
break
}
-
-verbose {
set doVerbose 1
}
-
-direct {
set direct 1
append more " -direct"
}
-
- -nopkgrequire {
- set noPkgRequire 1
- append more " -nopkgrequire"
- }
-
-* {
return -code error "unknown flag $flag: should be\n$usage"
}
-
default {
# done with the flags
break
@@ -92,7 +105,7 @@ proc pkg_mkIndex {args} {
}
set dir [lindex $args $idx]
- set patternList [lrange $args [expr $idx + 1] end]
+ set patternList [lrange $args [expr {$idx + 1}] end]
if {[llength $patternList] == 0} {
set patternList [list "*.tcl" "*[info sharedlibextension]"]
}
@@ -109,309 +122,198 @@ proc pkg_mkIndex {args} {
set oldDir [pwd]
cd $dir
- # In order to support building of index files from scratch, we make
- # repeated passes on the files to index, until either all have been
- # indexed, or we can no longer make any headway.
-
- foreach file [eval glob $patternList] {
- set toProcess($file) 1
+ if {[catch {eval glob $patternList} fileList]} {
+ global errorCode errorInfo
+ cd $oldDir
+ return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList
}
+ foreach file $fileList {
+ # For each file, figure out what commands and packages it provides.
+ # To do this, create a child interpreter, load the file into the
+ # interpreter, and get a list of the new commands and packages
+ # that are defined.
+
+ if {[string compare $file "pkgIndex.tcl"] == 0} {
+ continue
+ }
- while {[array size toProcess] > 0} {
- set processed 0
-
- foreach file [array names toProcess] {
- # For each file, figure out what commands and packages it provides.
- # To do this, create a child interpreter, load the file into the
- # interpreter, and get a list of the new commands and packages
- # that are defined. The interpeter uses a special version of
- # tclPkgSetup to force loading of required packages at require
- # time rather than lazily, so that we can keep track of commands
- # and packages that are defined indirectly rather than from the
- # file itself.
+ # Changed back to the original directory before initializing the
+ # slave in case TCL_LIBRARY is a relative path (e.g. in the test
+ # suite).
- set c [interp create]
+ cd $oldDir
+ set c [interp create]
- # Load into the child all packages currently loaded in the parent
- # interpreter, in case the extension depends on some of them.
+ # Load into the child all packages currently loaded in the parent
+ # interpreter, in case the extension depends on some of them.
- foreach pkg [info loaded] {
- if {[lindex $pkg 1] == "Tk"} {
- $c eval {set argv {-geometry +0+0}}
- }
- load [lindex $pkg 0] [lindex $pkg 1] $c
+ foreach pkg [info loaded] {
+ if {[lindex $pkg 1] == "Tk"} {
+ $c eval {set argv {-geometry +0+0}}
}
+ load [lindex $pkg 0] [lindex $pkg 1] $c
+ }
+ cd $dir
- # We also call package ifneeded for all packages that have been
- # identified so far. This way, each pass will have loaded the
- # equivalent of the pkgIndex.tcl file that we are constructing,
- # and packages whose processing failed in previous passes may
- # be processed successfully now
-
- foreach pkg [array names files] {
- $c eval "package ifneeded $pkg\
- \[list tclPkgSetup $dir \
- [lrange $pkg 0 0] [lrange $pkg 1 1]\
- [list $files($pkg)]\]"
- }
- if {$noPkgRequire == 1} {
- $c eval {
- rename package __package_orig
- proc package {what args} {
- switch -- $what {
- require { return ; # ignore transitive requires }
- default { eval __package_orig {$what} $args }
- }
- }
- proc __dummy args {}
- package unknown __dummy
- }
- } else {
- $c eval {
- rename package __package_orig
- proc package {what args} {
- switch -- $what {
- require {
- eval __package_orig require $args
-
- # a package that was required needs to be
- # placed in the list of packages to ignore.
- # tclPkgSetup is unable to do it, so do it
- # here.
-
- set ::__ignorePkgs([lindex $args 0]) 1
- }
-
- provide {
- # if package provide is called at level 1 and
- # with two arguments, then this package is
- # being provided by one of the files we are
- # indexing, and therefore we need to add it
- # to the list of packages to write out.
- # We need to do this check because otherwise
- # packages that are spread over multiple
- # files are indexed only by their first file
- # loaded.
- # Note that packages that this cannot catch
- # packages that are implemented by a
- # combination of TCL files and DLLs
-
- if {([info level] == 1) \
- && ([llength $args] == 2)} {
- lappend ::__providedPkgs [lindex $args 0]
- }
-
- eval __package_orig provide $args
- }
-
- default { eval __package_orig {$what} $args }
- }
- }
+ $c eval {
+ # Stub out the package command so packages can
+ # require other packages.
+
+ rename package __package_orig
+ proc package {what args} {
+ switch -- $what {
+ require { return ; # ignore transitive requires }
+ default { eval __package_orig {$what} $args }
}
}
+ proc tclPkgUnknown args {}
+ package unknown tclPkgUnknown
- $c eval [list set __file $file]
- $c eval [list set __direct $direct]
- if {[catch {
- $c eval {
- set __doingWhat "loading or sourcing"
-
- # override the tclPkgSetup procedure (which is called by
- # package ifneeded statements from pkgIndex.tcl) to force
- # loads of packages, and also keep track of
- # packages/namespaces/commands that the load generated
-
- proc tclPkgSetup {dir pkg version files} {
- # remember the current set of packages and commands,
- # so that we can add any that were defined by the
- # package files to the list of packages and commands
- # to ignore
-
- foreach __p [package names] {
- set __localIgnorePkgs($__p) 1
- }
- foreach __ns [__pkgGetAllNamespaces] {
- set __localIgnoreNs($__ns) 1
-
- # if the namespace is already in the __ignoreNs
- # array, its commands have already been imported
-
- if {[info exists ::__ignoreNs($__ns)] == 0} {
- namespace import ${__ns}::*
- }
- }
- foreach __cmd [info commands] {
- set __localIgnoreCmds($__cmd) 1
- }
-
- # load the files that make up the package
-
- package provide $pkg $version
- foreach __fileInfo $files {
- set __f [lindex $__fileInfo 0]
- set __type [lindex $__fileInfo 1]
- if {$__type == "load"} {
- load [file join $dir $__f] $pkg
- } else {
- source [file join $dir $__f]
- }
- }
-
- # packages and commands that were defined by these
- # files are to be ignored.
-
- foreach __p [package names] {
- if {[info exists __localIgnorePkgs($__p)] == 0} {
- set ::__ignorePkgs($__p) 1
- }
- }
- foreach __ns [__pkgGetAllNamespaces] {
- if {([info exists __localIgnoreNs($__ns)] == 0) \
- && ([info exists ::__ignoreNs($__ns)] == 0)} {
- namespace import ${__ns}::*
- set ::__ignoreNs($__ns) 1
- }
- }
- foreach __cmd [info commands] {
- if {[info exists __localIgnoreCmds($__cmd)] == 0} {
- lappend ::__ignoreCmds $__cmd
- }
- }
- }
+ # Stub out the unknown command so package can call
+ # into each other during their initialilzation.
- # we need to track command defined by each package even in
- # the -direct case, because they are needed internally by
- # the "partial pkgIndex.tcl" step above.
+ proc unknown {args} {}
- proc __pkgGetAllNamespaces {{root {}}} {
- set __list $root
- foreach __ns [namespace children $root] {
- eval lappend __list [__pkgGetAllNamespaces $__ns]
- }
- return $__list
- }
+ # Stub out the auto_import mechanism
- # initialize the list of packages to ignore; these are
- # packages that are present before the script/dll is loaded
+ proc auto_import {args} {}
- set ::__ignorePkgs(Tcl) 1
- set ::__ignorePkgs(Tk) 1
- foreach __pkg [package names] {
- set ::__ignorePkgs($__pkg) 1
- }
-
- # before marking the original commands, import all the
- # namespaces that may have been loaded from the parent;
- # these namespaces and their commands are to be ignored
+ # reserve the ::tcl namespace for support procs
+ # and temporary variables. This might make it awkward
+ # to generate a pkgIndex.tcl file for the ::tcl namespace.
- foreach __ns [__pkgGetAllNamespaces] {
- set ::__ignoreNs($__ns) 1
- namespace import ${__ns}::*
- }
+ namespace eval ::tcl {
+ variable file ;# Current file being processed
+ variable direct ;# -direct flag value
+ variable x ;# Loop variable
+ variable debug ;# For debugging
+ variable type ;# "load" or "source", for -direct
+ variable namespaces ;# Existing namespaces (e.g., ::tcl)
+ variable packages ;# Existing packages (e.g., Tcl)
+ variable origCmds ;# Existing commands
+ variable newCmds ;# Newly created commands
+ variable newPkgs {} ;# Newly created packages
+ }
+ }
- set ::__ignoreCmds [info commands]
-
- set dir "" ;# in case file is pkgIndex.tcl
-
- # Try to load the file if it has the shared library
- # extension, otherwise source it. It's important not to
- # try to load files that aren't shared libraries, because
- # on some systems (like SunOS) the loader will abort the
- # whole application when it gets an error.
-
- set __pkgs {}
- set __providedPkgs {}
- if {[string compare [file extension $__file] \
- [info sharedlibextension]] == 0} {
-
- # The "file join ." command below is necessary.
- # Without it, if the file name has no \'s and we're
- # on UNIX, the load command will invoke the
- # LD_LIBRARY_PATH search mechanism, which could cause
- # the wrong file to be used.
-
- set __doingWhat loading
- load [file join . $__file]
- set __type load
- } else {
- set __doingWhat sourcing
- source $__file
- set __type source
- }
+ $c eval [list set ::tcl::file $file]
+ $c eval [list set ::tcl::direct $direct]
+ if {[catch {
+ $c eval {
+ set ::tcl::debug "loading or sourcing"
- # Using __ variable names to avoid potential namespaces
- # clash, even here in post processing because the
- # loaded package could have set up traces,...
+ # we need to track command defined by each package even in
+ # the -direct case, because they are needed internally by
+ # the "partial pkgIndex.tcl" step above.
- foreach __ns [__pkgGetAllNamespaces] {
- if {[info exists ::__ignoreNs($__ns)] == 0} {
- namespace import ${__ns}::*
- }
- }
- foreach __i [info commands] {
- set __cmds($__i) 1
- }
- foreach __i $::__ignoreCmds {
- catch {unset __cmds($__i)}
+ proc ::tcl::GetAllNamespaces {{root ::}} {
+ set list $root
+ foreach ns [namespace children $root] {
+ eval lappend list [::tcl::GetAllNamespaces $ns]
}
- foreach __i [array names __cmds] {
- # reverse engineer which namespace a command comes from
-
- set __absolute [namespace origin $__i]
+ return $list
+ }
- # special case so that global names have no leading
- # ::, this is required by the unknown command
+ # initialize the list of existing namespaces, packages, commands
- set __absolute [auto_qualify $__absolute ::]
+ foreach ::tcl::x [::tcl::GetAllNamespaces] {
+ set ::tcl::namespaces($::tcl::x) 1
+ }
+ foreach ::tcl::x [package names] {
+ set ::tcl::packages($::tcl::x) 1
+ }
+ set ::tcl::origCmds [info commands]
+
+ # Try to load the file if it has the shared library
+ # extension, otherwise source it. It's important not to
+ # try to load files that aren't shared libraries, because
+ # on some systems (like SunOS) the loader will abort the
+ # whole application when it gets an error.
+
+ if {[pkg_compareExtension $::tcl::file [info sharedlibextension]]} {
+ # The "file join ." command below is necessary.
+ # Without it, if the file name has no \'s and we're
+ # on UNIX, the load command will invoke the
+ # LD_LIBRARY_PATH search mechanism, which could cause
+ # the wrong file to be used.
+
+ set ::tcl::debug loading
+ load [file join . $::tcl::file]
+ set ::tcl::type load
+ } else {
+ set ::tcl::debug sourcing
+ source $::tcl::file
+ set ::tcl::type source
+ }
- if {[string compare $__i $__absolute] != 0} {
- set __cmds($__absolute) 1
- unset __cmds($__i)
- }
- }
+ # See what new namespaces appeared, and import commands
+ # from them. Only exported commands go into the index.
- foreach __i $::__providedPkgs {
- lappend __pkgs [list $__i [package provide $__i]]
- set __ignorePkgs($__i) 1
- }
- foreach __i [package names] {
- if {([string compare [package provide $__i] ""] != 0) \
- && ([info exists ::__ignorePkgs($__i)] == 0)} {
- lappend __pkgs [list $__i [package provide $__i]]
- }
+ foreach ::tcl::x [::tcl::GetAllNamespaces] {
+ if {! [info exists ::tcl::namespaces($::tcl::x)]} {
+ namespace import ${::tcl::x}::*
}
}
- } msg] == 1} {
- set what [$c eval set __doingWhat]
- if {$doVerbose} {
- tclLog "warning: error while $what $file: $msg\nthis file will be retried in the next pass"
+
+ # Figure out what commands appeared
+
+ foreach ::tcl::x [info commands] {
+ set ::tcl::newCmds($::tcl::x) 1
}
- } else {
- set type [$c eval set __type]
- set cmds [lsort [$c eval array names __cmds]]
- set pkgs [$c eval set __pkgs]
- if {[llength $pkgs] > 1} {
- tclLog "warning: \"$file\" provides more than one package ($pkgs)"
+ foreach ::tcl::x $::tcl::origCmds {
+ catch {unset ::tcl::newCmds($::tcl::x)}
}
- foreach pkg $pkgs {
- # cmds is empty/not used in the direct case
- lappend files($pkg) [list $file $type $cmds]
+ foreach ::tcl::x [array names ::tcl::newCmds] {
+ # reverse engineer which namespace a command comes from
+
+ set ::tcl::abs [namespace origin $::tcl::x]
+
+ # special case so that global names have no leading
+ # ::, this is required by the unknown command
+
+ set ::tcl::abs [auto_qualify $::tcl::abs ::]
+
+ if {[string compare $::tcl::x $::tcl::abs] != 0} {
+ # Name changed during qualification
+
+ set ::tcl::newCmds($::tcl::abs) 1
+ unset ::tcl::newCmds($::tcl::x)
+ }
}
- incr processed
- unset toProcess($file)
+ # Look through the packages that appeared, and if there is
+ # a version provided, then record it
- if {$doVerbose} {
- tclLog "processed $file"
+ foreach ::tcl::x [package names] {
+ if {([string compare [package provide $::tcl::x] ""] != 0) \
+ && ![info exists ::tcl::packages($::tcl::x)]} {
+ lappend ::tcl::newPkgs \
+ [list $::tcl::x [package provide $::tcl::x]]
+ }
}
}
- interp delete $c
- }
+ } msg] == 1} {
+ set what [$c eval set ::tcl::debug]
+ if {$doVerbose} {
+ tclLog "warning: error while $what $file: $msg"
+ }
+ } else {
+ set type [$c eval set ::tcl::type]
+ set cmds [lsort [$c eval array names ::tcl::newCmds]]
+ set pkgs [$c eval set ::tcl::newPkgs]
+ if {[llength $pkgs] > 1} {
+ tclLog "warning: \"$file\" provides more than one package ($pkgs)"
+ }
+ foreach pkg $pkgs {
+ # cmds is empty/not used in the direct case
+ lappend files($pkg) [list $file $type $cmds]
+ }
- if {$processed == 0} {
- tclLog "this iteration could not process any files: giving up here"
- break
+ if {$doVerbose} {
+ tclLog "processed $file"
+ }
}
+ interp delete $c
}
foreach pkg [lsort [array names files]] {
diff --git a/mac/MW_TclAppleScriptHeader.pch b/mac/MW_TclAppleScriptHeader.pch
index f37bc1b..bf86989 100644
--- a/mac/MW_TclAppleScriptHeader.pch
+++ b/mac/MW_TclAppleScriptHeader.pch
@@ -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: MW_TclAppleScriptHeader.pch,v 1.1.2.1 1998/09/24 23:59:08 stanton Exp $
+ * RCS: @(#) $Id: MW_TclAppleScriptHeader.pch,v 1.1.2.2 1998/11/11 04:08:26 stanton Exp $
*/
/*
@@ -22,6 +22,7 @@
* architecture we are compiling for (see the code below). For
* example, for a 68k app the prefix file should be: MW_TclHeader68K.
*/
+
#if __POWERPC__
#pragma precompile_target "MW_TclAppleScriptHeaderPPC"
#include "MW_TclHeaderPPC"
diff --git a/mac/MW_TclHeader.pch b/mac/MW_TclHeader.pch
index 01da559..6a193d3 100644
--- a/mac/MW_TclHeader.pch
+++ b/mac/MW_TclHeader.pch
@@ -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: MW_TclHeader.pch,v 1.1.2.2 1998/09/24 23:59:08 stanton Exp $
+ * RCS: @(#) $Id: MW_TclHeader.pch,v 1.1.2.3 1998/11/11 04:08:26 stanton Exp $
*/
/*
@@ -30,7 +30,7 @@
#pragma precompile_target "MW_TclHeader68K"
#endif
-#include "tclMacCommonDefines.h"
+#include "tclMacCommonPch.h"
/*
* Place any includes below that will are needed by the majority of the
@@ -43,16 +43,5 @@
#include "tclMac.h"
#include "tclInt.h"
-/*
- * These three symbols are needed by Itcl, so we must export them
- * here. They are all from tclCompile.h, but there is no need to
- * export that whole file...
- */
-
-EXTERN void TclPrintSource _ANSI_ARGS_((FILE *outFile,
- char *string, int maxChars));
-extern int tclTraceExec;
-extern int tclTraceCompile;
-
#pragma export reset
diff --git a/mac/tclMac.h b/mac/tclMac.h
index 8be6d7a..24f9574 100644
--- a/mac/tclMac.h
+++ b/mac/tclMac.h
@@ -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: tclMac.h,v 1.1.2.2 1998/09/24 23:59:09 stanton Exp $
+ * RCS: @(#) $Id: tclMac.h,v 1.1.2.3 1998/11/11 04:08:26 stanton Exp $
*/
#ifndef _TCLMAC
@@ -79,10 +79,10 @@ EXTERN pascal void FSpCreateResFileCompat(const FSSpec *spec,
* Mac calls. These routines is from tclMacUtils.h.
*/
-EXTERN int FSpLocationFromPath _ANSI_ARGS_((int length,
- CONST char *path, FSSpecPtr theSpec));
-EXTERN OSErr FSpPathFromLocation _ANSI_ARGS_((FSSpecPtr theSpec,
- int *length, Handle *fullPath));
+EXTERN int FSpLocationFromPath _ANSI_ARGS_((int length, CONST char *path,
+ FSSpecPtr theSpec));
+EXTERN OSErr FSpPathFromLocation _ANSI_ARGS_((FSSpecPtr theSpec,
+ int *length, Handle *fullPath));
/*
* These are not in MSL 2.1.2, so we need to export them from the
diff --git a/mac/tclMacAppInit.c b/mac/tclMacAppInit.c
index d39d392..6a4ffc7 100644
--- a/mac/tclMacAppInit.c
+++ b/mac/tclMacAppInit.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: tclMacAppInit.c,v 1.1.2.2 1998/09/24 23:59:09 stanton Exp $
+ * RCS: @(#) $Id: tclMacAppInit.c,v 1.1.2.3 1998/11/11 04:08:26 stanton Exp $
*/
#include "tcl.h"
@@ -26,6 +26,8 @@ short InstallConsole _ANSI_ARGS_((short fd));
#endif
#ifdef TCL_TEST
+EXTERN int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TCL_TEST */
@@ -108,6 +110,11 @@ Tcl_AppInit(
if (TclObjTest_Init(interp) == TCL_ERROR) {
return TCL_ERROR;
}
+ if (Procbodytest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
+ Procbodytest_SafeInit);
#endif /* TCL_TEST */
/*
diff --git a/mac/tclMacCommonDefines.h b/mac/tclMacCommonDefines.h
deleted file mode 100644
index a6b184f..0000000
--- a/mac/tclMacCommonDefines.h
+++ /dev/null
@@ -1,90 +0,0 @@
-/*
- * tclMacCommonDefines.h --
- *
- * This file contains all the defines that commonly go in the .pch files
- * for both Tcl & Tk.
- *
- * Copyright (c) 1995-1997 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * SCCS: @(#) tclMacCommonDefines.h 1.1 98/02/18 13:01:21
- */
-
-
-/*
- * Macintosh Tcl must be compiled with certain compiler options to
- * ensure that it will work correctly. The following pragmas are
- * used to ensure that those options are set correctly. An error
- * will occur at compile time if they are not set correctly.
- */
-
-#if !__option(enumsalwaysint)
-#error Tcl requires the Metrowerks setting "Enums always ints".
-#endif
-
-#if !defined(__POWERPC__)
-#if !__option(far_data)
-#error Tcl requires the Metrowerks setting "Far data".
-#endif
-#endif
-
-#if !defined(__POWERPC__)
-#if !__option(fourbyteints)
-#error Tcl requires the Metrowerks setting "4 byte ints".
-#endif
-#endif
-
-#if !defined(__POWERPC__)
-#if !__option(IEEEdoubles)
-#error Tcl requires the Metrowerks setting "8 byte doubles".
-#endif
-#endif
-
-/*
- * The define is used most everywhere to tell Tcl (or any Tcl
- * extensions) that we are compiling for the Macintosh platform.
- */
-
-#define MAC_TCL
-
-/*
- * The following defines control the behavior of the Macintosh
- * Universial Headers.
- */
-
-#define SystemSevenOrLater 1
-#define STRICT_CONTROLS 1
-#define STRICT_WINDOWS 1
-
-/*
- * Define the following symbol if you want
- * to build the Thread capable version of Tcl.
- */
-
-/* #define TCL_THREADS */
-
-/*
- * Define the following symbol if you want
- * comprehensive debugging turned on.
- */
-
-/* #define TCL_DEBUG */
-
-#ifdef TCL_DEBUG
-# define TCL_MEM_DEBUG
-# define TCL_TEST
-#endif
-
-
-/*
- * For a while, we will continue to use the old routine names, so that
- * people with older versions of CodeWarrior will still be able to compile
- * the source (albeit they will have to update the project files themselves).
- *
- * At some point, we will convert over to the new routine names.
- */
-
-#define OLDROUTINENAMES 1
-
diff --git a/mac/tclMacResource.c b/mac/tclMacResource.c
index 97c480e..033c8d0 100644
--- a/mac/tclMacResource.c
+++ b/mac/tclMacResource.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: tclMacResource.c,v 1.1.2.2 1998/09/24 23:59:16 stanton Exp $
+ * RCS: @(#) $Id: tclMacResource.c,v 1.1.2.3 1998/11/11 04:08:27 stanton Exp $
*/
#include <Errors.h>
@@ -1827,7 +1827,7 @@ GetRsrcRefFromObj(
* managed by the procedures in this file. If the resource file
* is already registered with the table, then no new token is made.
*
- * The bahavior is controlled by the value of tokenPtr, and of the
+ * The behavior is controlled by the value of tokenPtr, and of the
* flags variable. For tokenPtr, the possibilities are:
* - NULL: The new token is auto-generated, but not returned.
* - The string value of tokenPtr is the empty string: Then
@@ -1849,7 +1849,7 @@ GetRsrcRefFromObj(
* Standard Tcl Result
*
* Side effects:
- * An entry is added to the resource name table.
+ * An entry may be added to the resource name table.
*
*----------------------------------------------------------------------
*/
@@ -1875,12 +1875,14 @@ TclMacRegisterResourceFork(
/*
* If we were asked to, check that this file has not been opened
- * already.
+ * already with a different permission. It it has, then return an error.
*/
+ new = 1;
+
if (flags & TCL_RESOURCE_CHECK_IF_OPEN) {
Tcl_HashSearch search;
- short oldFileRef;
+ short oldFileRef, filePermissionFlag;
FCBPBRec newFileRec, oldFileRec;
OSErr err;
@@ -1894,15 +1896,17 @@ TclMacRegisterResourceFork(
newFileRec.ioVRefNum = 0;
newFileRec.ioRefNum = fileRef;
err = PBGetFCBInfo(&newFileRec, false);
+ filePermissionFlag = ( newFileRec.ioFCBFlags >> 12 ) & 0x1;
resourceHashPtr = Tcl_FirstHashEntry(&resourceTable, &search);
while (resourceHashPtr != NULL) {
-
oldFileRef = (short) Tcl_GetHashKey(&resourceTable,
resourceHashPtr);
-
-
+ if (oldFileRef == fileRef) {
+ new = 0;
+ break;
+ }
oldFileRec.ioVRefNum = 0;
oldFileRec.ioRefNum = oldFileRef;
err = PBGetFCBInfo(&oldFileRec, false);
@@ -1913,43 +1917,52 @@ TclMacRegisterResourceFork(
* to fix it here, OR because it is the ROM MAP, which has a
* fileRef, but can't be gotten to by PBGetFCBInfo.
*/
-
- if (oldFileRef == fileRef) {
- resourceId = (char *) Tcl_GetHashValue(resourceHashPtr);
- Tcl_SetStringObj(tokenPtr, resourceId, -1);
- return TCL_OK;
- } else if ((err == noErr)
+ if ((err == noErr)
&& (newFileRec.ioFCBVRefNum == oldFileRec.ioFCBVRefNum)
- && (newFileRec.ioFCBFlNm == oldFileRec.ioFCBFlNm)
- && (newFileRec.ioFCBFlags == oldFileRec.ioFCBFlags)) {
+ && (newFileRec.ioFCBFlNm == oldFileRec.ioFCBFlNm)) {
/*
- * THis is the same file. If the permissions are the same as well,
- * then close the second path, and return the token for the
- * first path
- */
- CloseResFile((short) fileRef);
- resourceId = (char *) Tcl_GetHashValue(resourceHashPtr);
- Tcl_SetStringObj(tokenPtr, resourceId, -1);
- return TCL_OK;
+ * In MacOS 8.1 it seems like we get different file refs even
+ * though we pass the same file & permissions. This is not
+ * what Inside Mac says should happen, but it does, so if it
+ * does, then close the new res file and return the original
+ * one...
+ */
+
+ if (filePermissionFlag == ((oldFileRec.ioFCBFlags >> 12) & 0x1)) {
+ CloseResFile(fileRef);
+ new = 0;
+ break;
+ } else {
+ if (tokenPtr != NULL) {
+ Tcl_SetStringObj(tokenPtr, "Resource already open with different permissions.", -1);
+ }
+ return TCL_ERROR;
+ }
}
-
resourceHashPtr = Tcl_NextHashEntry(&search);
}
-
-
}
+
- resourceHashPtr = Tcl_CreateHashEntry(&resourceTable,
+ /*
+ * If the file has already been opened with these same permissions, then it
+ * will be in our list and we will have set new to 0 above.
+ * So we will just return the token (if tokenPtr is non-null)
+ */
+
+ if (new) {
+ resourceHashPtr = Tcl_CreateHashEntry(&resourceTable,
(char *) fileRef, &new);
+ }
+
if (!new) {
- if (tokenPtr != NULL) {
+ if (tokenPtr != NULL) {
resourceId = (char *) Tcl_GetHashValue(resourceHashPtr);
- Tcl_SetStringObj(tokenPtr, resourceId, -1);
+ Tcl_SetStringObj(tokenPtr, resourceId, -1);
}
- return TCL_OK;
- }
-
-
+ return TCL_OK;
+ }
+
/*
* If we were passed in a result pointer which is not an empty
* string, attempt to use that as the key. If the key already
diff --git a/mac/tclMacTest.c b/mac/tclMacTest.c
index 54ea96d..8f1117c 100644
--- a/mac/tclMacTest.c
+++ b/mac/tclMacTest.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: tclMacTest.c,v 1.1.2.1 1998/09/24 23:59:18 stanton Exp $
+ * RCS: @(#) $Id: tclMacTest.c,v 1.1.2.2 1998/11/11 04:08:27 stanton Exp $
*/
#define TCL_TEST
@@ -188,11 +188,11 @@ WriteTextResource(
strcpy((char *) resourceName, rsrcName);
c2pstr((char *) resourceName);
- dataHandle = NewHandle(strlen(data) + 1);
+ dataHandle = NewHandle(strlen(data));
HLock(dataHandle);
strcpy(*dataHandle, data);
HUnlock(dataHandle);
-
+
/*
* Add the resource to the file and close it.
*/
diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test
index 11db5f0..50a654f 100644
--- a/tests/autoMkindex.test
+++ b/tests/autoMkindex.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: autoMkindex.test,v 1.1.2.1 1998/09/24 23:59:19 stanton Exp $
+# RCS: @(#) $Id: autoMkindex.test,v 1.1.2.2 1998/11/11 04:08:28 stanton Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
@@ -53,3 +53,9 @@ test autoMkindex-2.1 {commands on the autoload path can be imported} {
interp delete $interp
set final
} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"
+
+#
+# Clean up.
+#
+
+catch {file delete tclIndex}
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index 58b83d4..3b38f84 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -3,11 +3,12 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
+# Copyright (c) 1998 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: cmdIL.test,v 1.1.2.2 1998/09/24 23:59:21 stanton Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.1.2.3 1998/11/11 04:08:28 stanton Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
@@ -38,34 +39,37 @@ test cmdIL-1.7 {Tcl_LsortObjCmd procedure, -decreasing option} {
test cmdIL-1.8 {Tcl_LsortObjCmd procedure, -dictionary option} {
lsort -dictionary {d e c b a d35 d300}
} {a b c d d35 d300 e}
-test cmdIL-1.9 {Tcl_LsortObjCmd procedure, -increasing option} {
+test cmdIL-1.9 {Tcl_LsortObjCmd procedure, -dictionary option} {
+ lsort -dictionary {1k 0k 10k}
+} {0k 1k 10k}
+test cmdIL-1.10 {Tcl_LsortObjCmd procedure, -increasing option} {
lsort -decreasing -increasing {d e c b a d35 d300}
} {a b c d d300 d35 e}
-test cmdIL-1.10 {Tcl_LsortObjCmd procedure, -index option} {
+test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} {
list [catch {lsort -index {1 3 2 5}} msg] $msg
} {1 {"-index" option must be followed by list index}}
-test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} {
+test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} {
list [catch {lsort -index foo {1 3 2 5}} msg] $msg
} {1 {bad index "foo": must be integer or "end"}}
-test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} {
+test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} {
lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1}
} {1 {2 25} {3 16 42} {10 20 50 100}}
-test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} {
+test cmdIL-1.14 {Tcl_LsortObjCmd procedure, -index option} {
lsort -index 1 -integer {{1 25 100} {3 16 42} {10 20 50}}
} {{3 16 42} {10 20 50} {1 25 100}}
-test cmdIL-1.14 {Tcl_LsortObjCmd procedure, -integer option} {
+test cmdIL-1.15 {Tcl_LsortObjCmd procedure, -integer option} {
lsort -integer {24 6 300 18}
} {6 18 24 300}
-test cmdIL-1.15 {Tcl_LsortObjCmd procedure, -integer option} {
+test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -integer option} {
list [catch {lsort -integer {1 3 2.4}} msg] $msg
} {1 {expected integer but got "2.4"}}
-test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -real option} {
+test cmdIL-1.17 {Tcl_LsortObjCmd procedure, -real option} {
lsort -real {24.2 6e3 150e-1}
} {150e-1 24.2 6e3}
-test cmdIL-1.17 {Tcl_LsortObjCmd procedure, bogus list} {
+test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} {
list [catch {lsort "1 2 3 \{ 4"} msg] $msg
} {1 {unmatched open brace in list}}
-test cmdIL-1.18 {Tcl_LsortObjCmd procedure, empty list} {
+test cmdIL-1.19 {Tcl_LsortObjCmd procedure, empty list} {
lsort {}
} {}
diff --git a/tests/http.test b/tests/http.test
index 3a0e420..e5afd9a 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -11,7 +11,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#
-# RCS: @(#) $Id: http.test,v 1.1.2.2 1998/09/24 23:59:25 stanton Exp $
+# RCS: @(#) $Id: http.test,v 1.1.2.3 1998/11/11 04:08:28 stanton Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
@@ -256,7 +256,7 @@ test http-4.11 {http::Event} {
http::status $token
} {reset}
test http-4.12 {http::Event} {
- set token [http::geturl $url -timeout 1 -command {#}]
+ set token [http::geturl $url?timeout=10 -timeout 1 -command {#}]
http::wait $token
http::status $token
} {timeout}
diff --git a/tests/httpold.test b/tests/httpold.test
index 3873639..138574a 100644
--- a/tests/httpold.test
+++ b/tests/httpold.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: httpold.test,v 1.1.2.1 1998/09/24 23:59:25 stanton Exp $
+# RCS: @(#) $Id: httpold.test,v 1.1.2.2 1998/11/11 04:08:28 stanton Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
@@ -145,6 +145,14 @@ proc httpdRespond { sock } {
append html "<h2>Query</h2>\n<dl>\n"
foreach {key value} [split $data(query) &=] {
append html "<dt>$key<dd>$value\n"
+ if {[string compare $key timeout] == 0} {
+ # Simulate a timeout by not responding,
+ # but clean up our socket later.
+
+ after 50 [list httpdSockDone $sock]
+ httpd_log $sock Noresponse ""
+ return
+ }
}
append html </dl>\n
}
diff --git a/tests/interp.test b/tests/interp.test
index f602def..bfca84b 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -5,11 +5,12 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998 by Scriptics Corporation.
#
# 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.1.2.3 1998/10/05 18:47:26 stanton Exp $
+# RCS: @(#) $Id: interp.test,v 1.1.2.4 1998/11/11 04:08:29 stanton Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
@@ -2316,8 +2317,15 @@ test interp-29.2 {recursion limit inheritance} {
#test interp-29.1 {interp and stack (info level)} {
#} {}
+# End of stack-recursion tests
}
+# This test dumps core in Tcl 8.0.3!
+#test interp-30.1 {deletion of aliases inside namespaces} {
+# set i [interp create]
+# $i alias ns::cmd list
+# $i alias ns::cmd {}
+#} {}
foreach i [interp slaves] {
interp delete $i
diff --git a/tests/io.test b/tests/io.test
index d90d1c0..cd0c06d 100644
--- a/tests/io.test
+++ b/tests/io.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: io.test,v 1.1.2.2 1998/09/24 23:59:27 stanton Exp $
+# RCS: @(#) $Id: io.test,v 1.1.2.3 1998/11/11 04:08:30 stanton Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
@@ -6705,8 +6705,8 @@ test io-34.2 {buffered data and file events, read} {
proc accept {sock args} {
set ::s2 $sock
}
- set server [socket -server accept 4040]
- set s [socket localhost 4040]
+ set server [socket -server accept 4041]
+ set s [socket localhost 4041]
vwait s2
update
fileevent $s2 readable {lappend result readable}
@@ -6723,6 +6723,31 @@ test io-34.2 {buffered data and file events, read} {
set result
} {1 readable 234567890 timer}
+test io-35.1 {Tcl_NotifyChannel and error when closing} {unixOrPc} {
+ set out [open script w]
+ puts $out {
+ puts "normal message from pipe"
+ puts stderr "error message from pipe"
+ exit 1
+ }
+ proc readit {pipe} {
+ global x result
+ if {[eof $pipe]} {
+ set x [catch {close $pipe} line]
+ lappend result catch $line
+ } else {
+ gets $pipe line
+ lappend result gets $line
+ }
+ }
+ close $out
+ set pipe [open "|[list $tcltest] script" r]
+ fileevent $pipe readable [list readit $pipe]
+ set x ""
+ set result ""
+ vwait x
+ list $x $result
+} {1 {gets {normal message from pipe} gets {} catch {error message from pipe}}}
removeFile fooBar
diff --git a/tests/parse.test b/tests/parse.test
index ff61caa..3f8ae88 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -7,7 +7,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.1.2.2 1998/09/24 23:59:33 stanton Exp $
+# RCS: @(#) $Id: parse.test,v 1.1.2.3 1998/11/11 04:08:33 stanton Exp $
if {[info commands testparser] == {}} {
puts "This application hasn't been compiled with the \"testparser\""
@@ -555,151 +555,185 @@ test parse-15.4 {Tcl_ParseQuotedString procedure, garbage after quoted string} {
invoked from within
"testparser {foo "a b c"d} 0"}}
-test parse-15.1 {CommandComplete procedure} {
+test parse-15.5 {CommandComplete procedure} {
info complete ""
} 1
-test parse-15.2 {CommandComplete procedure} {
+test parse-15.6 {CommandComplete procedure} {
info complete " \n"
} 1
-test parse-15.3 {CommandComplete procedure} {
+test parse-15.7 {CommandComplete procedure} {
info complete "abc def"
} 1
-test parse-15.4 {CommandComplete procedure} {
+test parse-15.8 {CommandComplete procedure} {
info complete "a b c d e f \t\n"
} 1
-test parse-15.5 {CommandComplete procedure} {
+test parse-15.9 {CommandComplete procedure} {
info complete {a b c"d}
} 1
-test parse-15.6 {CommandComplete procedure} {
+test parse-15.10 {CommandComplete procedure} {
info complete {a b "c d" e}
} 1
-test parse-15.7 {CommandComplete procedure} {
+test parse-15.11 {CommandComplete procedure} {
info complete {a b "c d"}
} 1
-test parse-15.8 {CommandComplete procedure} {
+test parse-15.12 {CommandComplete procedure} {
info complete {a b "c d"}
} 1
-test parse-15.9 {CommandComplete procedure} {
+test parse-15.13 {CommandComplete procedure} {
info complete {a b "c d}
} 0
-test parse-15.10 {CommandComplete procedure} {
+test parse-15.14 {CommandComplete procedure} {
info complete {a b "}
} 0
-test parse-15.11 {CommandComplete procedure} {
+test parse-15.15 {CommandComplete procedure} {
info complete {a b "cd"xyz}
} 1
-test parse-15.12 {CommandComplete procedure} {
+test parse-15.16 {CommandComplete procedure} {
info complete {a b "c $d() d"}
} 1
-test parse-15.13 {CommandComplete procedure} {
+test parse-15.17 {CommandComplete procedure} {
info complete {a b "c $dd("}
} 0
-test parse-15.14 {CommandComplete procedure} {
+test parse-15.18 {CommandComplete procedure} {
info complete {a b "c \"}
} 0
-test parse-15.15 {CommandComplete procedure} {
+test parse-15.19 {CommandComplete procedure} {
info complete {a b "c [d e f]"}
} 1
-test parse-15.16 {CommandComplete procedure} {
+test parse-15.20 {CommandComplete procedure} {
info complete {a b "c [d e f] g"}
} 1
-test parse-15.17 {CommandComplete procedure} {
+test parse-15.21 {CommandComplete procedure} {
info complete {a b "c [d e f"}
} 0
-test parse-15.18 {CommandComplete procedure} {
+test parse-15.22 {CommandComplete procedure} {
info complete {a {b c d} e}
} 1
-test parse-15.19 {CommandComplete procedure} {
+test parse-15.23 {CommandComplete procedure} {
info complete {a {b c d}}
} 1
-test parse-15.20 {CommandComplete procedure} {
+test parse-15.24 {CommandComplete procedure} {
info complete "a b\{c d"
} 1
-test parse-15.21 {CommandComplete procedure} {
+test parse-15.25 {CommandComplete procedure} {
info complete "a b \{c"
} 0
-test parse-15.22 {CommandComplete procedure} {
+test parse-15.26 {CommandComplete procedure} {
info complete "a b \{c{ }"
} 0
-test parse-15.23 {CommandComplete procedure} {
+test parse-15.27 {CommandComplete procedure} {
info complete "a b {c d e}xxx"
} 1
-test parse-15.24 {CommandComplete procedure} {
+test parse-15.28 {CommandComplete procedure} {
info complete "a b {c \\\{d e}xxx"
} 1
-test parse-15.25 {CommandComplete procedure} {
+test parse-15.29 {CommandComplete procedure} {
info complete {a b [ab cd ef]}
} 1
-test parse-15.26 {CommandComplete procedure} {
+test parse-15.30 {CommandComplete procedure} {
info complete {a b x[ab][cd][ef] gh}
} 1
-test parse-15.27 {CommandComplete procedure} {
+test parse-15.31 {CommandComplete procedure} {
info complete {a b x[ab][cd[ef] gh}
} 0
-test parse-15.28 {CommandComplete procedure} {
+test parse-15.32 {CommandComplete procedure} {
info complete {a b x[ gh}
} 0
-test parse-15.29 {CommandComplete procedure} {
+test parse-15.33 {CommandComplete procedure} {
info complete {[]]]}
} 1
-test parse-15.30 {CommandComplete procedure} {
+test parse-15.34 {CommandComplete procedure} {
info complete {abc x$yyy}
} 1
-test parse-15.31 {CommandComplete procedure} {
+test parse-15.35 {CommandComplete procedure} {
info complete "abc x\${abc\[\\d} xyz"
} 1
-test parse-15.32 {CommandComplete procedure} {
+test parse-15.36 {CommandComplete procedure} {
info complete "abc x\$\{ xyz"
} 0
-test parse-15.33 {CommandComplete procedure} {
+test parse-15.37 {CommandComplete procedure} {
info complete {word $a(xyz)}
} 1
-test parse-15.34 {CommandComplete procedure} {
+test parse-15.38 {CommandComplete procedure} {
info complete {word $a(}
} 0
-test parse-15.35 {CommandComplete procedure} {
+test parse-15.39 {CommandComplete procedure} {
info complete "set a \\\n"
} 0
-test parse-15.36 {CommandComplete procedure} {
+test parse-15.40 {CommandComplete procedure} {
info complete "set a \\\\\n"
} 1
-test parse-15.37 {CommandComplete procedure} {
+test parse-15.41 {CommandComplete procedure} {
info complete "set a \\n "
} 1
-test parse-15.38 {CommandComplete procedure} {
+test parse-15.42 {CommandComplete procedure} {
info complete "set a \\"
} 1
-test parse-15.39 {CommandComplete procedure} {
+test parse-15.43 {CommandComplete procedure} {
info complete "foo \\\n\{"
} 0
-test parse-15.40 {CommandComplete procedure} {
+test parse-15.44 {CommandComplete procedure} {
info complete "a\nb\n# \{\n# \{\nc\n"
} 1
-test parse-15.41 {CommandComplete procedure} {
+test parse-15.45 {CommandComplete procedure} {
info complete "#Incomplete comment\\\n"
} 0
-test parse-15.42 {CommandComplete procedure} {
+test parse-15.46 {CommandComplete procedure} {
info complete "#Incomplete comment\\\nBut now it's complete.\n"
} 1
-test parse-15.43 {CommandComplete procedure} {
+test parse-15.47 {CommandComplete procedure} {
info complete "# Complete comment\\\\\n"
} 1
-test parse-15.44 {CommandComplete procedure} {
+test parse-15.48 {CommandComplete procedure} {
info complete "abc\\\n def"
} 1
-test parse-15.45 {CommandComplete procedure} {
+test parse-15.49 {CommandComplete procedure} {
info complete "abc\\\n "
} 1
-test parse-15.46 {CommandComplete procedure} {
+test parse-15.50 {CommandComplete procedure} {
info complete "abc\\\n"
} 0
-test parse-15.47 {CommandComplete procedure} {
+test parse-15.51 {CommandComplete procedure} {
info complete "\{abc\}\{"
} 1
-test parse-15.48 {CommandComplete procedure} {
+test parse-15.52 {CommandComplete procedure} {
info complete "\"abc\"("
} 1
+test parse-15.53 {CommandComplete procedure} {
+ parse complete " # \{"
+} 1
+test parse-15.54 {CommandComplete procedure} {
+ parse complete "foo bar;# \{"
+} 1
+test parse-15.55 {CommandComplete procedure} {
+ parse complete "a\nb\n# \{\n# \{\nc\n"
+} 1
+test parse-15.56 {CommandComplete procedure} {
+ parse complete "#Incomplete comment\\\n"
+} 0
+test parse-15.57 {CommandComplete procedure} {
+ parse complete "#Incomplete comment\\\nBut now it's complete.\n"
+} 1
+test parse-15.58 {CommandComplete procedure} {
+ parse complete "# Complete comment\\\\\n"
+} 1
+test parse-15.59 {CommandComplete procedure} {
+ parse complete "abc\\\n def"
+} 1
+test parse-15.60 {CommandComplete procedure} {
+ parse complete "abc\\\n "
+} 1
+test parse-15.61 {CommandComplete procedure} {
+ parse complete "abc\\\n"
+} 0
+test parse-15.62 {CommandComplete procedure} {
+ parse complete "set x [binary format H 00]; puts hi"
+} 1
+test parse-15.63 {CommandComplete procedure} {
+ parse complete "set x [binary format H 00]; {"
+} 0
catch {unset a}
return
+
diff --git a/tests/registry.test b/tests/registry.test
index ffa2961..5196cfb 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -9,7 +9,7 @@
#
# Copyright (c) 1997 by Sun Microsystems, Inc. All rights reserved.
#
-# RCS: @(#) $Id: registry.test,v 1.1.2.2 1998/09/24 23:59:34 stanton Exp $
+# RCS: @(#) $Id: registry.test,v 1.1.2.3 1998/11/11 04:08:33 stanton Exp $
if {$tcl_platform(platform) != "windows"} {
return
@@ -17,7 +17,10 @@ if {$tcl_platform(platform) != "windows"} {
if {[string compare test [info procs test]] == 1} then {source defs}
-if [catch {package require registry}] {
+set lib [lindex [glob [file join [pwd] [file dirname \
+ [info nameofexecutable]] tclreg*.dll]] 0]
+
+if [catch {load $lib registry}] {
puts "Unable to find the registry package. Skipping registry tests."
return
}
diff --git a/tests/resource.test b/tests/resource.test
index 840443c..938ff34 100644
--- a/tests/resource.test
+++ b/tests/resource.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: resource.test,v 1.1.2.1 1998/09/24 23:59:35 stanton Exp $
+# RCS: @(#) $Id: resource.test,v 1.1.2.2 1998/11/11 04:08:34 stanton Exp $
# Only run this test on Macintosh systems
if {$tcl_platform(platform) != "macintosh"} {
@@ -45,27 +45,38 @@ test resource-2.5 {resource open & close tests} {
} {}
test resource-2.6 {resource open & close tests} {
catch {file delete rsrc.file}
- testWriteTextResource -rsrc fileRsrcName -file rsrc.file {error "don't source me"}
+ testWriteTextResource -rsrc fileRsrcName -file rsrc.file {A test string}
set id [resource open rsrc.file]
set result [string compare [resource open rsrc.file] $id]
+ lappend result [resource read TEXT fileRsrcName $id]
resource close $id
file delete rsrc.file
set result
-} {0}
+} {0 {A test string}}
test resource-2.7 {resource open & close tests} {
+ catch {file delete rsrc.file}
+ testWriteTextResource -rsrc fileRsrcName -file rsrc.file {error "don't source me"}
+ set id [resource open rsrc.file r]
+ set result [catch {resource open rsrc.file w} mssg]
+ resource close $id
+ file delete rsrc.file
+ lappend result $mssg
+ set result
+} {1 {Resource already open with different permissions.}}
+test resource-2.8 {resource open & close tests} {
list [catch {resource close} msg] $msg
} {1 {wrong # args: should be "resource close resourceRef"}}
-test resource-2.8 {resource open & close tests} {
+test resource-2.9 {resource open & close tests} {
list [catch {resource close foo bar} msg] $msg
} {1 {wrong # args: should be "resource close resourceRef"}}
-test resource-2.9 {resource open & close tests} {
+test resource-2.10 {resource open & close tests} {
list [catch {resource close _bad_resource_} msg] $msg
} {1 {invalid resource file reference "_bad_resource_"}}
-test resource-2.10 {resource open & close tests} {
+test resource-2.11 {resource open & close tests} {
set result [catch {resource close System} mssg]
lappend result $mssg
} {1 {can't close "System" resource file}}
-test resource-2.11 {resource open & close tests} {
+test resource-2.12 {resource open & close tests} {
set result [catch {resource close application} mssg]
lappend result $mssg
} {1 {can't close "application" resource file}}
diff --git a/tests/safe.test b/tests/safe.test
index 4ca857a..745b529 100644
--- a/tests/safe.test
+++ b/tests/safe.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: safe.test,v 1.1.2.2 1998/09/24 23:59:35 stanton Exp $
+# RCS: @(#) $Id: safe.test,v 1.1.2.3 1998/11/11 04:08:35 stanton Exp $
if {[string compare test [info procs test]] == 1} then {source defs}
@@ -167,7 +167,10 @@ test safe-6.1 {test safe interpreters knowledge of the world} {
test safe-6.2 {test safe interpreters knowledge of the world} {
SI; set r [$I eval {info script}]; DI; set r
} {}
-test safe-6.3 {test safe interpreters knowledge of the world} {
+test safe-6.3 {test safe interpreters knowledge of the world} {pcOnly} {
+ SI; set r [lsort [$I eval {array names tcl_platform}]]; DI; set r
+} {byteOrder debug platform}
+test safe-6.3 {test safe interpreters knowledge of the world} {macOrUnix} {
SI; set r [lsort [$I eval {array names tcl_platform}]]; DI; set r
} {byteOrder platform}
diff --git a/tests/winPipe.test b/tests/winPipe.test
index f8d0192..1991abc 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -11,14 +11,15 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: winPipe.test,v 1.1.2.2 1998/09/24 23:59:40 stanton Exp $
+# RCS: @(#) $Id: winPipe.test,v 1.1.2.3 1998/11/11 04:08:35 stanton Exp $
if {($tcl_platform(platform) != "windows") || ($testConfig(stdio) == 0)} {
return
}
-set cat16 [file join $tcl_library ../win/cat16.exe]
-set cat32 [file join $tcl_library ../win/cat32.exe]
+set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
+set cat16 [file join $bindir cat16.exe]
+set cat32 [file join $bindir cat32.exe]
if {[string compare test [info procs test]] == 1} then {source defs}
@@ -263,7 +264,7 @@ test winpipe-2.21 {16 bit comprehensive tests: read/write application} {nt} {
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
}
-test winpipe-3.1 {Tcl_WaitPid} {nt} {
+test winpipe-4.1 {Tcl_WaitPid} {nt} {
proc readResults {f} {
global x result
if { [eof $f] } {
diff --git a/unix/Makefile.in b/unix/Makefile.in
index cbcd510..4e32789 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -5,7 +5,7 @@
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
-# RCS: @(#) $Id: Makefile.in,v 1.1.2.5 1998/11/11 01:44:57 stanton Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.1.2.6 1998/11/11 04:08:36 stanton Exp $
# Current Tcl version; used in various names.
@@ -198,7 +198,7 @@ TCL_LIB_FLAG = @TCL_LIB_FLAG@
COMPAT_OBJS = @LIBOBJS@
-AC_FLAGS = @DEFS@
+AC_FLAGS = @EXTRA_CFLAGS@ @DEFS@
RANLIB = @RANLIB@
SRC_DIR = @srcdir@
TOP_DIR = @srcdir@/..
diff --git a/unix/configure.in b/unix/configure.in
index 817f3b2..78f3c2c 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -2,12 +2,11 @@ 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.
AC_INIT(../generic/tcl.h)
-# RCS: @(#) $Id: configure.in,v 1.1.2.2 1998/09/24 23:59:42 stanton Exp $
+# RCS: @(#) $Id: configure.in,v 1.1.2.3 1998/11/11 04:08:37 stanton Exp $
TCL_VERSION=8.1
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=1
-TCL_PATCH_LEVEL="a2"
VERSION=${TCL_VERSION}
if test "${prefix}" = "NONE"; then
@@ -699,7 +698,7 @@ AC_CHECK_LIB(dl, dlopen, have_dl=yes, have_dl=no)
# Step 3: set configuration options based on system name and version.
fullSrcDir=`cd $srcdir; pwd`
-TCL_SHARED_LIB_SUFFIX=""
+EXTRA_CFLAGS=""
TCL_UNSHARED_LIB_SUFFIX=""
TCL_TRIM_DOTS='`echo ${VERSION} | tr -d .`'
ECHO_VERSION='`echo ${VERSION}`'
@@ -776,13 +775,27 @@ case $system in
;;
IRIX-5.*|IRIX-6.*)
SHLIB_CFLAGS=""
- SHLIB_LD="ld -shared -rdata_shared"
+ SHLIB_LD="ld -n32 -shared -rdata_shared"
SHLIB_LD_LIBS=""
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
- LD_FLAGS=""
LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
+ if test "$CC" = "gcc" -o `$CC -v 2>&1 | grep -c gcc` != "0" ; then
+ EXTRA_CFLAGS="-mabi=n32"
+ LD_FLAGS="-mabi=n32"
+ else
+ case $system in
+ IRIX-6.3)
+ # Use to build 6.2 compatible binaries on 6.3.
+ EXTRA_CFLAGS="-n32 -D_OLD_TERMIOS"
+ ;;
+ *)
+ EXTRA_CFLAGS="-n32"
+ ;;
+ esac
+ LD_FLAGS="-n32"
+ fi
;;
IRIX64-6.*)
SHLIB_CFLAGS=""
@@ -1287,6 +1300,7 @@ AC_SUBST(CFG_TCL_UNSHARED_LIB_SUFFIX)
AC_SUBST(TCL_DBGX)
AC_SUBST(DL_LIBS)
AC_SUBST(DL_OBJS)
+AC_SUBST(EXTRA_CFLAGS)
AC_SUBST(LD_FLAGS)
AC_SUBST(MAKE_LIB)
AC_SUBST(MATH_LIBS)
diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in
index 1875852..cc7f14a 100644
--- a/unix/tclConfig.sh.in
+++ b/unix/tclConfig.sh.in
@@ -9,7 +9,7 @@
#
# The information in this file is specific to a single platform.
#
-# RCS: @(#) $Id: tclConfig.sh.in,v 1.1.2.1 1998/09/24 23:59:43 stanton Exp $
+# RCS: @(#) $Id: tclConfig.sh.in,v 1.1.2.2 1998/11/11 04:08:38 stanton Exp $
# Tcl's version number.
TCL_VERSION='@TCL_VERSION@'
@@ -51,6 +51,9 @@ TCL_EXEC_PREFIX='@exec_prefix@'
# Flags to pass to cc when compiling the components of a shared library:
TCL_SHLIB_CFLAGS='@SHLIB_CFLAGS@'
+# Extra flags to pass to cc:
+TCL_EXTRA_CFLAGS='@EXTRA_CFLAGS@'
+
# Base command to use for combining object files into a shared library:
TCL_SHLIB_LD='@SHLIB_LD@'
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index f6ab520..cab23e7 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -4,11 +4,12 @@
* Contains platform specific test commands for the Unix platform.
*
* Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixTest.c,v 1.1.2.2 1998/09/24 23:59:46 stanton Exp $
+ * RCS: @(#) $Id: tclUnixTest.c,v 1.1.2.3 1998/11/11 04:08:38 stanton Exp $
*/
#include "tclInt.h"
@@ -516,7 +517,7 @@ TestgetopenfileCmd(clientData, interp, argc, argv)
*----------------------------------------------------------------------
*/
-int
+static int
TestalarmCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
@@ -593,7 +594,7 @@ AlarmHandler()
*----------------------------------------------------------------------
*/
-int
+static int
TestgotsigCmd(clientData, interp, argc, argv)
ClientData clientData; /* Not used. */
Tcl_Interp *interp; /* Current interpreter. */
diff --git a/win/makefile.vc b/win/makefile.vc
index de9f892..79c4352 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -4,7 +4,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
-# RCS: @(#) $Id: makefile.vc,v 1.1.2.8 1998/11/11 01:44:57 stanton Exp $
+# RCS: @(#) $Id: makefile.vc,v 1.1.2.9 1998/11/11 04:08:39 stanton Exp $
# Does not depend on the presence of any environment variables in
# order to compile tcl; all needed information is derived from
@@ -236,11 +236,11 @@ guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup
dlllflags = $(lflags) -entry:_DllMainCRTStartup$(DLLENTRY) -dll
!IF "$(MACHINE)" == "PPC"
-libc = libc.lib
-libcdll = crtdll.lib
+libc = libc$(DBGX).lib
+libcdll = crtdll$(DBGX).lib
!ELSE
-libc = libc.lib oldnames.lib
-libcdll = msvcrt.lib oldnames.lib
+libc = libc$(DBGX).lib oldnames.lib
+libcdll = msvcrt$(DBGX).lib oldnames.lib
!ENDIF
baselibs = kernel32.lib $(optlibs) advapi32.lib user32.lib
@@ -260,7 +260,9 @@ conlibsdll = $(libcdll) $(baselibs)
# MSVC on Alpha doesn't understand -Ot
cdebug = -O2i -Gs -GD
!ELSE
-cdebug = -Oti -Gs -GD
+#cdebug = -Oti -Gs -GD
+# This cranks the optimization level to maximize speed
+cdebug = -O2 -Gs -GD
!ENDIF
!ELSE
cdebug = -Z7 -Od -WX
@@ -305,8 +307,9 @@ all: setup $(TCLSH) dlls $(CAT16) $(CAT32)
tcltest: setup $(TCLTEST) dlls $(CAT16) $(CAT32)
plugin: setup $(TCLPLUGINDLL) $(TCLSHP)
install: install-binaries install-libraries
-test: setup $(TCLTEST) dlls $(CAT16) $(CAT32)
- set TCL_LIBRARY=$(ROOT)\library
+test: setup $(TCLTEST) dlls $(CAT16) $(CAT32)
+ copy $(WINDIR)\pkgIndex.tcl $(OUTDIR)
+ set TCL_LIBRARY=$(ROOT)/library
$(TCLTEST) <<
cd ../tests
source all
@@ -418,26 +421,26 @@ install-binaries: $(TCLSH)
@copy $(TCLSH) $(BIN_INSTALL_DIR)
install-libraries:
- @mkd $(LIB_INSTALL_DIR)
- @mkd $(INCLUDE_INSTALL_DIR)
- @mkd $(SCRIPT_INSTALL_DIR)
- @mkd $(SCRIPT_INSTALL_DIR)\http1.0
- @copy $(ROOT)\library\http1.0\http.tcl $(SCRIPT_INSTALL_DIR)\http1.0
- @copy $(ROOT)\library\http1.0\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\http1.0
- @mkd $(SCRIPT_INSTALL_DIR)\http2.0
- @copy $(ROOT)\library\http2.0\http.tcl $(SCRIPT_INSTALL_DIR)\http2.0
- @copy $(ROOT)\library\http2.0\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\http2.0
- @mkd $(SCRIPT_INSTALL_DIR)\opt0.1
- @copy $(ROOT)\library\opt0.1\optparse.tcl $(SCRIPT_INSTALL_DIR)\opt0.1
- @copy $(ROOT)\library\opt0.1\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\opt0.1
- @copy $(GENERICDIR)\tcl.h $(INCLUDE_INSTALL_DIR)
- @copy $(ROOT)\library\history.tcl $(SCRIPT_INSTALL_DIR)
- @copy $(ROOT)\library\init.tcl $(SCRIPT_INSTALL_DIR)
- @copy $(ROOT)\library\ldAout.tcl $(SCRIPT_INSTALL_DIR)
- @copy $(ROOT)\library\parray.tcl $(SCRIPT_INSTALL_DIR)
- @copy $(ROOT)\library\safe.tcl $(SCRIPT_INSTALL_DIR)
- @copy $(ROOT)\library\tclIndex $(SCRIPT_INSTALL_DIR)
- @copy $(ROOT)\library\word.tcl $(SCRIPT_INSTALL_DIR)
+ -@mkd $(LIB_INSTALL_DIR)
+ -@mkd $(INCLUDE_INSTALL_DIR)
+ -@mkd $(SCRIPT_INSTALL_DIR)
+ -@mkd $(SCRIPT_INSTALL_DIR)\http1.0
+ -@copy $(ROOT)\library\http1.0\http.tcl $(SCRIPT_INSTALL_DIR)\http1.0
+ -@copy $(ROOT)\library\http1.0\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\http1.0
+ -@mkd $(SCRIPT_INSTALL_DIR)\http2.0
+ -@copy $(ROOT)\library\http2.0\http.tcl $(SCRIPT_INSTALL_DIR)\http2.0
+ -@copy $(ROOT)\library\http2.0\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\http2.0
+ -@mkd $(SCRIPT_INSTALL_DIR)\opt0.1
+ -@copy $(ROOT)\library\opt0.1\optparse.tcl $(SCRIPT_INSTALL_DIR)\opt0.1
+ -@copy $(ROOT)\library\opt0.1\pkgIndex.tcl $(SCRIPT_INSTALL_DIR)\opt0.1
+ -@copy $(GENERICDIR)\tcl.h $(INCLUDE_INSTALL_DIR)
+ -@copy $(ROOT)\library\history.tcl $(SCRIPT_INSTALL_DIR)
+ -@copy $(ROOT)\library\init.tcl $(SCRIPT_INSTALL_DIR)
+ -@copy $(ROOT)\library\ldAout.tcl $(SCRIPT_INSTALL_DIR)
+ -@copy $(ROOT)\library\parray.tcl $(SCRIPT_INSTALL_DIR)
+ -@copy $(ROOT)\library\safe.tcl $(SCRIPT_INSTALL_DIR)
+ -@copy $(ROOT)\library\tclIndex $(SCRIPT_INSTALL_DIR)
+ -@copy $(ROOT)\library\word.tcl $(SCRIPT_INSTALL_DIR)
#
# Special case object file targets
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index ef93cce..0a4c73b 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.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: tclWinInit.c,v 1.1.2.3 1998/09/30 20:50:31 stanton Exp $
+ * RCS: @(#) $Id: tclWinInit.c,v 1.1.2.4 1998/11/11 04:08:39 stanton Exp $
*/
#include "tclWinInt.h"
@@ -516,6 +516,18 @@ TclpSetVariables(interp)
TCL_GLOBAL_ONLY);
}
+#ifdef _DEBUG
+ /*
+ * The existence of the "debug" element of the tcl_platform array indicates
+ * that this particular Tcl shell has been compiled with debug information.
+ * Using "info exists tcl_platform(debug)" a Tcl script can direct the
+ * interpreter to load debug versions of DLLs with the load command.
+ */
+
+ Tcl_SetVar2(interp, "tcl_platform", "debug", "1",
+ TCL_GLOBAL_ONLY);
+#endif
+
/*
* Set up the HOME environment variable from the HOMEDRIVE & HOMEPATH
* environment variables, if necessary.