diff options
| -rw-r--r-- | ChangeLog | 53 | ||||
| -rw-r--r-- | generic/tclClock.c | 18 | ||||
| -rw-r--r-- | generic/tclCompile.c | 21 | ||||
| -rw-r--r-- | generic/tclExecute.c | 53 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 16 | ||||
| -rw-r--r-- | tests/httpd | 1 | ||||
| -rw-r--r-- | tests/namespace.test | 6 | ||||
| -rw-r--r-- | unix/tcl.spec | 8 | ||||
| -rw-r--r-- | unix/tclLoadAout.c | 8 | ||||
| -rw-r--r-- | unix/tclUnixChan.c | 4 | ||||
| -rw-r--r-- | unix/tclUnixPipe.c | 6 |
11 files changed, 48 insertions, 146 deletions
@@ -1,58 +1,15 @@ -2000-03-29 Jeff Hobbs <hobbs@scriptics.com> - - * generic/tclCompile.c (TclCleanupByteCode): made ByteCode cleanup - more aware of TCL_BYTECODE_PRECOMPILED flagged structs (gen'd by - tbcload), to correctly clean them up. - - * generic/tclClock.c (FormatClock): moved check for empty format - earlier, commented 0 result return value - -2000-03-29 Sandeep Tamhankar <sandeep@scriptics.com> - - * library/http2.1/http.tcl: Removed an unnecessary fileevent - statement from the error processing part of the Write method. - Also, fixed two potential memory leaks in wait and reset, in which - the state array wasn't being unset before throwing an exception. - Prior to this version, Brent checked in a fix to catch a - fileevent statement that was sometimes causing a stack trace when - geturl was called with -timeout. I believe Brent's fix is - necessary because TLS closes bad sockets for secure connections, - and the fileevent was trying to act on a socket that no longer - existed. - -2000-03-27 Jeff Hobbs <hobbs@scriptics.com> - - * tests/httpd: removed unnecessary 'puts stderr "Post Dispatch"' - - * tests/namespace.test: - * generic/tclNamesp.c (Tcl_Export): added a uniq'ing test to the - export list so only one instance of each export pattern would - exist in the list. - - * generic/tclExecute.c (TclExecuteByteCode): optimized case for - the empty string in ==/!= comparisons - -2000-03-27 Eric Melski <ericm@scriptics.com> - - * unix/tclUnixChan.c: Added (off_t) type casts in lseek() call - [Bug: 4409]. - - * unix/tclLoadAout.c: - * unix/tclUnixPipe.c: Added (off_t) type casts in lseek() calls - [Bug: 4410]. - 2000-03-22 Sandeep Tamhankar <sandeep@scriptics.com> - * library/http2.1/http.tcl: Fixed a bug where string query data + * library/http2.1/http.tcl: Fixed a bug where string query data that was bigger than queryblocksize would get duplicate characters at block boundaries. 2000-03-22 Sandeep Tamhankar <sandeep@scriptics.com> - * library/http2.1/http.tcl: Fixed bug 4463, where we were getting - a stack trace if we tried to publish a project to a good host but - a port where there was no server listening. It turned out the - problem was a stray fileevent that needed to be cleared. Also, + * library/http2.1/http.tcl: Fixed bug 4463, where we were getting + a stack trace if we tried to publish a project to a good host but + a port where there was no server listening. It turned out the + problem was a stray fileevent that needed to be cleared. Also, fixed a bug where http::code could stack trace if called on a bad token (one which didn't represent a successful geturl) by adding an http element to the state array in geturl. diff --git a/generic/tclClock.c b/generic/tclClock.c index 8b2bc53..b155b4d 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.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: tclClock.c,v 1.9 2000/03/30 04:36:11 hobbs Exp $ + * RCS: @(#) $Id: tclClock.c,v 1.8 2000/01/26 03:37:40 hobbs Exp $ */ #include "tcl.h" @@ -282,13 +282,6 @@ FormatClock(interp, clockVal, useGMT, format) Tcl_MutexUnlock(&clockMutex); #endif - /* - * If the user gave us -format "", just return now - */ - if (*format == '\0') { - return TCL_OK; - } - #ifndef HAVE_TM_ZONE /* * This is a kludge for systems not having the timezone string in @@ -347,14 +340,7 @@ FormatClock(interp, clockVal, useGMT, format) tzset(); } #endif - - if (result == 0) { - /* - * A zero return is the error case (can also mean the strftime - * didn't get enough space to write into). We know it doesn't - * mean that we wrote zero chars because the check for an empty - * format string is above. - */ + if ((result == 0) && (*format != '\0')) { Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "bad format string \"", format, "\"", (char *) NULL); return TCL_ERROR; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 7a9f64d..ed7500f 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.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: tclCompile.c,v 1.20 2000/03/30 04:36:11 hobbs Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.19 1999/12/12 02:26:41 hobbs Exp $ */ #include "tclInt.h" @@ -553,26 +553,9 @@ TclCleanupByteCode(codePtr) * only need to 1) decrement the ref counts of the LiteralEntry's in * its literal array, 2) call the free procs for the auxiliary data * items, and 3) free the ByteCode structure's heap object. - * - * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes, - * like those generated from tbcload) is special, as they doesn't - * make use of the global literal table. They instead maintain - * private references to their literals which must be decremented. */ - if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) { - register Tcl_Obj *objPtr; - - objArrayPtr = codePtr->objArrayPtr; - for (i = 0; i < numLitObjects; i++) { - objPtr = *objArrayPtr; - if (objPtr) { - Tcl_DecrRefCount(objPtr); - } - objArrayPtr++; - } - codePtr->numLitObjects = 0; - } else if (interp != NULL) { + if (interp != NULL) { /* * If the interp has already been freed, then Tcl will have already * forcefully released all the literals used by ByteCodes compiled diff --git a/generic/tclExecute.c b/generic/tclExecute.c index bc026b3..1affb53 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.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: tclExecute.c,v 1.10 2000/03/27 22:18:55 hobbs Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.9 1999/12/12 02:26:42 hobbs Exp $ */ #include "tclInt.h" @@ -1779,39 +1779,30 @@ TclExecuteByteCode(interp, codePtr) valuePtr = POP_OBJECT(); t1Ptr = valuePtr->typePtr; t2Ptr = value2Ptr->typePtr; - - /* - * We only want to coerce numeric validation if - * neither type is NULL. A NULL type means the arg is - * essentially an empty object ("", {} or [list]). - */ - if (!((((t1Ptr == NULL) && (valuePtr->bytes == NULL)) - || (valuePtr->bytes && (valuePtr->length == 0))) - || (((t2Ptr == NULL) && (value2Ptr->bytes == NULL)) - || (value2Ptr->bytes && (value2Ptr->length == 0))))) { - if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) { - s1 = Tcl_GetStringFromObj(valuePtr, &length); - if (TclLooksLikeInt(s1, length)) { - (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL, - valuePtr, &i); - } else { - (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, - valuePtr, &d1); - } - t1Ptr = valuePtr->typePtr; + + if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) { + s1 = Tcl_GetStringFromObj(valuePtr, &length); + if (TclLooksLikeInt(s1, length)) { + (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL, + valuePtr, &i); + } else { + (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, + valuePtr, &d1); } - if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) { - s2 = Tcl_GetStringFromObj(value2Ptr, &length); - if (TclLooksLikeInt(s2, length)) { - (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL, - value2Ptr, &i2); - } else { - (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, - value2Ptr, &d2); - } - t2Ptr = value2Ptr->typePtr; + t1Ptr = valuePtr->typePtr; + } + if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) { + s2 = Tcl_GetStringFromObj(value2Ptr, &length); + if (TclLooksLikeInt(s2, length)) { + (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL, + value2Ptr, &i2); + } else { + (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, + value2Ptr, &d2); } + t2Ptr = value2Ptr->typePtr; } + if (((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) || ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType))) { /* diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 43b074c..b64b6cc 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -19,7 +19,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.17 2000/03/27 22:18:56 hobbs Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.16 2000/01/26 21:36:35 ericm Exp $ */ #include "tclInt.h" @@ -956,20 +956,6 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst) } /* - * Make sure that we don't already have the pattern in the array - */ - if (nsPtr->exportArrayPtr != NULL) { - for (i = 0; i < nsPtr->numExportPatterns; i++) { - if (strcmp(pattern, nsPtr->exportArrayPtr[i]) == 0) { - /* - * The pattern already exists in the list - */ - return TCL_OK; - } - } - } - - /* * Make sure there is room in the namespace's pattern array for the * new pattern. */ diff --git a/tests/httpd b/tests/httpd index aa2e51d..94cfb43 100644 --- a/tests/httpd +++ b/tests/httpd @@ -106,6 +106,7 @@ proc httpdRead { sock } { set data(length) $data(length_orig) httpdRespond $sock } +puts stderr "Post Dispatch" } default { if [eof $sock] { diff --git a/tests/namespace.test b/tests/namespace.test index 7f855c9..dcc6671 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.10 2000/03/27 22:19:14 hobbs Exp $ +# RCS: @(#) $Id: namespace.test,v 1.9 2000/01/26 21:36:36 ericm Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -803,11 +803,11 @@ test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumula } list [info commands test_ns_2::*] [test_ns_2::cmd3 hello] } {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}} -test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} { +test namespace-26.6 {NamespaceExportCmd, no patterns means return export list} { namespace eval test_ns_1 { namespace export } -} {cmd1 cmd3} +} {cmd1 cmd1 cmd3} test namespace-26.7 {NamespaceExportCmd, -clear resets export list} { namespace eval test_ns_1 { namespace export -clear cmd4 diff --git a/unix/tcl.spec b/unix/tcl.spec index dc7b148..b205733 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -1,4 +1,4 @@ -# $Id: tcl.spec,v 1.2 2000/03/24 23:15:29 ericm Exp $ +# $Id: tcl.spec,v 1.1 2000/02/14 22:40:56 ericm Exp $ # This file is the basis for a binary Tcl RPM for Linux. %define version 8.3.0 @@ -43,11 +43,9 @@ rm -rf $RPM_BUILD_ROOT # then to create the files list for tk, uncomment tk, comment out tcl, # then rm -rf $RPM_BUILD_ROOT then rpm --short-circuit -bi then redo a find, # and remove the files in specific directories which suffice by themselves. -%files +%files -n tcl %defattr(-,root,root) %{directory}/lib %{directory}/bin %{directory}/include -%{directory}/man/man1 -%{directory}/man/man3 -%{directory}/man/mann +%{directory}/man diff --git a/unix/tclLoadAout.c b/unix/tclLoadAout.c index da85d16..8b6da69 100644 --- a/unix/tclLoadAout.c +++ b/unix/tclLoadAout.c @@ -14,7 +14,7 @@ * and Design Engineering (MADE) Initiative through ARPA contract * F33615-94-C-4400. * - * RCS: @(#) $Id: tclLoadAout.c,v 1.4 2000/03/27 18:34:32 ericm Exp $ + * RCS: @(#) $Id: tclLoadAout.c,v 1.3 1999/04/16 00:48:04 stanton Exp $ */ #include "tclInt.h" @@ -262,10 +262,10 @@ TclpLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr, clientDataPtr) #if defined(__mips) || defined(mips) status = lseek (relocatedFd, - (off_t) N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o), - SEEK_SET); + N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o), + SEEK_SET); #else - status = lseek (relocatedFd, (off_t) N_TXTOFF (relocatedHead), SEEK_SET); + status = lseek (relocatedFd, N_TXTOFF (relocatedHead), SEEK_SET); #endif if (status < 0) { goto ioError; diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 31204cb..06a8a42 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.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: tclUnixChan.c,v 1.14 2000/03/27 18:34:32 ericm Exp $ + * RCS: @(#) $Id: tclUnixChan.c,v 1.13 2000/01/26 03:38:00 hobbs Exp $ */ #include "tclInt.h" /* Internal definitions for Tcl. */ @@ -502,7 +502,7 @@ FileSeekProc(instanceData, offset, mode, errorCodePtr) FileState *fsPtr = (FileState *) instanceData; int newLoc; - newLoc = lseek(fsPtr->fd, (off_t) offset, mode); + newLoc = lseek(fsPtr->fd, offset, mode); *errorCodePtr = (newLoc == -1) ? errno : 0; return newLoc; diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 91c497d..0e26414 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.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: tclUnixPipe.c,v 1.8 2000/03/27 18:34:32 ericm Exp $ + * RCS: @(#) $Id: tclUnixPipe.c,v 1.7 1999/12/12 02:27:20 hobbs Exp $ */ #include "tclInt.h" @@ -147,7 +147,7 @@ TclpOpenFile(fname, mode) */ if (mode & O_WRONLY) { - lseek(fd, (off_t) 0, SEEK_END); + lseek(fd, 0, SEEK_END); } /* @@ -198,7 +198,7 @@ TclpCreateTempFile(contents) close(fd); return NULL; } - lseek(fd, (off_t) 0, SEEK_SET); + lseek(fd, 0, SEEK_SET); } return MakeFile(fd); } |