Check-in [2875c5d69c]
Not logged in

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

Overview
Comment:Make test-output more readable when it contains non-printable characters (stolen from TIP #656 impl, thanks Ashok!) tcltest -> 2.5.6
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256: 2875c5d69c341700fbe0d640f2ded0476469784ed5e1450186ebad85dd576677
User & Date: jan.nijtmans 2023-03-12 11:24:24.791
Context
2023-03-12
11:32
Forgot that \x00 is not printable anyway check-in: 054270394c user: jan.nijtmans tags: core-8-branch
11:28
Merge 8.7 check-in: 1bf875b575 user: jan.nijtmans tags: trunk, main
11:24
Make test-output more readable when it contains non-printable characters (stolen from TIP #656 impl,... check-in: 2875c5d69c user: jan.nijtmans tags: core-8-branch
10:49
Always output 2 hex characters in "unexpected byte sequence" exception message. make testcases io-3... check-in: 6d7be73ba5 user: jan.nijtmans tags: core-8-branch
Changes
Unified Diff Ignore Whitespace Patch
Changes to library/manifest.txt.
8
9
10
11
12
13
14
15
16
17
18
19
20
    0 http            2.10b1  {http http.tcl}
    1 msgcat          1.7.1  {msgcat msgcat.tcl}
    1 opt             0.4.8  {opt optparse.tcl}
    0 cookiejar       0.2.0  {cookiejar cookiejar.tcl}
    0 tcl::idna       1.0.1  {cookiejar idna.tcl}
    0 platform        1.0.19 {platform platform.tcl}
    0 platform::shell 1.1.4  {platform shell.tcl}
    1 tcltest         2.5.5  {tcltest tcltest.tcl}
  } {
    if {$isafe && !$safe} continue
    package ifneeded $package $version  [list source [file join $dir {*}$file]]
  }
}} $dir







|





8
9
10
11
12
13
14
15
16
17
18
19
20
    0 http            2.10b1  {http http.tcl}
    1 msgcat          1.7.1  {msgcat msgcat.tcl}
    1 opt             0.4.8  {opt optparse.tcl}
    0 cookiejar       0.2.0  {cookiejar cookiejar.tcl}
    0 tcl::idna       1.0.1  {cookiejar idna.tcl}
    0 platform        1.0.19 {platform platform.tcl}
    0 platform::shell 1.1.4  {platform shell.tcl}
    1 tcltest         2.5.6  {tcltest tcltest.tcl}
  } {
    if {$isafe && !$safe} continue
    package ifneeded $package $version  [list source [file join $dir {*}$file]]
  }
}} $dir
Changes to library/tcltest/pkgIndex.tcl.
1
2
3
4
5
6
7
8
9
10
11
12
# 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.5.5 [list source [file join $dir tcltest.tcl]]











|
1
2
3
4
5
6
7
8
9
10
11
12
# 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.5.6 [list source [file join $dir tcltest.tcl]]
Changes to library/tcltest/tcltest.tcl.
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

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.5.5

    # 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]








|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

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.5.6

    # 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]

1130
1131
1132
1133
1134
1135
1136

































1137
1138
1139
1140
1141
1142
1143
    if {![info exists testConstraints($n2)]} {
	if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} {
	    testConstraint $n2 0
	}
    }
}


































# tcltest::ConstraintInitializer --
#
#	Get or set a script that when evaluated in the tcltest namespace
#	will return a boolean value with which to initialize the
#	associated constraint.
#
# Arguments:







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
    if {![info exists testConstraints($n2)]} {
	if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} {
	    testConstraint $n2 0
	}
    }
}


# tcltest::Asciify --
#
#       Transforms the passed string to contain only printable ascii characters.
#       Useful for printing to terminals. Non-printables are mapped to
#       \x, \u or \U sequences.
#
# Arguments:
#       s - string to transform
#
# Results:
#       The transformed strings
#
# Side effects:
#       None.

proc tcltest::Asciify {s} {
    set print ""
    foreach c [split $s ""] {
        set i [scan $c %c]
        if {[string is print $c] && ($i <= 127) && ($i > 0)} {
            append print $c
        } elseif {$i <= 0xFF} {
            append print \\x[format %02X $i]
        } elseif {$i <= 0xFFFF} {
            append print \\u[format %04X $i]
        } else {
            append print \\U[format %08X $i]
        }
    }
    return $print
}

# tcltest::ConstraintInitializer --
#
#	Get or set a script that when evaluated in the tcltest namespace
#	will return a boolean value with which to initialize the
#	associated constraint.
#
# Arguments:
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
	    puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)"
	}
    }
    if {$processTest && $scriptFailure} {
	if {$scriptCompare} {
	    puts [outputChannel] "---- Error testing result: $scriptMatch"
	} else {
	    puts [outputChannel] "---- Result was:\n$actualAnswer"
	    puts [outputChannel] "---- Result should have been\
		    ($match matching):\n$result"
	}
    }
    if {$errorCodeFailure} {
	puts [outputChannel] "---- Error code was: '$errorCodeRes(body)'"
	puts [outputChannel] "---- Error code should have been: '$errorCode'"
    }
    if {$codeFailure} {







|

|







2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
	    puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)"
	}
    }
    if {$processTest && $scriptFailure} {
	if {$scriptCompare} {
	    puts [outputChannel] "---- Error testing result: $scriptMatch"
	} else {
	    puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
	    puts [outputChannel] "---- Result should have been\
		    ($match matching):\n[Asciify $result]"
	}
    }
    if {$errorCodeFailure} {
	puts [outputChannel] "---- Error code was: '$errorCodeRes(body)'"
	puts [outputChannel] "---- Error code should have been: '$errorCode'"
    }
    if {$codeFailure} {
Changes to unix/Makefile.in.
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"
	@for i in $(TOP_DIR)/library/opt/*.tcl; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	done
	@echo "Installing package msgcat 1.7.1 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \
		"$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm"
	@echo "Installing package tcltest 2.5.5 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \
		"$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.5.tm"
	@echo "Installing package platform 1.0.19 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \
		"$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm"
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \
		"$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm"
	@echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/"







|

|







1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"
	@for i in $(TOP_DIR)/library/opt/*.tcl; do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	done
	@echo "Installing package msgcat 1.7.1 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \
		"$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm"
	@echo "Installing package tcltest 2.5.6 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \
		"$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.6.tm"
	@echo "Installing package platform 1.0.19 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \
		"$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm"
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module"
	@$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \
		"$(MODULE_INSTALL_DIR)/8.4/platform/shell-1.1.4.tm"
	@echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/"
Changes to win/Makefile.in.
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10b1.tm";
	@echo "Installing package opt 0.4.7";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.7.1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm";
	@echo "Installing package tcltest 2.5.5 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.5.tm";
	@echo "Installing package platform 1.0.19 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm";
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/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"; \







|
|







885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10b1.tm";
	@echo "Installing package opt 0.4.7";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.7.1 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl "$(MODULE_INSTALL_DIR)/8.7/msgcat-1.7.1.tm";
	@echo "Installing package tcltest 2.5.6 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl "$(MODULE_INSTALL_DIR)/8.5/tcltest-2.5.6.tm";
	@echo "Installing package platform 1.0.19 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl "$(MODULE_INSTALL_DIR)/8.4/platform-1.0.19.tm";
	@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/platform/shell.tcl "$(MODULE_INSTALL_DIR)/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"; \