Tcl Source Code

2011-08-15  Don Porter  <[email protected]>

	* generic/tclBasic.c: [Bug 3390272] Leak of [info script] value.

2011-08-15  Jan Nijtmans  <[email protected]>

	* generic/tclPosixStr.c:    [Bug 3388350] mingw64 compiler warnings
	* win/tclWinPort.h:
	* win/configure.in
	* win/configure

2011-08-14  Jan Nijtmans  <[email protected]>

	* doc/FindExec.3: [Patch 3124554]: Move WishPanic from Tk to Tcl
	* doc/Panic.3     Added Documentation

2011-08-12  Don Porter  <[email protected]>

	* generic/tclPathObj.c:	[Bug 3389764] Eliminate possibility that dup
	of a "path" value can create reference cycle.

2011-08-12  Donal K. Fellows  <[email protected]>

	* generic/tclZlib.c (ZlibTransformOutput): [Bug 3390073]: Return the
	correct length of written data for a compressing transform.

2011-08-10 Alexandre Ferrieux  <[email protected]>

	* generic/tclTestObj.c: [Bug 3386721]: Allow multiple [load]ing of the
	Tcltest package.

2011-08-09 Alexandre Ferrieux  <[email protected]>

	* generic/tclBasic.c: [Bug 2919042]: Restore "valgrindability" of Tcl
	* generic/tclEvent.c: that was lost by the streamlining of [exit], by
	* generic/tclExecute.c: conditionally forcing a full Finalize:
	* generic/tclInt.h:  use -DPURIFY or ::env(TCL_FINALIZE_ON_EXIT)

2011-08-09 Alexandre Ferrieux  <[email protected]>

	* generic/tclCompCmds.c: [Bug 3386417]: Avoid a reference loop between
	* generic/tclInt.h:      the bytecode and its companion errostack
	* generic/tclResult.c:   when compiling a syntax error.

2011-08-09  Jan Nijtmans  <[email protected]>

	* win/tclWinConsole.c: [Bug 3388350]: mingw64 compiler warnings
	* win/tclWinDde.c
	* win/tclWinPipe.c
	* win/tclWinSerial.c

2011-08-09  Jan Nijtmans  <[email protected]>

	* generic/tclInt.h: Change the signature of TclParseHex(), such that

\fIargv[0]\fR as its argument.  It is important not to change the
working directory before the invocation.
\fBTcl_FindExecutable\fR uses \fIargv0\fR
along with the \fBPATH\fR environment variable to find the
application's executable, if possible.  If it fails to find
the binary, then future calls to \fBinfo nameofexecutable\fR
will return an empty string.
.PP
On Windows platforms this procedure is typically invoked as the very
first thing in the application's main program as well; Its \fIargv[0]\fR
argument is only used to indicate wheter the executable has a stderr
channel (any non-null value) or not (the value null). If \fBTcl_SetPanicProc\fR
is never called and no debugger is running, this determines whether
the panic message is sent to stderr or to a standard system dialog.
.PP
\fBTcl_GetNameOfExecutable\fR simply returns a pointer to the
internal full path name of the executable file as computed by
\fBTcl_FindExecutable\fR.  This procedure call is the C API
equivalent to the \fBinfo nameofexecutable\fR command.  NULL
is returned if the internal full path name has not been
computed or unknown.

same formatting rules used by the \fBprintf\fR family of functions.  The
same formatting rules are also used by the built-in Tcl command
\fBformat\fR.
.PP
In a freshly loaded Tcl library, \fBTcl_Panic\fR prints the formatted
error message to the standard error file of the process, and then
calls \fBabort\fR to terminate the process.  \fBTcl_Panic\fR does not
return. On Windows, when a debugger is running, the formatted error
message is sent to the debugger in stead. If the windows executable
does not have a stderr channel (e.g. \fBwish.exe\fR), then a
system dialog box is used to display the panic message.
.PP
\fBTcl_SetPanicProc\fR may be used to modify the behavior of
\fBTcl_Panic\fR.  The \fIpanicProc\fR argument should match the
type \fBTcl_PanicProc\fR:
.PP
.CS
typedef void \fBTcl_PanicProc\fR(
        const char *\fBformat\fR,
        \fBarg\fR, \fBarg\fR,...);
.CE
.PP
After \fBTcl_SetPanicProc\fR returns, any future calls to
\fBTcl_Panic\fR will call \fIpanicProc\fR, passing along the
\fIformat\fR and \fIarg\fR arguments. \fIpanicProc\fR should avoid


