summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/fileName.test6
-rw-r--r--tests/fileSystem.test2
-rw-r--r--tests/format.test7
-rw-r--r--tests/http.test16
-rw-r--r--tests/string.test4
-rw-r--r--tests/winDde.test57
6 files changed, 59 insertions, 33 deletions
diff --git a/tests/fileName.test b/tests/fileName.test
index 19503f8..6dd1cb4 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -199,7 +199,7 @@ test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} {
test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split //foo
-} "[file split //] foo"
+} "/ foo"
test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} {
testsetplatform unix
file split foo//bar
@@ -436,11 +436,11 @@ test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} {
test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join //a b
-} "[file split //]a/b"
+} "/a/b"
test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} {
testsetplatform unix
file join /// a b
-} "[file split //]a/b"
+} "/a/b"
test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} {
testsetplatform win
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 9469af0..38ecbee 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -484,7 +484,7 @@ test filesystem-6.22 {empty file name} {file pathtype ""} relative
test filesystem-6.23 {empty file name} {file readable ""} 0
test filesystem-6.24 {empty file name} -returnCodes error -body {
file readlink ""
-} -result {could not readlink "": no such file or directory}
+} -result {could not read link "": no such file or directory}
test filesystem-6.25 {empty file name} -returnCodes error -body {
file rename "" ""
} -result {error renaming "": no such file or directory}
diff --git a/tests/format.test b/tests/format.test
index 2d53eba..27eac31 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -549,10 +549,7 @@ test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} {
list [format %08x $a] [expr {$a == $b}]
} {aaaaaaab 1}
-test format-19.1 {
- regression test - tcl-core message by Brian Griffin on
- 26 0ctober 2004
-} -body {
+test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body {
set x 0x8fedc654
list [expr { ~ $x }] [format %08x [expr { ~$x }]]
} -match regexp -result {-2414724693 f*701239ab}
@@ -569,7 +566,7 @@ test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body {
format %s $x
# After this, obj in $x should be a dict with a non-NULL bytes field
tcl::unsupported::representation $x
-} -match glob -result {value is a dict with *, string representation "*".}
+} -match glob -result {value is a dict with *, string representation "*"}
# cleanup
catch {unset a}
diff --git a/tests/http.test b/tests/http.test
index fe44b47..bde5795 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -392,11 +392,19 @@ Content-Type {text/plain;charset=utf-8}
Accept-Encoding .*
Content-Length 5}
test http-3.29 "http::geturl $ipv6url" -body {
- set token [http::geturl $ipv6url -validate 1]
- http::code $token
+ # We only want to see if the URL gets parsed correctly. This is
+ # the case if http::geturl succeeds or returns a socket related
+ # error. If the parsing is wrong, we'll get a parse error.
+ # It'd be better to separate the URL parser from http::geturl, so
+ # that it can be tested without also trying to make a connection.
+ set error [catch {http::geturl $ipv6url -validate 1} token]
+ if {$error && [string match "couldn't open socket: *" $token]} {
+ set error 0
+ }
+ set error
} -cleanup {
- http::cleanup $token
-} -result "HTTP/1.0 200 OK"
+ catch { http::cleanup $token }
+} -result 0
test http-4.1 {http::Event} -body {
set token [http::geturl $url -keepalive 0]
diff --git a/tests/string.test b/tests/string.test
index 8cacd07..e86c0de 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -1776,10 +1776,10 @@ test string-26.3.1 {tcl::prefix, bad args} -body {
} -returnCodes 1 -result {error options must have an even number of elements}
test string-26.3.2 {tcl::prefix, bad args} -body {
tcl::prefix match -error str1 str2
-} -returnCodes 1 -result {missing error options}
+} -returnCodes 1 -result {missing value for -error}
test string-26.4 {tcl::prefix, bad args} -body {
tcl::prefix match -message str1 str2
-} -returnCodes 1 -result {missing message}
+} -returnCodes 1 -result {missing value for -message}
test string-26.5 {tcl::prefix} {
tcl::prefix match {apa bepa cepa depa} cepa
} cepa
diff --git a/tests/winDde.test b/tests/winDde.test
index 9e0b20a..8d9bd12 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -15,6 +15,7 @@ if {"::tcltest" ni [namespace children]} {
namespace import -force ::tcltest::*
}
+testConstraint debug [::tcl::pkgconfig get debug]
testConstraint dde 0
if {[testConstraint win]} {
if {![catch {
@@ -139,33 +140,43 @@ test winDde-3.2 {DDE execute -async locally} -constraints dde -body {
set \xe1
} -result foo
test winDde-3.3 {DDE request locally} -constraints dde -body {
- set a ""
- dde execute TclEval self [list set a foo]
- dde request TclEval self a
+ set \xe1 ""
+ dde execute TclEval self [list set \xe1 foo]
+ dde request TclEval self \xe1
} -result foo
test winDde-3.4 {DDE eval locally} -constraints dde -body {
set \xe1 ""
dde eval self set \xe1 foo
} -result foo
test winDde-3.5 {DDE request locally} -constraints dde -body {
- set a ""
- dde execute TclEval self [list set a foo]
- dde request -binary TclEval self a
+ set \xe1 ""
+ dde execute TclEval self [list set \xe1 foo]
+ dde request -binary TclEval self \xe1
} -result "foo\x00"
# Set variable a to A with diaeresis (unicode C4) by relying on the fact
# that utf8 is sent (e.g. "c3 84" on the wire)
test winDde-3.6 {DDE request utf8} -constraints dde -body {
- set a "not set"
- dde execute TclEval self "set a \xc4"
- scan $a %c
+ set \xe1 "not set"
+ dde execute TclEval self "set \xe1 \xc4"
+ scan [set \xe1] %c
} -result 196
# Set variable a to A with diaeresis (unicode C4) using binary execute
# and compose utf-8 (e.g. "c3 84" ) manualy
test winDde-3.7 {DDE request binary} -constraints dde -body {
- set a "not set"
- dde execute -binary TclEval self [list set a \xc3\x84\x00]
- scan $a %c
+ set \xe1 "not set"
+ dde execute -binary TclEval self [list set \xc3\xa1 \xc3\x84\x00]
+ scan [set \xe1] %c
} -result 196
+test winDde-3.8 {DDE poke locally} -constraints {dde debug} -body {
+ set \xe1 ""
+ dde poke TclEval self \xe1 \xc4
+ dde request TclEval self \xe1
+} -result \xc4
+test winDde-3.9 {DDE poke -binary locally} -constraints {dde debug} -body {
+ set \xe1 ""
+ dde poke -binary TclEval self \xe1 \xc3\x84\x00
+ dde request TclEval self \xe1
+} -result \xc4
# -------------------------------------------------------------------------
@@ -189,24 +200,34 @@ test winDde-4.2 {DDE execute async remotely} -constraints {dde stdio} -body {
set \xe1
} -result ""
test winDde-4.3 {DDE request remotely} -constraints {dde stdio} -body {
- set a ""
+ set \xe1 ""
set name ch\xEDld-4.3
set child [createChildProcess $name]
dde execute TclEval $name [list set a foo]
- set a [dde request TclEval $name a]
+ set \xe1 [dde request TclEval $name a]
dde execute TclEval $name {set done 1}
update
- set a
+ set \xe1
} -result foo
test winDde-4.4 {DDE eval remotely} -constraints {dde stdio} -body {
- set a ""
+ set \xe1 ""
set name ch\xEDld-4.4
set child [createChildProcess $name]
- set a [dde eval $name set a foo]
+ set \xe1 [dde eval $name set \xe1 foo]
dde execute TclEval $name {set done 1}
update
- set a
+ set \xe1
} -result foo
+test winDde-4.5 {DDE poke remotely} -constraints {dde debug stdio} -body {
+ set \xe1 ""
+ set name ch\xEDld-4.5
+ set child [createChildProcess $name]
+ dde poke TclEval $name \xe1 foo
+ set \xe1 [dde request TclEval $name \xe1]
+ dde execute TclEval $name {set done 1}
+ update
+ set \xe1
+} -result foo
# -------------------------------------------------------------------------
generated by cgit v0.12 at 2025-01-06 08:26:21 (GMT)