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 (c) 1991-1993 The Regents of the University of California.

    run {string equal -length 2 abcde abxyz}
} 1
test string-3.15.$noComp {string equal with special index} {
    list [catch {run {string equal -length end-3 abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}

test string-3.16.$noComp {string equal, unicode} {
    run {string equal ab牦 ab牧}
} 0
test string-3.17.$noComp {string equal, unicode} {
    run {string equal Ü Ü}
} 1
test string-3.18.$noComp {string equal, unicode} {
    run {string equal Ü ü}
} 0
test string-3.19.$noComp {string equal, unicode} {
    run {string equal ÜÜÜüü ÜÜÜÜÜ}
} 0
test string-3.20.$noComp {string equal, high bit} {
    # This test fails if the underlying comparison
    # is using signed chars instead of unsigned chars.
    # (like SunOS's default memcmp thus the compat/memcmp.c)
    run {string equal "\x80" "@"}
    # Nb this tests works also in utf8 space because \x80 is
    # translated into a 2 or more bytelength but whose first byte has
    # the high bit set.
} 0
test string-3.21.$noComp {string equal -nocase} {
    run {string equal -nocase abcde Abdef}
} 0
test string-3.22.$noComp {string equal, -nocase unicode} {
    run {string equal -nocase Ü Ü}
} 1
test string-3.23.$noComp {string equal, -nocase unicode} {
    run {string equal -nocase ÜÜÜüü ÜÜÜÜÜ}
} 1
test string-3.24.$noComp {string equal -nocase with length} {
    run {string equal -length 2 -nocase abcde Abxyz}
} 1
test string-3.25.$noComp {string equal -nocase with length} {
    run {string equal -nocase -length 3 abcde Abxyz}
} 0
test string-3.26.$noComp {string equal -nocase with length <= 0} {
    run {string equal -nocase -length -1 abcde AbCdEf}
} 0
test string-3.27.$noComp {string equal -nocase with excessive length} {
    run {string equal -nocase -length 50 AbCdEf abcde}
} 0
test string-3.28.$noComp {string equal -len unicode} {
    # These are strings that are 6 BYTELENGTH long, but the length
    # shouldn't make a different because there are actually 3 CHARS long
    run {string equal -len 5 ÜÜÜ ÜÜü}
} 0
test string-3.29.$noComp {string equal -nocase with special index} {
    list [catch {run {string equal -nocase -length end-3 Abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
test string-3.30.$noComp {string equal, null strings} {
    run {string equal "" ""}
} 1