Tcl Source Code

    if {[llength $matchDirs] == 0} {
	DebugPuts 1 "No test directories remain after applying match\
		and skip patterns!"
    }
    return [lsort $matchDirs]
}

# tcltest::fileEncoding --
#
#	checks the file contains BOM (or coding header)
#	and returns -encoding utf-8 (or enconding),
#	otherwise an empty list
#
#	Typical header for coding:
#		# -*- coding: utf-8 -*-
#
#	For similarity with Tcl this will be also supported:
#		# -encoding utf-8 ...
#		#!/usr/bin/env tclsh -encoding utf-8 ...
#
# Arguments:
#	name of the file to check encoding
#
# Results:
#	-encoding utf-8, -encoding $enc or empty
#
# Side effects:
#	None.

proc tcltest::fileEncoding {name} {
    variable fullutf

    set f [open $name rb]
    try {
	set buf [read $f 3]
	# contains BOM?
	if {$buf eq "\xEF\xBB\xBF"} {
	    return {-encoding utf-8}
	}
	# read 2 lines in header (may contain shebang and coding hereafter):
	append buf [gets $f] \n [gets $f]
	if {[regexp -line {^#+(?:!\S+(?: \S+){0,2})? [-\*\s]*(?:en)?coding:? ([\w\-]+)} $buf {} enc]} {
	    return [list -encoding $enc]
	}
    } finally {
	close $f
    }
    return {}
}

# tcltest::runAllTests --
#
#	prints output and sources test files according to the match and
#	skip patterns provided.  after sourcing test files, it goes on
#	to source all.tcl files in matching test subdirectories.
#
# Arguments:

    # Run each of the specified tests
    foreach file [lsort [GetMatchingFiles]] {
	set tail [file tail $file]
	puts [outputChannel] $tail
	flush [outputChannel]

	# get encoding of file (BOM or coding in header):
	set fenc [fileEncoding $file]

	if {[singleProcess]} {
	    if {[catch {
		incr numTestFiles
		uplevel 1 [list ::source {*}$fenc $file]
	    } msg]} {
		puts [outputChannel] "Test file error: $msg"
		# append the name of the test to a list to be reported
		# later
		lappend testFileFailures $file
	    }
	    if {$numTests(Failed) > 0} {

		set value [Configure $opt]
		# Don't bother passing default configuration options
		if {$value eq $DefaultValue($opt)} {
			continue
		}
		lappend childargv $opt $value
	    }
	    set cmd [linsert $childargv 0 | $shell {*}$fenc $file]
	    if {[catch {
		incr numTestFiles
		set pipeFd [open $cmd "r"]
		if {$fullutf} {
		    fconfigure $pipeFd -profile tcl8 -encoding utf-8
		}
		while {[gets $pipeFd line] >= 0} {

# -*- coding: utf-8 -*-
#
# Commands covered:  string
#
# 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 © 1991-1993 The Regents of the University of California.