summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/compExpr.test36
-rw-r--r--tests/expr-old.test2
-rw-r--r--tests/expr.test61
-rw-r--r--tests/parseExpr.test8
-rw-r--r--tests/unload.test3
-rw-r--r--tests/winDde.test4
6 files changed, 108 insertions, 6 deletions
diff --git a/tests/compExpr.test b/tests/compExpr.test
index f6fe333..2222b8d 100644
--- a/tests/compExpr.test
+++ b/tests/compExpr.test
@@ -371,10 +371,46 @@ test compExpr-7.2 {[Bug 1869989]: expr parser memleak} -constraints memory -setu
unset end i tmp
rename getbytes {}
} -result 0
+
+proc extract {opcodes descriptor} {
+ set instructions [dict values [dict get $descriptor instructions]]
+ return [lmap i $instructions {
+ if {[lindex $i 0] in $opcodes} {string cat $i} else continue
+ }]
+}
+
+test compExpr-8.1 {TIP 582: expression comments} -setup {} -body {
+ extract {loadStk add} [tcl::unsupported::getbytecode script {expr {
+ $abc
+ # + $def
+ + $ghi
+ }}]
+} -result {loadStk loadStk add}
+test compExpr-8.2 {TIP 582: expression comments} -setup {} -body {
+ extract {loadStk add} [tcl::unsupported::getbytecode script {expr {
+ $abc
+ # + $def
+ # + $ghi }}]
+} -result loadStk
+test compExpr-8.3 {TIP 582: expression comments} -setup {} -body {
+ extract {loadStk add} [tcl::unsupported::getbytecode script {expr {
+ $abc
+ # + $def\
+ + $ghi
+ }}]
+} -result loadStk
+test compExpr-8.4 {TIP 582: expression comments} -setup {} -body {
+ extract {loadStk add} [tcl::unsupported::getbytecode script {expr {
+ $abc
+ # + $def\\
+ + $ghi
+ }}]
+} -result {loadStk loadStk add}
# cleanup
catch {unset a}
catch {unset b}
+catch {rename extract ""}
::tcltest::cleanupTests
return
diff --git a/tests/expr-old.test b/tests/expr-old.test
index ab33e06..1a4278f 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -524,7 +524,7 @@ test expr-old-26.10b {error conditions} ieeeFloatingPoint {
list [catch {expr 2.0/0.0} msg] $msg
} {0 Inf}
test expr-old-26.11 {error conditions} -body {
- expr 2#
+ expr 2`
} -returnCodes error -match glob -result *
test expr-old-26.12 {error conditions} -body {
expr a.b
diff --git a/tests/expr.test b/tests/expr.test
index c185580..9752c53 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -7384,6 +7384,67 @@ foreach v1 $values r1 $results {
}
}
unset -nocomplain values results ctr
+
+test expr-62.1 {TIP 582: comments} -body {
+ expr {1 # + 2}
+} -result 1
+test expr-62.2 {TIP 582: comments} -body {
+ expr "1 #\n+ 2"
+} -result 3
+test expr-62.3 {TIP 582: comments} -setup {
+ set ctr 0
+} -body {
+ expr {
+ # This is a demonstration of a comment
+ 1 + 2 + 3
+ # and another comment
+ + 4 + 5
+ # + [incr ctr]
+ + [incr ctr]
+ }
+} -result 16
+# Buggy because line breaks aren't tracked inside expressions at all
+test expr-62.4 {TIP 582: comments don't hide line breaks} -setup {
+ proc getline {} {
+ dict get [info frame -1] line
+ }
+ set base [getline]
+} -constraints knownBug -body {
+ expr {
+ 0
+ # a comment
+ + [getline] - $base
+ }
+} -cleanup {
+ rename getline ""
+} -result 5
+test expr-62.5 {TIP 582: comments don't splice tokens} {
+ set a False
+ expr {$a#don't splice
+ne#don't splice
+false}
+} 1
+test expr-62.6 {TIP 582: comments don't splice tokens} {
+ expr {0x2#don't splice
+ne#don't splice
+2}
+} 1
+test expr-62.7 {TIP 582: comments can go inside function calls} {
+ expr {max(1,# comment
+ 2)}
+} 2
+test expr-62.8 {TIP 582: comments can go inside function calls} {
+ expr {max(1# comment
+ ,2)}
+} 2
+test expr-62.9 {TIP 582: comments can go inside function calls} {
+ expr {max(# comment
+ 1,2)}
+} 2
+test expr-62.10 {TIP 582: comments can go inside function calls} {
+ expr {max# comment
+ (1,2)}
+} 2
# cleanup
unset -nocomplain a
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index 3fbd14e..74ffd41 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.test
@@ -1075,6 +1075,14 @@ test parseExpr-22.21 {Bug d2ffcca163} -constraints testexprparser -body {
testexprparser in\u0433(0) -1
} -returnCodes error -match glob -result {missing operand*}
+test parseExpr-23.1 {TIP 582: comments} -constraints testexprparser -body {
+ testexprparser "7 # * 8 " -1
+} -result {- {} 0 subexpr 7 1 text 7 0 {}}
+test parseExpr-23.2 {TIP 582: comments} -constraints testexprparser -body {
+ testexprparser "7 #\n* 8 " -1
+} -result {- {} 0 subexpr {7 #
+*} 5 operator # 0 subexpr 7 1 text 7 0 subexpr * 1 text * 0 {}}
+
# cleanup
cleanupTests
return
diff --git a/tests/unload.test b/tests/unload.test
index bab197b..3eb2bf7 100644
--- a/tests/unload.test
+++ b/tests/unload.test
@@ -38,9 +38,6 @@ testConstraint $loaded [expr {![string match *pkgua* $alreadyLoaded]}]
set alreadyTotalLoaded [info loaded]
-# Certain tests require the 'teststaticpkg' command from tcltest
-testConstraint teststaticpkg [llength [info commands teststaticpkg]]
-
# Certain tests need the 'testsimplefilsystem' in tcltest
testConstraint testsimplefilesystem \
[llength [info commands testsimplefilesystem]]
diff --git a/tests/winDde.test b/tests/winDde.test
index d2fb8a0..421578b 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -20,7 +20,7 @@ if {[testConstraint win]} {
if {![catch {
::tcltest::loadTestedCommands
set ::ddever [package require dde 1.4.3]
- set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
+ set ::ddelib [info loaded "" Dde]}]} {
testConstraint dde 1
}
}
@@ -38,7 +38,7 @@ proc createChildProcess {ddeServerName args} {
set f [open $::scriptName w+]
puts $f [list set ddeServerName $ddeServerName]
- puts $f [list load $::ddelib dde]
+ puts $f [list load $::ddelib Dde]
puts $f {
# DDE child server -
#