Check-in [7e733817b3]
Not logged in
Home Timeline Branches Tags Tickets Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Bring back the common facilities of the tcltests "package", but use a less fragile method to gain access to them.
Timelines: family | ancestors | descendants | both | core-8-6-branch
Files: files | file ages | folders
SHA3-256: 7e733817b327b5b182d26027f8052747a591c69049b5d953c709e5aa920fc0ee
User & Date: dgp 2022-11-18 17:53:54.144
Context
2022-11-20
14:16
Newest tests must have most recent releases of http to pass. check-in: a9691d58b3 user: dgp tags: core-8-6-branch
2022-11-18
18:30
merge 8.6 check-in: 056103237b user: dgp tags: core-8-6-13-rc
17:53
Bring back the common facilities of the tcltests "package", but use a less fragile method to gain ac... check-in: 7e733817b3 user: dgp tags: core-8-6-branch
2022-11-14
17:23
Test suite hygiene - Several tests missing the "testdstring" constraint - [package require tclte... check-in: ba1fb66b47 user: dgp tags: core-8-6-branch
Changes
Unified Diff Ignore Whitespace Patch
Changes to tests/chanio.test.
︙︙
30
31
32
33
34
35
36

37
38
39
40
41
42
43

    variable expected

    catch {
	::tcltest::loadTestedCommands
	package require -exact Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    }


    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]
    testConstraint testmainthread   [llength [info commands testmainthread]]
    testConstraint testservicemode  [llength [info commands testservicemode]]








>








30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

    variable expected

    catch {
	::tcltest::loadTestedCommands
	package require -exact Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    }
    source [file join [file dirname [info script]] tcltests.tcl]

    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]
    testConstraint testmainthread   [llength [info commands testmainthread]]
    testConstraint testservicemode  [llength [info commands testservicemode]]
︙︙
Changes to tests/env.test.
︙︙
11
12
13
14
15
16
17


18
19
20
21
22
23
24

# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}



# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript
    catch {exec [interpreter] $printenvScript} out
    if {$out eq "child process exited abnormally"} {








>
>








11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

source [file join [file dirname [info script]] tcltests.tcl]

# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript
    catch {exec [interpreter] $printenvScript} out
    if {$out eq "child process exited abnormally"} {
︙︙
Changes to tests/exec.test.
︙︙
14
15
16
17
18
19
20

21
22
23
24
25
26
27
28
29
30
31

# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


# All tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
# Some skips when running in a macOS CI environment
testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}]

unset -nocomplain path

