summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog49
-rw-r--r--compat/dirent2.h10
-rw-r--r--compat/dlfcn.h19
-rw-r--r--compat/stdlib.h51
-rw-r--r--compat/string.h74
-rw-r--r--compat/unistd.h112
-rw-r--r--doc/InitStubs.34
-rw-r--r--doc/string.n31
-rw-r--r--generic/tcl.decls3
-rw-r--r--generic/tclDecls.h162
-rw-r--r--generic/tclExecute.c6
-rw-r--r--generic/tclIntDecls.h52
-rw-r--r--generic/tclListObj.c17
-rw-r--r--generic/tclStubInit.c52
-rw-r--r--generic/tclStubLib.c33
-rw-r--r--generic/tclTestObj.c11
-rw-r--r--generic/tclThreadTest.c17
-rw-r--r--generic/tclTomMathInterface.c6
-rw-r--r--generic/tclUtil.c4
-rw-r--r--library/http/http.tcl4
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--tests/listObj.test4
-rw-r--r--unix/Makefile.in4
-rw-r--r--unix/dltest/pkgb.c25
-rw-r--r--win/Makefile.in4
-rw-r--r--win/tclWinFile.c11
26 files changed, 531 insertions, 236 deletions
diff --git a/ChangeLog b/ChangeLog
index a9b9d57..5e6f47b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,52 @@
+2013-01-13 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclIntDecls.h: If TCL_NO_DEPRECATED is defined, make
+ sure that TIP #139 functions all are taken from the public stub
+ table, even if the inclusion is through tclInt.h.
+
+2013-01-09 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * library/http/http.tcl: [Bug 3599395]: http assumes status line
+ is a proper tcl list.
+ Bump http package to 2.7.11.
+
+2013-01-08 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * win/tclWinFile.c: [Bug 3092089]: [file normalize] can remove path
+ components. [Bug 3587096] win vista/7: "can't find init.tcl" when
+ called via junction without folder list access.
+
+2013-01-07 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tcl.decls: Extend the public stub table with dummy NULL
+ entries, up to the size of the Tcl 8.6 stub tables. This makes it
+ easier to debug extensions which use Tcl 8.6 features but (erroneously)
+ are attempted to be loaded in Tcl 8.5.
+
+2013-01-02 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclEnsemble.c: Remove stray calls to Tcl_Alloc and
+ * generic/tclExecute.c: friends: the core should only use ckalloc
+ * generic/tclIORTrans.c: to allow MEM_DEBUG to work properly
+ * generic/tclTomMathInterface.c:
+
+2012-12-31 Donal K. Fellows <dkf@users.sf.net>
+
+ * doc/string.n: Noted the obsolescence of the 'bytelength',
+ 'wordstart' and 'wordend' subcommands, and moved them to later in the
+ file.
+
+2012-12-27 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * generic/tclListObj.c: [Bug 3598580]: Tcl_ListObjReplace may release
+ deleted elements too early
+
+2012-12-21 Jan Nijtmans <nijtmans@users.sf.net>
+
+ * unix/dltest/pkgb.c: Make pkgb.so loadable in Tcl 8.4 as well.
+ * generic/tclStubLib.c: Eliminate unnessarcy static HasStubSupport() and
+ isDigit() functions, just do the same inline.
+
2012-12-13 Jan Nijtmans <nijtmans@users.sf.net>
* generic/tcl.h: Fix Tcl_DecrRefCount macro such that it
diff --git a/compat/dirent2.h b/compat/dirent2.h
index c00d2f4..5be08ba 100644
--- a/compat/dirent2.h
+++ b/compat/dirent2.h
@@ -14,10 +14,6 @@
#ifndef _DIRENT
#define _DIRENT
-#ifndef _TCL
-#include <tcl.h>
-#endif
-
/*
* Dirent structure, which holds information about a single
* directory entry.
@@ -50,8 +46,8 @@ typedef struct _dirdesc {
* Procedures defined for reading directories:
*/
-extern void closedir _ANSI_ARGS_((DIR *dirp));
-extern DIR * opendir _ANSI_ARGS_((char *name));
-extern struct dirent * readdir _ANSI_ARGS_((DIR *dirp));
+extern void closedir (DIR *dirp);
+extern DIR * opendir (char *name);
+extern struct dirent * readdir (DIR *dirp);
#endif /* _DIRENT */
diff --git a/compat/dlfcn.h b/compat/dlfcn.h
index 1a6a118..fb27ea0 100644
--- a/compat/dlfcn.h
+++ b/compat/dlfcn.h
@@ -1,4 +1,4 @@
-/*
+/*
* dlfcn.h --
*
* This file provides a replacement for the header file "dlfcn.h"
@@ -19,7 +19,6 @@
*/
/*
- * @(#)dlfcn.h 1.4 revision of 95/04/25 09:36:52
* This is an unpublished work copyright (c) 1992 HELIOS Software GmbH
* 30159 Hannover, Germany
*/
@@ -27,10 +26,6 @@
#ifndef __dlfcn_h__
#define __dlfcn_h__
-#ifndef _TCL
-#include <tcl.h>
-#endif
-
#ifdef __cplusplus
extern "C" {
#endif
@@ -47,14 +42,14 @@ extern "C" {
* that contains functions to be called to initialize and terminate.
*/
struct dl_info {
- void (*init) _ANSI_ARGS_((void));
- void (*fini) _ANSI_ARGS_((void));
+ void (*init) (void);
+ void (*fini) (void);
};
-VOID *dlopen _ANSI_ARGS_((const char *path, int mode));
-VOID *dlsym _ANSI_ARGS_((void *handle, const char *symbol));
-char *dlerror _ANSI_ARGS_((void));
-int dlclose _ANSI_ARGS_((void *handle));
+void *dlopen (const char *path, int mode);
+void *dlsym (void *handle, const char *symbol);
+char *dlerror (void);
+int dlclose (void *handle);
#ifdef __cplusplus
}
diff --git a/compat/stdlib.h b/compat/stdlib.h
index 4d1a386..0ad4c1d 100644
--- a/compat/stdlib.h
+++ b/compat/stdlib.h
@@ -1,43 +1,36 @@
/*
* stdlib.h --
*
- * Declares facilities exported by the "stdlib" portion of
- * the C library. This file isn't complete in the ANSI-C
- * sense; it only declares things that are needed by Tcl.
- * This file is needed even on many systems with their own
- * stdlib.h (e.g. SunOS) because not all stdlib.h files
- * declare all the procedures needed here (such as strtod).
+ * Declares facilities exported by the "stdlib" portion of the C library.
+ * This file isn't complete in the ANSI-C sense; it only declares things
+ * that are needed by Tcl. This file is needed even on many systems with
+ * their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare
+ * all the procedures needed here (such as strtod).
*
* Copyright (c) 1991 The Regents of the University of California.
* Copyright (c) 1994-1998 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _STDLIB
#define _STDLIB
-#include <tcl.h>
-
-extern void abort _ANSI_ARGS_((void));
-extern double atof _ANSI_ARGS_((CONST char *string));
-extern int atoi _ANSI_ARGS_((CONST char *string));
-extern long atol _ANSI_ARGS_((CONST char *string));
-extern char * calloc _ANSI_ARGS_((unsigned int numElements,
- unsigned int size));
-extern void exit _ANSI_ARGS_((int status));
-extern int free _ANSI_ARGS_((char *blockPtr));
-extern char * getenv _ANSI_ARGS_((CONST char *name));
-extern char * malloc _ANSI_ARGS_((unsigned int numBytes));
-extern void qsort _ANSI_ARGS_((VOID *base, int n, int size,
- int (*compar)(CONST VOID *element1, CONST VOID
- *element2)));
-extern char * realloc _ANSI_ARGS_((char *ptr, unsigned int numBytes));
-extern double strtod _ANSI_ARGS_((CONST char *string, char **endPtr));
-extern long strtol _ANSI_ARGS_((CONST char *string, char **endPtr,
- int base));
-extern unsigned long strtoul _ANSI_ARGS_((CONST char *string,
- char **endPtr, int base));
+extern void abort(void);
+extern double atof(const char *string);
+extern int atoi(const char *string);
+extern long atol(const char *string);
+extern char * calloc(unsigned int numElements, unsigned int size);
+extern void exit(int status);
+extern int free(char *blockPtr);
+extern char * getenv(const char *name);
+extern char * malloc(unsigned int numBytes);
+extern void qsort(void *base, int n, int size, int (*compar)(
+ const void *element1, const void *element2));
+extern char * realloc(char *ptr, unsigned int numBytes);
+extern double strtod(const char *string, char **endPtr);
+extern long strtol(const char *string, char **endPtr, int base);
+extern unsigned long strtoul(const char *string, char **endPtr, int base);
#endif /* _STDLIB */
diff --git a/compat/string.h b/compat/string.h
index 4eb2b86..42be10c 100644
--- a/compat/string.h
+++ b/compat/string.h
@@ -6,66 +6,52 @@
* Copyright (c) 1991-1993 The Regents of the University of California.
* Copyright (c) 1994-1996 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#ifndef _STRING
#define _STRING
-#include <tcl.h>
-
/*
- * The following #include is needed to define size_t. (This used to
- * include sys/stdtypes.h but that doesn't exist on older versions
- * of SunOS, e.g. 4.0.2, so I'm trying sys/types.h now.... hopefully
- * it exists everywhere)
+ * The following #include is needed to define size_t. (This used to include
+ * sys/stdtypes.h but that doesn't exist on older versions of SunOS, e.g.
+ * 4.0.2, so I'm trying sys/types.h now.... hopefully it exists everywhere)
*/
#include <sys/types.h>
#ifdef __APPLE__
-extern VOID * memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n));
+extern void * memchr(const void *s, int c, size_t n);
#else
-extern char * memchr _ANSI_ARGS_((CONST VOID *s, int c, size_t n));
+extern char * memchr(const void *s, int c, size_t n);
#endif
-extern int memcmp _ANSI_ARGS_((CONST VOID *s1, CONST VOID *s2,
- size_t n));
-extern char * memcpy _ANSI_ARGS_((VOID *t, CONST VOID *f, size_t n));
+extern int memcmp(const void *s1, const void *s2, size_t n);
+extern char * memcpy(void *t, const void *f, size_t n);
#ifdef NO_MEMMOVE
-#define memmove(d, s, n) bcopy ((s), (d), (n))
+#define memmove(d,s,n) (bcopy((s), (d), (n)))
#else
-extern char * memmove _ANSI_ARGS_((VOID *t, CONST VOID *f,
- size_t n));
+extern char * memmove(void *t, const void *f, size_t n);
#endif
-extern char * memset _ANSI_ARGS_((VOID *s, int c, size_t n));
+extern char * memset(void *s, int c, size_t n);
-extern int strcasecmp _ANSI_ARGS_((CONST char *s1,
- CONST char *s2));
-extern char * strcat _ANSI_ARGS_((char *dst, CONST char *src));
-extern char * strchr _ANSI_ARGS_((CONST char *string, int c));
-extern int strcmp _ANSI_ARGS_((CONST char *s1, CONST char *s2));
-extern char * strcpy _ANSI_ARGS_((char *dst, CONST char *src));
-extern size_t strcspn _ANSI_ARGS_((CONST char *string,
- CONST char *chars));
-extern char * strdup _ANSI_ARGS_((CONST char *string));
-extern char * strerror _ANSI_ARGS_((int error));
-extern size_t strlen _ANSI_ARGS_((CONST char *string));
-extern int strncasecmp _ANSI_ARGS_((CONST char *s1,
- CONST char *s2, size_t n));
-extern char * strncat _ANSI_ARGS_((char *dst, CONST char *src,
- size_t numChars));
-extern int strncmp _ANSI_ARGS_((CONST char *s1, CONST char *s2,
- size_t nChars));
-extern char * strncpy _ANSI_ARGS_((char *dst, CONST char *src,
- size_t numChars));
-extern char * strpbrk _ANSI_ARGS_((CONST char *string,
- CONST char *chars));
-extern char * strrchr _ANSI_ARGS_((CONST char *string, int c));
-extern size_t strspn _ANSI_ARGS_((CONST char *string,
- CONST char *chars));
-extern char * strstr _ANSI_ARGS_((CONST char *string,
- CONST char *substring));
-extern char * strtok _ANSI_ARGS_((char *s, CONST char *delim));
+extern int strcasecmp(const char *s1, const char *s2);
+extern char * strcat(char *dst, const char *src);
+extern char * strchr(const char *string, int c);
+extern int strcmp(const char *s1, const char *s2);
+extern char * strcpy(char *dst, const char *src);
+extern size_t strcspn(const char *string, const char *chars);
+extern char * strdup(const char *string);
+extern char * strerror(int error);
+extern size_t strlen(const char *string);
+extern int strncasecmp(const char *s1, const char *s2, size_t n);
+extern char * strncat(char *dst, const char *src, size_t numChars);
+extern int strncmp(const char *s1, const char *s2, size_t nChars);
+extern char * strncpy(char *dst, const char *src, size_t numChars);
+extern char * strpbrk(const char *string, const char *chars);
+extern char * strrchr(const char *string, int c);
+extern size_t strspn(const char *string, const char *chars);
+extern char * strstr(const char *string, const char *substring);
+extern char * strtok(char *s, const char *delim);
#endif /* _STRING */
diff --git a/compat/unistd.h b/compat/unistd.h
index 1a40e90..2de5bd0 100644
--- a/compat/unistd.h
+++ b/compat/unistd.h
@@ -1,82 +1,76 @@
/*
* unistd.h --
*
- * Macros, CONSTants and prototypes for Posix conformance.
+ * Macros, constants and prototypes for Posix conformance.
*
- * Copyright 1989 Regents of the University of California
- * Permission to use, copy, modify, and distribute this
- * software and its documentation for any purpose and without
- * fee is hereby granted, provided that the above copyright
- * notice appear in all copies. The University of California
- * makes no representations about the suitability of this
- * software for any purpose. It is provided "as is" without
- * express or implied warranty.
+ * Copyright 1989 Regents of the University of California Permission to use,
+ * copy, modify, and distribute this software and its documentation for any
+ * purpose and without fee is hereby granted, provided that the above
+ * copyright notice appear in all copies. The University of California makes
+ * no representations about the suitability of this software for any purpose.
+ * It is provided "as is" without express or implied warranty.
*/
#ifndef _UNISTD
#define _UNISTD
#include <sys/types.h>
-#ifndef _TCL
-# include "tcl.h"
-#endif
#ifndef NULL
#define NULL 0
#endif
/*
- * Strict POSIX stuff goes here. Extensions go down below, in the
- * ifndef _POSIX_SOURCE section.
+ * Strict POSIX stuff goes here. Extensions go down below, in the ifndef
+ * _POSIX_SOURCE section.
*/
-extern void _exit _ANSI_ARGS_((int status));
-extern int access _ANSI_ARGS_((CONST char *path, int mode));
-extern int chdir _ANSI_ARGS_((CONST char *path));
-extern int chown _ANSI_ARGS_((CONST char *path, uid_t owner, gid_t group));
-extern int close _ANSI_ARGS_((int fd));
-extern int dup _ANSI_ARGS_((int oldfd));
-extern int dup2 _ANSI_ARGS_((int oldfd, int newfd));
-extern int execl _ANSI_ARGS_((CONST char *path, ...));
-extern int execle _ANSI_ARGS_((CONST char *path, ...));
-extern int execlp _ANSI_ARGS_((CONST char *file, ...));
-extern int execv _ANSI_ARGS_((CONST char *path, char **argv));
-extern int execve _ANSI_ARGS_((CONST char *path, char **argv, char **envp));
-extern int execvp _ANSI_ARGS_((CONST char *file, char **argv));
-extern pid_t fork _ANSI_ARGS_((void));
-extern char *getcwd _ANSI_ARGS_((char *buf, size_t size));
-extern gid_t getegid _ANSI_ARGS_((void));
-extern uid_t geteuid _ANSI_ARGS_((void));
-extern gid_t getgid _ANSI_ARGS_((void));
-extern int getgroups _ANSI_ARGS_((int bufSize, int *buffer));
-extern pid_t getpid _ANSI_ARGS_((void));
-extern uid_t getuid _ANSI_ARGS_((void));
-extern int isatty _ANSI_ARGS_((int fd));
-extern long lseek _ANSI_ARGS_((int fd, long offset, int whence));
-extern int pipe _ANSI_ARGS_((int *fildes));
-extern int read _ANSI_ARGS_((int fd, char *buf, size_t size));
-extern int setgid _ANSI_ARGS_((gid_t group));
-extern int setuid _ANSI_ARGS_((uid_t user));
-extern unsigned sleep _ANSI_ARGS_ ((unsigned seconds));
-extern char *ttyname _ANSI_ARGS_((int fd));
-extern int unlink _ANSI_ARGS_((CONST char *path));
-extern int write _ANSI_ARGS_((int fd, CONST char *buf, size_t size));
+extern void _exit(int status);
+extern int access(const char *path, int mode);
+extern int chdir(const char *path);
+extern int chown(const char *path, uid_t owner, gid_t group);
+extern int close(int fd);
+extern int dup(int oldfd);
+extern int dup2(int oldfd, int newfd);
+extern int execl(const char *path, ...);
+extern int execle(const char *path, ...);
+extern int execlp(const char *file, ...);
+extern int execv(const char *path, char **argv);
+extern int execve(const char *path, char **argv, char **envp);
+extern int execvpw(const char *file, char **argv);
+extern pid_t fork(void);
+extern char * getcwd(char *buf, size_t size);
+extern gid_t getegid(void);
+extern uid_t geteuid(void);
+extern gid_t getgid(void);
+extern int getgroups(int bufSize, int *buffer);
+extern pid_t getpid(void);
+extern uid_t getuid(void);
+extern int isatty(int fd);
+extern long lseek(int fd, long offset, int whence);
+extern int pipe(int *fildes);
+extern int read(int fd, char *buf, size_t size);
+extern int setgid(gid_t group);
+extern int setuid(uid_t user);
+extern unsigned sleep(unsigned seconds);
+extern char * ttyname(int fd);
+extern int unlink(const char *path);
+extern int write(int fd, const char *buf, size_t size);
#ifndef _POSIX_SOURCE
-extern char *crypt _ANSI_ARGS_((CONST char *, CONST char *));
-extern int fchown _ANSI_ARGS_((int fd, uid_t owner, gid_t group));
-extern int flock _ANSI_ARGS_((int fd, int operation));
-extern int ftruncate _ANSI_ARGS_((int fd, unsigned long length));
-extern int ioctl _ANSI_ARGS_((int fd, int request, ...));
-extern int readlink _ANSI_ARGS_((CONST char *path, char *buf, int bufsize));
-extern int setegid _ANSI_ARGS_((gid_t group));
-extern int seteuid _ANSI_ARGS_((uid_t user));
-extern int setreuid _ANSI_ARGS_((int ruid, int euid));
-extern int symlink _ANSI_ARGS_((CONST char *, CONST char *));
-extern int ttyslot _ANSI_ARGS_((void));
-extern int truncate _ANSI_ARGS_((CONST char *path, unsigned long length));
-extern int vfork _ANSI_ARGS_((void));
+extern char * crypt(const char *, const char *);
+extern int fchown(int fd, uid_t owner, gid_t group);
+extern int flock(int fd, int operation);
+extern int ftruncate(int fd, unsigned long length);
+extern int ioctl(int fd, int request, ...);
+extern int readlink(const char *path, char *buf, int bufsize);
+extern int setegid(gid_t group);
+extern int seteuidw(uid_t user);
+extern int setreuid(int ruid, int euid);
+extern int symlink(const char *, const char *);
+extern int ttyslot(void);
+extern int truncate(const char *path, unsigned long length);
+extern int vfork(void);
#endif /* _POSIX_SOURCE */
#endif /* _UNISTD */
-
diff --git a/doc/InitStubs.3 b/doc/InitStubs.3
index 318c564..fe10a59 100644
--- a/doc/InitStubs.3
+++ b/doc/InitStubs.3
@@ -64,8 +64,8 @@ Define the \fBUSE_TCL_STUBS\fR symbol. Typically, you would include the
.IP 3) 5
Link the extension with the Tcl stubs library instead of the standard
Tcl library. On Unix platforms, the library name is
-\fIlibtclstub8.1.a\fR; on Windows platforms, the library name is
-\fItclstub81.lib\fR.
+\fIlibtclstub8.5.a\fR; on Windows platforms, the library name is
+\fItclstub85.lib\fR.
.PP
If the extension also requires the Tk API, it must also call
\fBTk_InitStubs\fR to initialize the Tk stubs interface and link
diff --git a/doc/string.n b/doc/string.n
index dfb5a90..e74b8a2 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -20,16 +20,6 @@ string \- Manipulate strings
Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
.TP
-\fBstring bytelength \fIstring\fR
-Returns a decimal string giving the number of bytes used to represent
-\fIstring\fR in memory. Because UTF\-8 uses one to three bytes to
-represent Unicode characters, the byte length will not be the same as
-the character length in general. The cases where a script cares about
-the byte length are rare. In almost all cases, you should use the
-\fBstring length\fR operation (including determining the length of a
-Tcl ByteArray object). Refer to the \fBTcl_NumUtfChars\fR manual
-entry for more details on the UTF\-8 representation.
-.TP
\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length int\fR? \fIstring1 string2\fR
Perform a character-by-character comparison of strings \fIstring1\fR
and \fIstring2\fR. Returns \-1, 0, or 1, depending on whether
@@ -128,7 +118,7 @@ empty string returns 0, otherwise an empty string will return 1 on
any class. If \fB\-failindex\fR is specified, then if the function
returns 0, the index in the string where the class was no longer valid
will be stored in the variable named \fIvarname\fR. The \fIvarname\fR
-will not be set if the function returns 1. The following character
+will not be set if \fBstring is\fR returns 1. The following character
classes are recognized (the class name can be abbreviated):
.RS
.IP \fBalnum\fR 12
@@ -355,6 +345,21 @@ Returns a value equal to \fIstring\fR except that any trailing
characters present in the string given by \fIchars\fR are removed. If
\fIchars\fR is not specified then white space is removed (spaces,
tabs, newlines, and carriage returns).
+.SH "OBSOLETE SUBCOMMANDS"
+.PP
+These subcommands are currently supported, but are likely to go away in a
+future release as their functionality is either virtually never used or highly
+misleading.
+.TP
+\fBstring bytelength \fIstring\fR
+Returns a decimal string giving the number of bytes used to represent
+\fIstring\fR in memory. Because UTF\-8 uses one to three bytes to
+represent Unicode characters, the byte length will not be the same as
+the character length in general. The cases where a script cares about
+the byte length are rare. In almost all cases, you should use the
+\fBstring length\fR operation (including determining the length of a
+Tcl ByteArray object). Refer to the \fBTcl_NumUtfChars\fR manual
+entry for more details on the UTF\-8 representation.
.TP
\fBstring wordend \fIstring charIndex\fR
Returns the index of the character just after the last one in the word
@@ -377,9 +382,9 @@ prefix of the string \fBfoobar\fR.
.CS
set length [\fBstring length\fR $string]
if {$length == 0} {
- set isPrefix 0
+ set isPrefix 0
} else {
- set isPrefix [\fBstring equal\fR -length $length $string "foobar"]
+ set isPrefix [\fBstring equal\fR -length $length $string "foobar"]
}
.CE
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 256701d..7f49002 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -2108,6 +2108,9 @@ declare 578 {
declare 579 {
void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr, const char *format, ...)
}
+declare 630 {
+ void TclUnusedStubEntry(void)
+}
##############################################################################
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 4225c96..8cb939c 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -3408,6 +3408,61 @@ EXTERN Tcl_Obj * Tcl_ObjPrintf(CONST char *format, ...);
EXTERN void Tcl_AppendPrintfToObj(Tcl_Obj *objPtr,
CONST char *format, ...);
#endif
+/* Slot 580 is reserved */
+/* Slot 581 is reserved */
+/* Slot 582 is reserved */
+/* Slot 583 is reserved */
+/* Slot 584 is reserved */
+/* Slot 585 is reserved */
+/* Slot 586 is reserved */
+/* Slot 587 is reserved */
+/* Slot 588 is reserved */
+/* Slot 589 is reserved */
+/* Slot 590 is reserved */
+/* Slot 591 is reserved */
+/* Slot 592 is reserved */
+/* Slot 593 is reserved */
+/* Slot 594 is reserved */
+/* Slot 595 is reserved */
+/* Slot 596 is reserved */
+/* Slot 597 is reserved */
+/* Slot 598 is reserved */
+/* Slot 599 is reserved */
+/* Slot 600 is reserved */
+/* Slot 601 is reserved */
+/* Slot 602 is reserved */
+/* Slot 603 is reserved */
+/* Slot 604 is reserved */
+/* Slot 605 is reserved */
+/* Slot 606 is reserved */
+/* Slot 607 is reserved */
+/* Slot 608 is reserved */
+/* Slot 609 is reserved */
+/* Slot 610 is reserved */
+/* Slot 611 is reserved */
+/* Slot 612 is reserved */
+/* Slot 613 is reserved */
+/* Slot 614 is reserved */
+/* Slot 615 is reserved */
+/* Slot 616 is reserved */
+/* Slot 617 is reserved */
+/* Slot 618 is reserved */
+/* Slot 619 is reserved */
+/* Slot 620 is reserved */
+/* Slot 621 is reserved */
+/* Slot 622 is reserved */
+/* Slot 623 is reserved */
+/* Slot 624 is reserved */
+/* Slot 625 is reserved */
+/* Slot 626 is reserved */
+/* Slot 627 is reserved */
+/* Slot 628 is reserved */
+/* Slot 629 is reserved */
+#ifndef TclUnusedStubEntry_TCL_DECLARED
+#define TclUnusedStubEntry_TCL_DECLARED
+/* 630 */
+EXTERN void TclUnusedStubEntry(void);
+#endif
typedef struct TclStubHooks {
struct TclPlatStubs *tclPlatStubs;
@@ -4023,6 +4078,57 @@ typedef struct TclStubs {
int (*tcl_AppendFormatToObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, int objc, Tcl_Obj *CONST objv[]); /* 577 */
Tcl_Obj * (*tcl_ObjPrintf) (CONST char *format, ...); /* 578 */
void (*tcl_AppendPrintfToObj) (Tcl_Obj *objPtr, CONST char *format, ...); /* 579 */
+ VOID *reserved580;
+ VOID *reserved581;
+ VOID *reserved582;
+ VOID *reserved583;
+ VOID *reserved584;
+ VOID *reserved585;
+ VOID *reserved586;
+ VOID *reserved587;
+ VOID *reserved588;
+ VOID *reserved589;
+ VOID *reserved590;
+ VOID *reserved591;
+ VOID *reserved592;
+ VOID *reserved593;
+ VOID *reserved594;
+ VOID *reserved595;
+ VOID *reserved596;
+ VOID *reserved597;
+ VOID *reserved598;
+ VOID *reserved599;
+ VOID *reserved600;
+ VOID *reserved601;
+ VOID *reserved602;
+ VOID *reserved603;
+ VOID *reserved604;
+ VOID *reserved605;
+ VOID *reserved606;
+ VOID *reserved607;
+ VOID *reserved608;
+ VOID *reserved609;
+ VOID *reserved610;
+ VOID *reserved611;
+ VOID *reserved612;
+ VOID *reserved613;
+ VOID *reserved614;
+ VOID *reserved615;
+ VOID *reserved616;
+ VOID *reserved617;
+ VOID *reserved618;
+ VOID *reserved619;
+ VOID *reserved620;
+ VOID *reserved621;
+ VOID *reserved622;
+ VOID *reserved623;
+ VOID *reserved624;
+ VOID *reserved625;
+ VOID *reserved626;
+ VOID *reserved627;
+ VOID *reserved628;
+ VOID *reserved629;
+ void (*tclUnusedStubEntry) (void); /* 630 */
} TclStubs;
#ifdef __cplusplus
@@ -6377,11 +6483,67 @@ extern TclStubs *tclStubsPtr;
#define Tcl_AppendPrintfToObj \
(tclStubsPtr->tcl_AppendPrintfToObj) /* 579 */
#endif
+/* Slot 580 is reserved */
+/* Slot 581 is reserved */
+/* Slot 582 is reserved */
+/* Slot 583 is reserved */
+/* Slot 584 is reserved */
+/* Slot 585 is reserved */
+/* Slot 586 is reserved */
+/* Slot 587 is reserved */
+/* Slot 588 is reserved */
+/* Slot 589 is reserved */
+/* Slot 590 is reserved */
+/* Slot 591 is reserved */
+/* Slot 592 is reserved */
+/* Slot 593 is reserved */
+/* Slot 594 is reserved */
+/* Slot 595 is reserved */
+/* Slot 596 is reserved */
+/* Slot 597 is reserved */
+/* Slot 598 is reserved */
+/* Slot 599 is reserved */
+/* Slot 600 is reserved */
+/* Slot 601 is reserved */
+/* Slot 602 is reserved */
+/* Slot 603 is reserved */
+/* Slot 604 is reserved */
+/* Slot 605 is reserved */
+/* Slot 606 is reserved */
+/* Slot 607 is reserved */
+/* Slot 608 is reserved */
+/* Slot 609 is reserved */
+/* Slot 610 is reserved */
+/* Slot 611 is reserved */
+/* Slot 612 is reserved */
+/* Slot 613 is reserved */
+/* Slot 614 is reserved */
+/* Slot 615 is reserved */
+/* Slot 616 is reserved */
+/* Slot 617 is reserved */
+/* Slot 618 is reserved */
+/* Slot 619 is reserved */
+/* Slot 620 is reserved */
+/* Slot 621 is reserved */
+/* Slot 622 is reserved */
+/* Slot 623 is reserved */
+/* Slot 624 is reserved */
+/* Slot 625 is reserved */
+/* Slot 626 is reserved */
+/* Slot 627 is reserved */
+/* Slot 628 is reserved */
+/* Slot 629 is reserved */
+#ifndef TclUnusedStubEntry
+#define TclUnusedStubEntry \
+ (tclStubsPtr->tclUnusedStubEntry) /* 630 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
/* !END!: Do not edit above this line. */
+#undef TclUnusedStubEntry
+
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f2efa0f..229d7c6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -1063,7 +1063,7 @@ TclStackFree(
Tcl_Obj **markerPtr;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- Tcl_Free((char *) freePtr);
+ ckfree((char *) freePtr);
return;
}
@@ -1112,7 +1112,7 @@ TclStackAlloc(
int numWords = (numBytes + (sizeof(Tcl_Obj *) - 1))/sizeof(Tcl_Obj *);
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- return (void *) Tcl_Alloc(numBytes);
+ return (void *) ckalloc(numBytes);
}
return (void *) StackAllocWords(interp, numWords);
@@ -1131,7 +1131,7 @@ TclStackRealloc(
int numWords;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- return (void *) Tcl_Realloc((char *) ptr, numBytes);
+ return (void *) ckrealloc((char *) ptr, numBytes);
}
eePtr = iPtr->execEnvPtr;
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 3ccc50a..1dc797a 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -29,19 +29,18 @@
#endif
/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */
-#undef Tcl_AppendExportList
#undef Tcl_CreateNamespace
#undef Tcl_DeleteNamespace
+#undef Tcl_AppendExportList
#undef Tcl_Export
-#undef Tcl_FindCommand
-#undef Tcl_FindNamespace
-#undef Tcl_FindNamespaceVar
+#undef Tcl_Import
#undef Tcl_ForgetImport
-#undef Tcl_GetCommandFromObj
-#undef Tcl_GetCommandFullName
#undef Tcl_GetCurrentNamespace
#undef Tcl_GetGlobalNamespace
-#undef Tcl_Import
+#undef Tcl_FindNamespace
+#undef Tcl_FindCommand
+#undef Tcl_GetCommandFromObj
+#undef Tcl_GetCommandFullName
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
@@ -2053,4 +2052,43 @@ extern TclIntStubs *tclIntStubsPtr;
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
+#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
+# undef Tcl_CreateNamespace
+# define Tcl_CreateNamespace \
+ (tclStubsPtr->tcl_CreateNamespace) /* 506 */
+# undef Tcl_DeleteNamespace
+# define Tcl_DeleteNamespace \
+ (tclStubsPtr->tcl_DeleteNamespace) /* 507 */
+# undef Tcl_AppendExportList
+# define Tcl_AppendExportList \
+ (tclStubsPtr->tcl_AppendExportList) /* 508 */
+# undef Tcl_Export
+# define Tcl_Export \
+ (tclStubsPtr->tcl_Export) /* 509 */
+# undef Tcl_Import
+# define Tcl_Import \
+ (tclStubsPtr->tcl_Import) /* 510 */
+# undef Tcl_ForgetImport
+# define Tcl_ForgetImport \
+ (tclStubsPtr->tcl_ForgetImport) /* 511 */
+# undef Tcl_GetCurrentNamespace
+# define Tcl_GetCurrentNamespace \
+ (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
+# undef Tcl_GetGlobalNamespace
+# define Tcl_GetGlobalNamespace \
+ (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
+# undef Tcl_FindNamespace
+# define Tcl_FindNamespace \
+ (tclStubsPtr->tcl_FindNamespace) /* 514 */
+# undef Tcl_FindCommand
+# define Tcl_FindCommand \
+ (tclStubsPtr->tcl_FindCommand) /* 515 */
+# undef Tcl_GetCommandFromObj
+# define Tcl_GetCommandFromObj \
+ (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
+# undef Tcl_GetCommandFullName
+# define Tcl_GetCommandFullName \
+ (tclStubsPtr->tcl_GetCommandFullName) /* 517 */
+#endif
+
#endif /* _TCLINTDECLS */
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 17aa256..20b6ec1 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -857,6 +857,10 @@ Tcl_ListObjReplace(
isShared = (listRepPtr->refCount > 1);
numRequired = numElems - count + objc;
+ for (i = 0; i < objc; i++) {
+ Tcl_IncrRefCount(objv[i]);
+ }
+
if ((numRequired <= listRepPtr->maxElemCount) && !isShared) {
int shift;
@@ -902,6 +906,14 @@ Tcl_ListObjReplace(
listRepPtr = AttemptNewList(interp, newMax, NULL);
if (listRepPtr == NULL) {
+ for (i = 0; i < objc; i++) {
+ /* See bug 3598580 */
+#if TCL_MAJOR_VERSION > 8
+ Tcl_DecrRefCount(objv[i]);
+#else
+ objv[i]->refCount--;
+#endif
+ }
return TCL_ERROR;
}
@@ -964,14 +976,11 @@ Tcl_ListObjReplace(
}
/*
- * Insert the new elements into elemPtrs before "first". We don't do a
- * memcpy here because we must increment the reference counts for the
- * added elements, so we must explicitly loop anyway.
+ * Insert the new elements into elemPtrs before "first".
*/
for (i=0,j=first ; i<objc ; i++,j++) {
elemPtrs[j] = objv[i];
- Tcl_IncrRefCount(objv[i]);
}
/*
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index d06e174..fd4a222 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -33,6 +33,7 @@
#undef Tcl_CreateHashEntry
#undef TclpGetPid
#undef TclSockMinimumBuffers
+#define TclUnusedStubEntry NULL
/*
* Keep a record of the original Notifier procedures, created in the
@@ -1254,6 +1255,57 @@ TclStubs tclStubs = {
Tcl_AppendFormatToObj, /* 577 */
Tcl_ObjPrintf, /* 578 */
Tcl_AppendPrintfToObj, /* 579 */
+ NULL, /* 580 */
+ NULL, /* 581 */
+ NULL, /* 582 */
+ NULL, /* 583 */
+ NULL, /* 584 */
+ NULL, /* 585 */
+ NULL, /* 586 */
+ NULL, /* 587 */
+ NULL, /* 588 */
+ NULL, /* 589 */
+ NULL, /* 590 */
+ NULL, /* 591 */
+ NULL, /* 592 */
+ NULL, /* 593 */
+ NULL, /* 594 */
+ NULL, /* 595 */
+ NULL, /* 596 */
+ NULL, /* 597 */
+ NULL, /* 598 */
+ NULL, /* 599 */
+ NULL, /* 600 */
+ NULL, /* 601 */
+ NULL, /* 602 */
+ NULL, /* 603 */
+ NULL, /* 604 */
+ NULL, /* 605 */
+ NULL, /* 606 */
+ NULL, /* 607 */
+ NULL, /* 608 */
+ NULL, /* 609 */
+ NULL, /* 610 */
+ NULL, /* 611 */
+ NULL, /* 612 */
+ NULL, /* 613 */
+ NULL, /* 614 */
+ NULL, /* 615 */
+ NULL, /* 616 */
+ NULL, /* 617 */
+ NULL, /* 618 */
+ NULL, /* 619 */
+ NULL, /* 620 */
+ NULL, /* 621 */
+ NULL, /* 622 */
+ NULL, /* 623 */
+ NULL, /* 624 */
+ NULL, /* 625 */
+ NULL, /* 626 */
+ NULL, /* 627 */
+ NULL, /* 628 */
+ NULL, /* 629 */
+ TclUnusedStubEntry, /* 630 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index c98956e..31fc865 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -19,28 +19,11 @@ TclIntStubs *tclIntStubsPtr = NULL;
TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
TclTomMathStubs* tclTomMathStubsPtr = NULL;
-static TclStubs *
-HasStubSupport(
- Tcl_Interp *interp)
-{
- Interp *iPtr = (Interp *) interp;
-
- if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
- return iPtr->stubTable;
- }
- interp->result = "interpreter uses an incompatible stubs mechanism";
- interp->freeProc = TCL_STATIC;
- return NULL;
-}
-
/*
- * Use our own isdigit to avoid linking to libc on windows
+ * Use our own ISDIGIT to avoid linking to libc on windows
*/
-static int isDigit(const int c)
-{
- return (c >= '0' && c <= '9');
-}
+#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9)
/*
*----------------------------------------------------------------------
@@ -66,9 +49,10 @@ Tcl_InitStubs(
CONST char *version,
int exact)
{
+ Interp *iPtr = (Interp *) interp;
CONST char *actualVersion = NULL;
ClientData pkgData = NULL;
- TclStubs *stubsPtr;
+ TclStubs *stubsPtr = iPtr->stubTable;
/*
* We can't optimize this check by caching tclStubsPtr because that
@@ -76,8 +60,9 @@ Tcl_InitStubs(
* times. [Bug 615304]
*/
- stubsPtr = HasStubSupport(interp);
- if (!stubsPtr) {
+ if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
+ iPtr->result = "interpreter uses an incompatible stubs mechanism";
+ iPtr->freeProc = TCL_STATIC;
return NULL;
}
@@ -90,7 +75,7 @@ Tcl_InitStubs(
int count = 0;
while (*p) {
- count += !isDigit(*p++);
+ count += !ISDIGIT(*p++);
}
if (count == 1) {
CONST char *q = actualVersion;
@@ -99,7 +84,7 @@ Tcl_InitStubs(
while (*p && (*p == *q)) {
p++; q++;
}
- if (*p || isDigit(*q)) {
+ if (*p || ISDIGIT(*q)) {
/* Construct error message */
stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
return NULL;
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 37286e3..8597bbc 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -925,6 +925,17 @@ TestobjCmd(
}
SetVarToObj(destIndex, varPtr[varIndex]);
Tcl_SetObjResult(interp, varPtr[destIndex]);
+ } else if (strcmp(subCmd, "bug3598580") == 0) {
+ Tcl_Obj *listObjPtr, *elemObjPtr;
+ if (objc != 2) {
+ goto wrongNumArgs;
+ }
+ elemObjPtr = Tcl_NewIntObj(123);
+ listObjPtr = Tcl_NewListObj(1, &elemObjPtr);
+ /* Replace the single list element through itself, nonsense but legal. */
+ Tcl_ListObjReplace(interp, listObjPtr, 0, 1, 1, &elemObjPtr);
+ Tcl_SetObjResult(interp, listObjPtr);
+ return TCL_OK;
} else if (strcmp(subCmd, "convert") == 0) {
char *typeName;
if (objc != 4) {
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 960c7dc..d032cc6 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -57,7 +57,7 @@ static struct ThreadSpecificData *threadList;
*/
typedef struct ThreadCtrl {
- char *script; /* The Tcl command this thread should
+ const char *script; /* The Tcl command this thread should
* execute */
int flags; /* Initial value of the "flags" field in the
* ThreadSpecificData structure for the new
@@ -120,11 +120,11 @@ EXTERN int TclThread_Init(Tcl_Interp *interp);
EXTERN int Tcl_ThreadObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-EXTERN int TclCreateThread(Tcl_Interp *interp, char *script,
+EXTERN int TclCreateThread(Tcl_Interp *interp, const char *script,
int joinable);
EXTERN int TclThreadList(Tcl_Interp *interp);
EXTERN int TclThreadSend(Tcl_Interp *interp, Tcl_ThreadId id,
- char *script, int wait);
+ const char *script, int wait);
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
@@ -234,7 +234,7 @@ Tcl_ThreadObjCmd(
switch ((enum options)option) {
case THREAD_CREATE: {
- char *script;
+ const char *script;
int joinable, len;
if (objc == 2) {
@@ -331,7 +331,7 @@ Tcl_ThreadObjCmd(
return TclThreadList(interp);
case THREAD_SEND: {
long id;
- char *script;
+ const char *script;
int wait, arg;
if ((objc != 4) && (objc != 5)) {
@@ -407,7 +407,7 @@ Tcl_ThreadObjCmd(
int
TclCreateThread(
Tcl_Interp *interp, /* Current interpreter. */
- char *script, /* Script to execute */
+ const char *script, /* Script to execute */
int joinable) /* Flag, joinable thread or not */
{
ThreadCtrl ctrl;
@@ -424,7 +424,6 @@ TclCreateThread(
TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
Tcl_MutexUnlock(&threadMutex);
Tcl_AppendResult(interp, "can't create a new thread", NULL);
- ckfree((char *) ctrl.script);
return TCL_ERROR;
}
@@ -705,7 +704,7 @@ int
TclThreadSend(
Tcl_Interp *interp, /* The current interpreter. */
Tcl_ThreadId id, /* Thread Id of other interpreter. */
- char *script, /* The script to evaluate. */
+ const char *script, /* The script to evaluate. */
int wait) /* If 1, we block for the result. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -1035,7 +1034,7 @@ ThreadExitProc(
* going to call free on it.
*/
- char *msg = "target thread died";
+ const char *msg = "target thread died";
resultPtr->result = ckalloc(strlen(msg)+1);
strcpy(resultPtr->result, msg);
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
index 6e5dac3..89c1132 100644
--- a/generic/tclTomMathInterface.c
+++ b/generic/tclTomMathInterface.c
@@ -112,7 +112,7 @@ extern void *
TclBNAlloc(
size_t x)
{
- return (void *) Tcl_Alloc((unsigned int) x);
+ return (void *) ckalloc((unsigned int) x);
}
/*
@@ -136,7 +136,7 @@ TclBNRealloc(
void *p,
size_t s)
{
- return (void *) Tcl_Realloc((char *) p, (unsigned int) s);
+ return (void *) ckrealloc((char *) p, (unsigned int) s);
}
/*
@@ -162,7 +162,7 @@ extern void
TclBNFree(
void *p)
{
- Tcl_Free((char *) p);
+ ckfree((char *) p);
}
#endif
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 866b6ae..5f4cdae 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -167,7 +167,7 @@ Tcl_ObjType tclEndOffsetType = {
* separating whitespace, or a string terminator. It is just
* another character in a list element.
*
- * The interpretaton of a formatted substring as a list element follows
+ * The interpretation of a formatted substring as a list element follows
* rules similar to the parsing of the words of a command in a Tcl script.
* Backslash substitution plays a key role, and is defined exactly as it is
* in command parsing. The same routine, TclParseBackslash() is used in both
@@ -180,7 +180,7 @@ Tcl_ObjType tclEndOffsetType = {
* Backslash substitution replaces an "escape sequence" of one or more
* characters starting with
* \u005c \ BACKSLASH
- * with a single character. The one character escape sequent case happens
+ * with a single character. The one character escape sequence case happens
* only when BACKSLASH is the last character in the string. In all other
* cases, the escape sequence is at least two characters long.
*
diff --git a/library/http/http.tcl b/library/http/http.tcl
index fa0425d..6b82894 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -11,7 +11,7 @@
package require Tcl 8.4
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
-package provide http 2.7.10
+package provide http 2.7.11
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -974,7 +974,7 @@ proc http::Event {sock token} {
} elseif {$n == 0} {
# We have now read all headers
# We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
- if {$state(http) == "" || [lindex $state(http) 1] == 100} {
+ if {$state(http) == "" || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)} {
return
}
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 0b5cdeb..73b2f36 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,4 +1,4 @@
# Tcl package index file, version 1.1
if {![package vsatisfies [package provide Tcl] 8.4]} {return}
-package ifneeded http 2.7.10 [list tclPkgSetup $dir http 2.7.10 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.7.11 [list tclPkgSetup $dir http 2.7.11 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/tests/listObj.test b/tests/listObj.test
index 53017b1..9f9b41c 100644
--- a/tests/listObj.test
+++ b/tests/listObj.test
@@ -193,6 +193,10 @@ test listobj-10.1 {Bug [2971669]} {*}{
-result {{a b c d e} {} {a b c d e f}}
}
+test listobj-11.1 {bug 3598580} {
+ testobj bug3598580
+} 123
+
# cleanup
::tcltest::cleanupTests
return
diff --git a/unix/Makefile.in b/unix/Makefile.in
index e43c252..3daad96 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -766,8 +766,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
done;
- @echo "Installing package http 2.7.10 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.10.tm;
+ @echo "Installing package http 2.7.11 as a Tcl Module";
+ @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.11.tm;
@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
@for i in $(TOP_DIR)/library/opt/*.tcl ; \
do \
diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c
index 489f66b..039ad91 100644
--- a/unix/dltest/pkgb.c
+++ b/unix/dltest/pkgb.c
@@ -39,6 +39,10 @@ static int Pkgb_UnsafeObjCmd(ClientData clientData,
*----------------------------------------------------------------------
*/
+#ifndef Tcl_GetErrorLine
+# define Tcl_GetErrorLine(interp) ((interp)->errorLine)
+#endif
+
static int
Pkgb_SubObjCmd(
ClientData dummy, /* Not used. */
@@ -54,6 +58,9 @@ Pkgb_SubObjCmd(
}
if ((Tcl_GetIntFromObj(interp, objv[1], &first) != TCL_OK)
|| (Tcl_GetIntFromObj(interp, objv[2], &second) != TCL_OK)) {
+ char buf[TCL_INTEGER_SPACE];
+ sprintf(buf, "%d", Tcl_GetErrorLine(interp));
+ Tcl_AppendResult(interp, " in line: ", buf, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewIntObj(first - second));
@@ -104,15 +111,18 @@ Pkgb_UnsafeObjCmd(
*----------------------------------------------------------------------
*/
-int
+DLLEXPORT int
Pkgb_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
- if (Tcl_InitStubs(interp, "8.5-9.1", 0) == NULL) {
- return TCL_ERROR;
+ if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_ResetResult(interp);
}
code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
if (code != TCL_OK) {
@@ -142,15 +152,18 @@ Pkgb_Init(
*----------------------------------------------------------------------
*/
-int
+DLLEXPORT int
Pkgb_SafeInit(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
- if (Tcl_InitStubs(interp, "8.5-9.1", 0) == NULL) {
- return TCL_ERROR;
+ if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
+ return TCL_ERROR;
+ }
+ Tcl_ResetResult(interp);
}
code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
if (code != TCL_OK) {
diff --git a/win/Makefile.in b/win/Makefile.in
index 4949c70..23f5a2b 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -637,8 +637,8 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
done;
- @echo "Installing package http 2.7.10 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.10.tm;
+ @echo "Installing package http 2.7.11 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.11.tm;
@echo "Installing library opt0.4 directory";
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
do \
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index a9b321d..7da19ce 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -190,7 +190,7 @@ static unsigned short NativeStatMode(DWORD attr, int checkLinks,
int isExec);
static int NativeIsExec(const TCHAR *path);
static int NativeReadReparse(const TCHAR *LinkDirectory,
- REPARSE_DATA_BUFFER *buffer);
+ REPARSE_DATA_BUFFER *buffer, DWORD desiredAccess);
static int NativeWriteReparse(const TCHAR *LinkDirectory,
REPARSE_DATA_BUFFER *buffer);
static int NativeMatchType(int isDrive, DWORD attr,
@@ -481,7 +481,7 @@ TclWinSymLinkCopyDirectory(
DUMMY_REPARSE_BUFFER dummy;
REPARSE_DATA_BUFFER *reparseBuffer = (REPARSE_DATA_BUFFER *) &dummy;
- if (NativeReadReparse(linkOrigPath, reparseBuffer)) {
+ if (NativeReadReparse(linkOrigPath, reparseBuffer, GENERIC_READ)) {
return -1;
}
return NativeWriteReparse(linkCopyPath, reparseBuffer);
@@ -580,7 +580,7 @@ WinReadLinkDirectory(
if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) {
goto invalidError;
}
- if (NativeReadReparse(linkDirPath, reparseBuffer)) {
+ if (NativeReadReparse(linkDirPath, reparseBuffer, 0)) {
return NULL;
}
@@ -699,12 +699,13 @@ WinReadLinkDirectory(
static int
NativeReadReparse(
const TCHAR *linkDirPath, /* The junction to read */
- REPARSE_DATA_BUFFER *buffer)/* Pointer to buffer. Cannot be NULL */
+ REPARSE_DATA_BUFFER *buffer,/* Pointer to buffer. Cannot be NULL */
+ DWORD desiredAccess)
{
HANDLE hFile;
DWORD returnedLength;
- hFile = (*tclWinProcs->createFileProc)(linkDirPath, GENERIC_READ, 0,
+ hFile = (*tclWinProcs->createFileProc)(linkDirPath, desiredAccess, 0,
NULL, OPEN_EXISTING,
FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, NULL);
generated by cgit v0.12 at 2024-11-26 23:18:18 (GMT)