making calls into the Tcl library, or into other libraries that may
call the Tcl library, since the original call to \fBTcl_Panic\fR
indicates the Tcl library is not in a state of reliable operation.  
.PP
The typical use of \fBTcl_SetPanicProc\fR arranges for the error message
to be displayed or reported in a manner more suitable for the
application or the platform.



.PP
Although the primary callers of \fBTcl_Panic\fR are the procedures of
the Tcl library, \fBTcl_Panic\fR is a public function and may be called
by any extension or application that wishes to abort the process and
have a panic message displayed the same way that panic messages from Tcl
will be displayed.
.PP

    }
    TclFreePackageInfo(iPtr);
    while (iPtr->tracePtr != NULL) {
	Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
    }
    if (iPtr->execEnvPtr != NULL) {
	TclDeleteExecEnv(iPtr->execEnvPtr);
    }
    if (iPtr->scriptFile) {
	Tcl_DecrRefCount(iPtr->scriptFile);
	iPtr->scriptFile = NULL;
    }
    Tcl_DecrRefCount(iPtr->emptyObjPtr);
    iPtr->emptyObjPtr = NULL;

    resPtr = iPtr->resolverPtr;
    while (resPtr) {
	nextResPtr = resPtr->nextPtr;

    Tcl_Obj *copyPtr)		/* Path obj with internal rep to set. */
{
    FsPath *srcFsPathPtr = PATHOBJ(srcPtr);
    FsPath *copyFsPathPtr = ckalloc(sizeof(FsPath));

    SETPATHOBJ(copyPtr, copyFsPathPtr);

    if (srcFsPathPtr->translatedPathPtr == srcPtr) {
	/* Cycle in src -> make cycle in copy. */
	copyFsPathPtr->translatedPathPtr = copyPtr;
    } else {
	copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
	if (copyFsPathPtr->translatedPathPtr != NULL) {
	    Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
	}


    }

    if (srcFsPathPtr->normPathPtr == srcPtr) {
	/* Cycle in src -> make cycle in copy. */
	copyFsPathPtr->normPathPtr = copyPtr;
    } else {
	copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
	if (copyFsPathPtr->normPathPtr != NULL) {
	    Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
	}


    }


    copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
    if (copyFsPathPtr->cwdPtr != NULL) {

	Tcl_IncrRefCount(copyFsPathPtr->cwdPtr);
    }

    copyFsPathPtr->flags = srcFsPathPtr->flags;

    if (srcFsPathPtr->fsRecPtr != NULL
	    && srcFsPathPtr->nativePathPtr != NULL) {
	Tcl_FSDupInternalRepProc *dupProc =

 *----------------------------------------------------------------------
 */

const char *
Tcl_ErrnoId(void)
{
    switch (errno) {
#if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW))
    case E2BIG: return "E2BIG";
#endif
#ifdef EACCES
    case EACCES: return "EACCES";
#endif
#ifdef EADDRINUSE
    case EADDRINUSE: return "EADDRINUSE";

 */

const char *
Tcl_ErrnoMsg(
     int err)			/* Error number (such as in errno variable). */
{
    switch (err) {
#if defined(E2BIG) && (!defined(EOVERFLOW) || (E2BIG != EOVERFLOW))
    case E2BIG: return "argument list too long";
#endif
#ifdef EACCES
    case EACCES: return "permission denied";
#endif
#ifdef EADDRINUSE
    case EADDRINUSE: return "address already in use";

    if (e != Z_OK) {
	Tcl_SetChannelError(cd->parent,
		Tcl_NewStringObj(cd->outStream.msg, -1));
	*errorCodePtr = EINVAL;
	return -1;
    }

    return toWrite - cd->outStream.avail_in;
}

static int
ZlibTransformSetOption(			/* not used */
    ClientData instanceData,
    Tcl_Interp *interp,
    const char *optionName,

    }
    append total --> [file size $file]
} -cleanup {
    close $fout
    close $srv
    removeFile $file
} -result 81920-->81920

test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
    set sfile [makeFile {} testsrc.gz]
    set file [makeFile {} test.gz]
    set f [open $sfile wb]
    puts -nonewline $f [zlib gzip [string repeat a 81920]]
    close $f
} -body {

    vwait ::total
    set ::total
} -cleanup {
    close $srv
    rename bgerror {}
    rename zlibRead {}
} -result {error {invalid block type}}

test zlib-11.1 "Bug #3390073: mis-appled gzip filtering" -setup {
    set file [makeFile {} test.input]
} -constraints zlib -body {
    set f [open $file wb]
    puts -nonewline [zlib push gzip $f] [string repeat "hello" 1000]
    close $f
    set f [open $file rb]
    set d [read $f]
    close $f
    set d [zlib gunzip $d]
    list [regexp -all "hello" $d] [string length [regsub -all "hello" $d {}]]
} -cleanup {
    removeFile $file
} -result {1000 0}
test zlib-11.2 "Bug #3390073: mis-appled gzip filtering" -setup {
    set file [makeFile {} test.input]
} -constraints zlib -body {
    set f [open $file wb]
    puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \
	[string repeat "hello" 1000]
    close $f
    set f [open $file rb]
    set d [read $f]
    close $f
    set d [zlib gunzip $d -header h]
    list [regexp -all "hello" $d] [dict get $h filename] \
	[string length [regsub -all "hello" $d {}]]
} -cleanup {
    removeFile $file
} -result {1000 /foo/bar 0}

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

#define HAVE_CAST_TO_UNION 1
_ACEOF

fi

# Check to see if struct _stat32i64 exists in mingw's sys/stat.h

echo "$as_me:$LINENO: checking if struct _stat32i64 missing" >&5
echo $ECHO_N "checking if struct _stat32i64 missing... $ECHO_C" >&6
if test "${tcl_struct_stat32i64+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext

  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_struct_stat32i64=no
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_struct_stat32i64=yes
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_struct_stat32i64" >&5
echo "${ECHO_T}$tcl_struct_stat32i64" >&6
if test "$tcl_struct_stat32i64" = "yes" ; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_NO_STRUCT_STAT32I64 1
_ACEOF

fi


# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be

if test "$tcl_cv_cast_to_union" = "yes"; then
    AC_DEFINE(HAVE_CAST_TO_UNION, 1,
            [Defined when compiler supports casting to union type.])
fi

# Check to see if struct _stat32i64 exists in mingw's sys/stat.h

AC_CACHE_CHECK(if struct _stat32i64 missing,
    tcl_struct_stat32i64,
AC_TRY_COMPILE([
#include <sys/types.h>
#include <sys/stat.h>
],
[
  struct _stat32i64 foo;
],
        tcl_struct_stat32i64=no,
        tcl_struct_stat32i64=yes)
)
if test "$tcl_struct_stat32i64" = "yes" ; then
    AC_DEFINE(HAVE_NO_STRUCT_STAT32I64, 1,
            [Defined when sys/stat.h is missing struct _stat32i64])
fi


# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.

AC_CHECK_TYPE([intptr_t], [
    AC_DEFINE([HAVE_INTPTR_T], 1, [Do we have the intptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size signed integer type], tcl_cv_intptr_t, [
    for tcl_cv_intptr_t in "int" "long" "long long" none; do
	if test "$tcl_cv_intptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_intptr_t)]])],
		[tcl_ok=yes], [tcl_ok=no])
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_intptr_t" != none; then
	AC_DEFINE_UNQUOTED([intptr_t], [$tcl_cv_intptr_t], [Signed integer
	   type wide enough to hold a pointer.])
    fi
])
AC_CHECK_TYPE([uintptr_t], [
    AC_DEFINE([HAVE_UINTPTR_T], 1, [Do we have the uintptr_t type?])], [
    AC_CACHE_CHECK([for pointer-size unsigned integer type], tcl_cv_uintptr_t, [
    for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
	    none; do
	if test "$tcl_cv_uintptr_t" != none; then
	    AC_COMPILE_IFELSE([AC_LANG_BOOL_COMPILE_TRY([AC_INCLUDES_DEFAULT],
		    [[sizeof (void *) <= sizeof ($tcl_cv_uintptr_t)]])],
		[tcl_ok=yes], [tcl_ok=no])
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_uintptr_t" != none; then
	AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer
	   type wide enough to hold a pointer.])
    fi

#endif /* __MWERKS__ */

#include <time.h>

/*
 * Not all mingw32 versions have this struct.
 */
#if !defined(__BORLANDC__) && !defined(_MSC_VER) && !defined(_WIN64) && defined(HAVE_NO_STRUCT_STAT32I64)
  struct _stat32i64 {
    dev_t st_dev;
    ino_t st_ino;
    unsigned short st_mode;
    short st_nlink;
    short st_uid;
    short st_gid;