Tcl Source Code

2012-12-21  Jan Nijtmans  <[email protected]>

	* unix/dltest/pkgb.c:  Inline compat Tcl_GetDefaultEncodingDir.
	* generic/tclStubLib.c: Eliminate unnecessary static HasStubSupport() and
	isDigit() functions, just do the same inline.

2012-12-18  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmdsSZ.c (TclSubstCompile): Improved the sequence of
	instructions issued for [subst] when dealing with simple variable
	references.

2012-12-14  Don Porter  <[email protected]>

	*** 8.6.0 TAGGED FOR RELEASE ***

	* changes: updates for 8.6.0

2012-12-13  Don Porter  <[email protected]>

	* generic/tclZlib.c:	Repair same issue with misusing the
	* tests/zlib.test:	'fire and forget' nature of Tcl_ObjSetVar2
	in the new TIP 400 implementation.

2012-12-13  Miguel Sofer  <[email protected]>

	* generic/tclCmdAH.c:	(CatchObjCmdCallback): do not decrRefCount
	* tests/cmdAH.test:	the newValuePtr sent to Tcl_ObjSetVar2:
	TOSV2 is 'fire and forget', it decrs on its own.
	Fix for [Bug 3595576], found by andrewsh.

2012-12-13  Jan Nijtmans  <[email protected]>

	* generic/tcl.h: Fix Tcl_DecrRefCount macro such that it doesn't
	access its objPtr parameter twice any more.

2012-12-11  Don Porter  <[email protected]>

	* generic/tcl.h:	Bump version number to 8.6.0.
	* library/init.tcl:
	* unix/configure.in:
	* win/configure.in:
	* unix/tcl.spec:
	* README:

	* unix/configure:	autoconf-2.59
	* win/configure:

2012-12-10  Donal K. Fellows  <[email protected]>

	* tools/tcltk-man2html.tcl (plus-pkgs): Increased robustness of
	version number detection code to deal with packages whose names are
	prefixes of other packages.
	* unix/Makefile.in (dist): Added pkgs/package.list.txt to distribution

2012-11-15 (TIP 416) New [load] options -global and -lazy (nijtmans)

2012-11-20 (bug fix)[3033307] base64 trail whitespace (kovalenko,goth)

2012-12-03 (bug fix) [configure] query broke init from argv (porter)
=> tcltest 2.3.5

2012-12-13 (bug fix)[3595576] crash: [catch {} -> noSuchNs::var] (sofer,porter)

2012-12-13 (bug fix) crash: [zlib gunzip $data -header noSuchNs::var] (porter)

--- Released 8.6.0, December 20, 2012 --- See ChangeLog for details ---

	    continue;
	case TCL_TOKEN_BS:
	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
		    NULL, buf);
	    literal = TclRegisterNewLiteral(envPtr, buf, length);
	    TclEmitPush(literal, envPtr);
	    count++;
	    continue;
	case TCL_TOKEN_VARIABLE:
	    /*
	     * Check for simple variable access; see if we can only generate
	     * TCL_OK or TCL_ERROR from the substituted variable read; if so,
	     * there is no need to generate elaborate exception-management
	     * code. Note that the first component of TCL_TOKEN_VARIABLE is
	     * always TCL_TOKEN_TEXT...
	     */

	    if (tokenPtr->numComponents > 1) {
		int i, foundCommand = 0;

		for (i=2 ; i<=tokenPtr->numComponents ; i++) {
		    if (tokenPtr[i].type == TCL_TOKEN_COMMAND) {
			foundCommand = 1;
			break;
		    }
		}
		if (foundCommand) {
		    break;
		}
	    }

	    envPtr->line = bline;
	    TclCompileVarSubst(interp, tokenPtr, envPtr);
	    bline = envPtr->line;
	    count++;
	    continue;
	}

	while (count > 255) {
	    OP1(		CONCAT1, 255);
	    count -= 254;
	}

 *
 * tests/oo.test
 * tests/ooNext2.test
 * unix/tclooConfig.sh
 * win/tclooConfig.sh
 */

#define TCLOO_VERSION "1.0"
#define TCLOO_PATCHLEVEL TCLOO_VERSION

/*
 * These are opaque types.
 */

typedef struct Tcl_Class_ *Tcl_Class;

 */

void
TclOOInitInfo(
    Tcl_Interp *interp)
{
    Tcl_Command infoCmd;
    Tcl_Obj *mapDict;

    /*
     * Build the ensembles used to implement [info object] and [info class].
     */

    TclMakeEnsemble(interp, "::oo::InfoObject", infoObjectCmds);
    TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds);

    /*
     * Install into the master [info] ensemble.
     */

    infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);



    Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);






    Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("object", -1),
	    Tcl_NewStringObj("::oo::InfoObject", -1));
    Tcl_DictObjPut(NULL, mapDict, Tcl_NewStringObj("class", -1),
	    Tcl_NewStringObj("::oo::InfoClass", -1));


    Tcl_SetEnsembleMappingDict(interp, infoCmd, mapDict);


}

/*
 * ----------------------------------------------------------------------
 *
 * GetClassFromObj --
 *

MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr;

const TclStubs *tclStubsPtr = NULL;
const TclPlatStubs *tclPlatStubsPtr = NULL;
const TclIntStubs *tclIntStubsPtr = NULL;
const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;





















/*
 * Use our own ISDIGIT to avoid linking to libc on windows
 */





#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9)

/*
 *----------------------------------------------------------------------
 *
 * TclInitStubs --
 *
 *	Tries to initialise the stub table pointers and ensures that the

TclInitStubs(
    Tcl_Interp *interp,
    const char *version,
    int exact,
    const char *tclversion,
    int magic)
{
    Interp *iPtr = (Interp *) interp;
    const char *actualVersion = NULL;
    ClientData pkgData = NULL;
    const TclStubs *stubsPtr = iPtr->stubTable;

    /*
     * We can't optimize this check by caching tclStubsPtr because that
     * prevents apps from being able to load/unload Tcl dynamically multiple
     * times. [Bug 615304]
     */


    if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
	iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism";
	iPtr->legacyFreeProc = 0; /* TCL_STATIC */
	return NULL;
    }

    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
    if (actualVersion == NULL) {
	return NULL;
    }
    if (exact) {
	const char *p = version;
	int count = 0;

	while (*p) {
	    count += !ISDIGIT(*p++);
	}
	if (count == 1) {
	    const char *q = actualVersion;

	    p = version;
	    while (*p && (*p == *q)) {
		p++; q++;
	    }
	    if (*p || ISDIGIT(*q)) {
		/* Construct error message */
		stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
		return NULL;
	    }
	} else {
	    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
	    if (actualVersion == NULL) {

tdbc TDBC
Tdbc TDBC
TDBC TDBC
# Drivers for TDBC
tdbcmysql	tdbc::mysql
tdbcodbc	tdbc::odbc
tdbcpostgres	tdbc::postgres
tdbcsqlite3	tdbc::sqlite3

# This file contains a collection of tests for Tcl's built-in object system.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 2006-2012 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require TclOO 1.0
package require tcltest 2
if {"::tcltest" in [namespace children]} {
    namespace import -force ::tcltest::*
}

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {

# This file contains a collection of tests for Tcl's built-in object system.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 2006-2011 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require TclOO 1.0
package require tcltest 2
if {"::tcltest" in [namespace children]} {
    namespace import -force ::tcltest::*
}

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {

    global build_tcl tcltkdir tcldir
    if {$type ni {n 3}} {
	error "unknown type \"$type\": must be 3 or n"
    }
    if {!$build_tcl} return
    set result {}
    set pkgsdir $tcltkdir/$tcldir/pkgs
    foreach {dir name version} $args {
	set globpat $pkgsdir/$dir/doc/*.$type
	if {![llength [glob -type f -nocomplain $globpat]]} {
	    # Fallback for manpages generated using doctools
	    set globpat $pkgsdir/$dir/doc/man/*.$type
	    if {![llength [glob -type f -nocomplain $globpat]]} {
		continue
	    }
	}



	switch $type {
	    n {
		set title "$name Package Commands"
		if {$version ne ""} {
		    append title ", version $version"
		}
		set dir [string totitle $dir]Cmd

    }
    if {$build_tk} {
	append tcltkdesc "Tk"
	append cmdesc "Tk"
	append appdir "$tkdir"
    }


    # When building docs for Tcl, try to build docs for bundled packages too
    set packageBuildList {}
    if  {$build_tcl} {
	set pkgsDir [file join $tcltkdir $tcldir pkgs]
	set subdirs [glob -nocomplain -types d -tails -directory $pkgsDir *]

	foreach dir [lsort $subdirs] {
	    # Parse the subdir name into (name, version) as fallback...
	    set description [split $dir -]
	    if {2 != [llength $description]} {
		regexp {([^0-9]*)(.*)} $dir -> n v
		set description [list $n $v]
	    }

	    # ... but try to extract (name, version) from subdir contents
	    try {
		set f [open [file join $pkgsDir $dir configure.in]]
		foreach line [split [read $f] \n] {
		    if {2 == [scan $line \
			    { AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} {
			set description [list $n $v]
			break
		    }
		}
	    } finally {
		catch {close $f; unset f}
	    }

	    if {[file exists [file join $pkgsDir $dir configure]]} {
		# Looks like a package, record our best extraction attempt
		lappend packageBuildList $dir {*}$description
	    }
	}
    }

    # Get the list of packages to try, and what their human-readable names
    # are. Note that the package directory list should be version-less.
    try {
	set packageDirNameMap {}
	if {$build_tcl} {
	    set f [open $tcltkdir/$tcldir/pkgs/package.list.txt]
	    try {

	set packageDirNameMap {
	    itcl {[incr Tcl]}
	    tdbc {TDBC}
	    thread Thread
	}
    }

    # Convert to human readable names, if applicable
    for {set idx 0} {$idx < [llength $packageBuildList]} {incr idx 3} {
	lassign [lrange $packageBuildList $idx $idx+2] d n v
	if {[dict exists $packageDirNameMap $n]} {
	    lset packageBuildList $idx+1 [dict get $packageDirNameMap $n]
	}
    }

    #
    # Invoke the scraper/converter engine.
    #
    make-man-pages $webdir \
	[list $tcltkdir/{$appdir}/doc/*.1 "$tcltkdesc Applications" UserCmd \
	     "The interpreters which implement $cmdesc."] \
	[plus-base $build_tcl $tcldir doc/*.n {Tcl Commands} TclCmd \
	     "The commands which the <B>tclsh</B> interpreter implements."] \
	[plus-base $build_tk $tkdir doc/*.n {Tk Commands} TkCmd \
	     "The additional commands which the <B>wish</B> interpreter implements."] \
	{*}[plus-pkgs n {*}$packageBuildList] \
	[plus-base $build_tcl $tcldir doc/*.3 {Tcl C API} TclLib \
	     "The C functions which a Tcl extended C program may use."] \
	[plus-base $build_tk $tkdir doc/*.3 {Tk C API} TkLib \
	     "The additional C functions which a Tk extended C program may use."] \
	{*}[plus-pkgs 3 {*}$packageBuildList]
} on error {msg opts} {
    # On failure make sure we show what went wrong. We're not supposed
    # to get here though; it represents a bug in the script.
    puts $msg\n[dict get $opts -errorinfo]
    exit 1
}

# Local-Variables:
# mode: tcl
# End:

		$(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \
		$(DISTDIR)/tools
	$(NATIVE_TCLSH) $(TOOL_DIR)/eolFix.tcl -crlf $(DISTDIR)/tools/tcl.hpj.in
	mkdir $(DISTDIR)/libtommath
	cp -p $(TOMMATH_SRCS) $(TOMMATH_DIR)/*.h \
		$(DISTDIR)/libtommath
	mkdir $(DISTDIR)/pkgs
	cp $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs

	for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \
	    tar -C $(DISTDIR)/pkgs -xzf "$$i"; \
	done

alldist: dist
	rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME)
	cd $(DISTROOT); tar cf $(DISTNAME)-src.tar $(DISTNAME); \

    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    return Tcl_EvalEx(interp, "list unsafe command invoked", -1, TCL_EVAL_GLOBAL);
}

















static int
Pkgb_DemoObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
#if (TCL_MAJOR_VERSION > 8) || (TCL_MINOR_VERSION > 4)
    Tcl_Obj *first;

    if (Tcl_ListObjIndex(NULL, Tcl_GetEncodingSearchPath(), 0, &first)
	    == TCL_OK) {
	Tcl_SetObjResult(interp, first);
    }
#else
    Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetDefaultEncodingDir(), -1));
#endif
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgb_Init --

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-", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);

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-", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);
    return TCL_OK;
}

# These are mostly empty because no special steps are ever needed from Tcl 8.6
# onwards; all libraries and include files are just part of Tcl.
TCLOO_LIB_SPEC=""
TCLOO_STUB_LIB_SPEC=""
TCLOO_INCLUDE_SPEC=""
TCLOO_PRIVATE_INCLUDE_SPEC=""
TCLOO_CFLAGS=""
TCLOO_VERSION=1.0

# These are mostly empty because no special steps are ever needed from Tcl 8.6
# onwards; all libraries and include files are just part of Tcl.
TCLOO_LIB_SPEC=""
TCLOO_STUB_LIB_SPEC=""
TCLOO_INCLUDE_SPEC=""
TCLOO_PRIVATE_INCLUDE_SPEC=""
TCLOO_CFLAGS=""
TCLOO_VERSION=1.0