# Utilities that are like bourne shell stalwarts, but cross-platform.
set path(echo) [makeFile {








>

<
<
<








14
15
16
17
18
19
20
21
22



23
24
25
26
27
28
29

# There is no point in running Valgrind on cases where [exec] forks but then
# fails and the child process doesn't go through full cleanup.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]




# Some skips when running in a macOS CI environment
testConstraint noosxCI [expr {![info exists ::env(MAC_CI)]}]

unset -nocomplain path

# Utilities that are like bourne shell stalwarts, but cross-platform.
set path(echo) [makeFile {
︙︙
Changes to tests/fileSystemEncoding.test.
︙︙
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

    if {"::tcltest" ni [namespace children]} {
	package require tcltest 2.5
	namespace import -force ::tcltest::*
    }

    variable fname1 \u767b\u9e1b\u9d72\u6a13

    proc autopath {} {
	global auto_path
	set scriptpath [info script]
	set scriptpathnorm [file dirname [file normalize $scriptpath/...]]
	set dirnorm [file dirname $scriptpathnorm]
	set idx [lsearch -exact $auto_path $dirnorm]
	if {$idx >= 0} {
	    set auto_path [lreplace $auto_path[set auto_path {}] $idx $idx {}]
	}
	set auto_path [linsert $auto_path[set auto_path {}] 0 0 $dirnorm]
    }
    autopath

    package require tcltests

    test filesystemEncoding-1.0 {
	issue bcd100410465
    } -body {
	set dir [tcltests::tempdir]
	set saved [encoding system]
	encoding system iso8859-1








<
<
<
<
<
<
<
<
<
<
<
<
|
<








11
12
13
14
15
16
17












18

19
20
21
22
23
24
25

    if {"::tcltest" ni [namespace children]} {
	package require tcltest 2.5
	namespace import -force ::tcltest::*
    }

    variable fname1 \u767b\u9e1b\u9d72\u6a13













    source [file join [file dirname [info script]] tcltests.tcl]


    test filesystemEncoding-1.0 {
	issue bcd100410465
    } -body {
	set dir [tcltests::tempdir]
	set saved [encoding system]
	encoding system iso8859-1
︙︙
Changes to tests/io.test.
︙︙
30
31
32
33
34
35
36

37
38
39
40
41
42
43

    variable expected

    catch {
	::tcltest::loadTestedCommands
	package require -exact Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    }


testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread   [llength [info commands testmainthread]]
testConstraint testobj		[llength [info commands testobj]]








>








30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

    variable expected

    catch {
	::tcltest::loadTestedCommands
	package require -exact Tcltest [info patchlevel]
	set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
    }
    source [file join [file dirname [info script]] tcltests.tcl]

testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread   [llength [info commands testmainthread]]
testConstraint testobj		[llength [info commands testobj]]
︙︙
Changes to tests/ioCmd.test.
︙︙
13
14
15
16
17
18
19

20
21
22
23
24
25
26

# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Custom constraints used in this file
testConstraint testchannel	[llength [info commands testchannel]]









>








13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
source [file join [file dirname [info script]] tcltests.tcl]

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Custom constraints used in this file
testConstraint testchannel	[llength [info commands testchannel]]
︙︙
Changes to tests/platform.test. 
1
2
3
4
5
6
7
8
9
10
11
12

13
14
15
16
17
18
19

# The file tests the tcl_platform variable and platform package.
#
# 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) 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.

package require tcltest 2.5


namespace eval ::tcl::test::platform {
    namespace import ::tcltest::testConstraint
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests

    # This is not how [variable] works. See TIP 276.













>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

# The file tests the tcl_platform variable and platform package.
#
# 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) 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.

package require tcltest 2.5
source [file join [file dirname [info script]] tcltests.tcl]

namespace eval ::tcl::test::platform {
    namespace import ::tcltest::testConstraint
    namespace import ::tcltest::test
    namespace import ::tcltest::cleanupTests

    # This is not how [variable] works. See TIP 276.
︙︙
Changes to tests/tcltests.tcl. 
1



2
3
4
5
6
7
8

#! /usr/bin/env tclsh




package require tcltest 2.5
namespace import ::tcltest::*

testConstraint exec          [llength [info commands exec]]
testConstraint fcopy         [llength [info commands fcopy]]
testConstraint fileevent     [llength [info commands fileevent]]


>
>
>








1
2
3
4
5
6
7
8
9
10
11

#! /usr/bin/env tclsh

# Don't overwrite tcltests facilities already present
if {[package provide tcltests] ne {}} return

package require tcltest 2.5
namespace import ::tcltest::*

testConstraint exec          [llength [info commands exec]]
testConstraint fcopy         [llength [info commands fcopy]]
testConstraint fileevent     [llength [info commands fileevent]]
︙︙
Changes to tests/thread.test.
︙︙
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.


#  when thread::release is used, -wait is passed in order allow the thread to
#  be fully finalized, which avoids valgrind "still reachable" reports.

package require tcltest 2.5
namespace import ::tcltest::*

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] ne {}}]








|








12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.


#  when thread::release is used, -wait is passed in order allow the thread to
#  be fully finalized, which avoids valgrind "still reachable" reports.

package require tcltest 2.5
source [file join [file dirname [info script]] tcltests.tcl]

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] ne {}}]
︙︙
This page was created in about 0.056s by Fossil version [1205ec86cb] 2025-04-30 16:57:32