Tcl Source Code

2011-06-21  Don Porter  <[email protected]>

	* library/tcltest/tcltest.tcl (loadIntoSlaveInterpreter):
	* library/tcltest/pkgIndex.tcl: Backport tcltest 2.3.3 for release
	* unix/Makefile.in: with Tcl 8.5.*.
	* win/Makefile.in:

	* tests/init.test:	Update test files to use new command.
	* tests/pkg.test:

	* generic/tclLink.c:	Prevent multiple links to a single Tcl
	variable when calling Tcl_LinkVar(). [Bug 3317466]

2011-06-13  Don Porter  <[email protected]>

	* generic/tclStrToD.c:  [Bug 3315098] Mem leak fix from Gustaf Neumann.

# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex -direct" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded tcltest 2.3.3 [list source [file join $dir tcltest.tcl]]

package require Tcl 8.5		;# -verbose line uses [info frame]
namespace eval tcltest {

    # When the version number changes, be sure to update the pkgIndex.tcl file,
    # and the install directory in the Makefiles.  When the minor version
    # changes (new feature) be sure to update the man page as well.
    variable Version 2.3.3

    # Compatibility support for dumb variables defined in tcltest 1
    # Do not use these.  Call [package provide Tcl] and [info patchlevel]
    # yourself.  You don't need tcltest to wrap it for you.
    variable version [package provide Tcl]
    variable patchLevel [info patchlevel]

    # errors go to stderr by default
    Option -errfile stderr {
	Send errors from test runs to the specified file.
    } AcceptOutFile errorFile
    trace variable Option(-errfile) w \
	    [namespace code {errorChannel $Option(-errfile) ;#}]

    proc loadIntoSlaveInterpreter {slave args} {
	variable Version
	interp eval $slave [list set ::argv $args]
	interp eval $slave [list package require tcltest $Version]
	interp alias $slave ::tcltest::ReportToMaster \
	    {} ::tcltest::ReportedFromSlave
    }
    proc ReportedFromSlave {total passed skipped failed because newfiles} {
	variable numTests
	variable skippedBecause
	variable createdNewFiles
	incr numTests(Total)   $total
	incr numTests(Passed)  $passed
	incr numTests(Skipped) $skipped
	incr numTests(Failed)  $failed
	foreach {constraint count} $because {
	    incr skippedBecause($constraint) $count
	}
	foreach {testfile created} $newfiles {
	    lappend createdNewFiles($testfile) {*}$created
	}
	return
    }
}

#####################################################################

# tcltest::Debug* --
#
#     Internal helper procedures to write out debug information

    variable currentFailure
    variable originalEnv
    variable originalTclPlatform
    variable coreModTime

    FillFilesExisted
    set testFileName [file tail [info script]]

    # Hook to handle reporting to a parent interpreter
    if {[llength [info commands [namespace current]::ReportToMaster]]} {
	ReportToMaster $numTests(Total) $numTests(Passed) $numTests(Skipped) \
	    $numTests(Failed) [array get skippedBecause] \
	    [array get createdNewFiles]
	set testSingleFile false
    }

    # Call the cleanup hook
    cleanupTestsHook

    # Remove files and directories created by the makeFile and
    # makeDirectory procedures.  Record the names of files in
    # workingDirectory that were not pre-existing, and associate them

test init-1.7 {auto_qualify - multiples colons 1} {
    auto_qualify :::foo::::bar ::blue
} ::foo::bar

test init-1.8 {auto_qualify - multiple colons 2} {
    auto_qualify :::foo ::bar
} foo


# we use a sub interp and auto_reset and double the tests because there is 2
# places where auto_loading occur (before loading the indexes files and after)

set testInterp [interp create]
tcltest::loadIntoSlaveInterpreter $testInterp {*}$argv
interp eval $testInterp {
    namespace import -force ::tcltest::*



    auto_reset
    catch {rename parray {}}

test init-2.0 {load parray - stage 1} {
    set ret [catch {parray} error]
    rename parray {} ; # remove it, for the next test - that should not fail.
    list $ret $error
} {1 {wrong # args: should be "parray a ?pattern?"}}

# Tests that compare the error stack trace generated when autoloading
# with that generated when no autoloading is necessary.  Ideally they
# should be the same.

set count 0
foreach arg [subst -nocommands -novariables {
    c
    {argument
                which spans
                multiple lines}
    {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
    {argument which spans multiple lines
                and is long enough to be truncated and
"               <- includes a false lead in the prune point search
                and must be longer still to force truncation}
                {contrived example: rare circumstance 
		where the point at which to prune the
		error stack cannot be uniquely determined.
		foo bar foo
"}
    {contrived example: rare circumstance 
		where the point at which to prune the
		error stack cannot be uniquely determined.
		foo bar
"}
    {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
	}] {    ;# emacs needs -> "

    test init-4.$count.0 {::errorInfo produced by [unknown]} {
	auto_reset
	catch {parray a b $arg}
	set first $::errorInfo
	catch {parray a b $arg}
	set second $::errorInfo

    package require tcltest 2
    namespace import -force ::tcltest::*
}

# Do all this in a slave interp to avoid garbaging the
# package list
set i [interp create]

tcltest::loadIntoSlaveInterpreter $i {*}$argv

interp eval $i {
namespace import -force ::tcltest::*
package forget {*}[package names]
set oldPkgUnknown [package unknown]
package unknown {}
set oldPath $auto_path
set auto_path ""

test pkg-1.1 {Tcl_PkgProvide procedure} {

	@echo "Installing library opt0.4 directory";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.4.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.4.tm;
	@echo "Installing package tcltest 2.3.3 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.3.3.tm;

	@echo "Installing package platform 1.0.9 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.9.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;

	@echo "Installing library encoding directory";

	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.4.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm;
	@echo "Installing package tcltest 2.3.3 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.3.3.tm;
	@echo "Installing package platform 1.0.9 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.9.tm;
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
	@echo "Installing encodings";
	@for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
		$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \