Tcl Source Code

# This file contains tests for the pkg_mkIndex command.
# Note that the tests are limited to Tcl scripts only, there are no shared
# libraries against which to test.
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: pkgMkIndex.test,v 1.4.2.8 1999/04/01 23:22:32 welch Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# temporarily copy the pkg and pkg1 dirs from testsDir to tmpDir
if {"$::tcltest::testsDir" != "$::tcltest::workingDir"} {

    file copy -force $x pkg
    pkgtest::runIndex pkg pkga[info sharedlibextension] pkga.tcl
} "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
test pkgMkIndex-10.2 {package in DLL hidden by -load} $dll {
    pkgtest::runIndex -load Pkg* -- pkg pkga[info sharedlibextension]
} {0 {}}

# Tolerate "namespace import" at the global scope

test pkgMkIndex-11.1 {conflicting namespace imports} {
    pkgtest::runIndex pkg import.tcl
} {0 {{fubar:1.0 {tclPkgSetup {import.tcl source ::fubar::foo}}}}}

# cleanup
namespace delete pkgtest
cd $::tcltest::workingDir
if {[info exists removePkgDir]} {
    # strange error deleting the pkg dir only once--needs be done twice!
    catch {file delete -force $newPkgDir}
    catch {file delete -force $newPkgDir}

# Commands covered:  (test)thread
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: thread.test,v 1.1.2.6 1999/04/01 23:22:32 welch Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info command testthread] == ""} {
    puts "skipping: tests require the testthread command"

    set numthreads [llength [testthread names]]
} {2}
ThreadReap

test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {
    testthread create {set x 5}
    foreach try {0 1 2 4 5 6} {
	# Try various ways to yeild
	update
	after 10
	set l [llength [testthread names]]
	if {$l == 1} {
	    break
	}
    }
    set l
} {1}
ThreadReap

test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {
    testthread create {testthread exit}
    update
    after 10
    llength [testthread names]
} {1}
ThreadReap

test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {
    set x [catch {testthread id x} msg]
    list $x $msg