summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2022-10-20 15:16:28 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2022-10-20 15:16:28 (GMT)
commitc541afcd1abf1c09cd079d8b50a7abd33b8dc739 (patch)
treebdba54c93d7da4fdf8174ba7c37a4db4d8bb84c4 /tests
parent23900950d5ad3b15b790aacb18f9e0220836b132 (diff)
parenta344103b2df59b2fbd11188bb6b16293aa44c8ca (diff)
downloadtcl-c541afcd1abf1c09cd079d8b50a7abd33b8dc739.zip
tcl-c541afcd1abf1c09cd079d8b50a7abd33b8dc739.tar.gz
tcl-c541afcd1abf1c09cd079d8b50a7abd33b8dc739.tar.bz2
Merge 8.7
Diffstat (limited to 'tests')
-rw-r--r--tests/assemble.test2
-rw-r--r--tests/compExpr-old.test25
-rw-r--r--tests/execute.test22
-rw-r--r--tests/expr-old.test65
-rw-r--r--tests/expr.test56
-rw-r--r--tests/http.test6
-rw-r--r--tests/io.test22
-rw-r--r--tests/ioCmd.test10
-rw-r--r--tests/mathop.test194
-rw-r--r--tests/safe-stock.test206
-rw-r--r--tests/safe-zipfs.test406
-rw-r--r--tests/safe.test1952
-rw-r--r--tests/socket.test2
-rw-r--r--tests/while-old.test2
-rw-r--r--tests/while.test4
15 files changed, 2589 insertions, 385 deletions
diff --git a/tests/assemble.test b/tests/assemble.test
index 55124d0..b656894 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -781,7 +781,7 @@ test assemble-7.43 {uplus} {
}
}
-returnCodes error
- -result {can't use non-numeric floating-point value as operand of "+"}
+ -result {can't use non-numeric floating-point value "NaN" as operand of "+"}
}
test assemble-7.43.1 {tryCvtToNumeric} {
-body {
diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test
index b70e65c..40dea76 100644
--- a/tests/compExpr-old.test
+++ b/tests/compExpr-old.test
@@ -280,10 +280,10 @@ test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
} -returnCodes error -match glob -result *
test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {24.0^3}} msg] $msg
-} {1 {can't use floating-point value as operand of "^"}}
+} {1 {can't use floating-point value "24.0" as operand of "^"}}
test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {"a"^"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "^"}}
+} {1 {can't use non-numeric string "a" as operand of "^"}}
test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
@@ -304,10 +304,10 @@ test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
} -returnCodes error -match glob -result *
test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {24.0&3}} msg] $msg
-} {1 {can't use floating-point value as operand of "&"}}
+} {1 {can't use floating-point value "24.0" as operand of "&"}}
test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {"a"&"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "&"}}
+} {1 {can't use non-numeric string "a" as operand of "&"}}
test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1
@@ -365,10 +365,10 @@ test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body {
} -returnCodes error -match glob -result *
test compExpr-old-10.10 {CompileShiftExpr: runtime error} {
list [catch {expr {24.0>>43}} msg] $msg
-} {1 {can't use floating-point value as operand of ">>"}}
+} {1 {can't use floating-point value "24.0" as operand of ">>"}}
test compExpr-old-10.11 {CompileShiftExpr: runtime error} {
list [catch {expr {"a"<<"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "<<"}}
+} {1 {can't use non-numeric string "a" as operand of "<<"}}
test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
@@ -387,10 +387,10 @@ test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body {
} -returnCodes error -match glob -result *
test compExpr-old-11.10 {CompileAddExpr: runtime error} {
list [catch {expr {24.0+"xx"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string "xx" as operand of "+"}}
test compExpr-old-11.11 {CompileAddExpr: runtime error} {
list [catch {expr {"a"-"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "-"}}
+} {1 {can't use non-numeric string "a" as operand of "-"}}
test compExpr-old-11.12 {CompileAddExpr: runtime error} {
list [catch {expr {3/0}} msg] $msg
} {1 {divide by zero}}
@@ -418,10 +418,10 @@ test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body
} -returnCodes error -match glob -result *
test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} {
list [catch {expr {24.0*"xx"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "*"}}
+} {1 {can't use non-numeric string "xx" as operand of "*"}}
test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} {
list [catch {expr {"a"/"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "/"}}
+} {1 {can't use non-numeric string "a" as operand of "/"}}
test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
@@ -439,10 +439,10 @@ test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
} -returnCodes error -match glob -result *
test compExpr-old-13.10 {CompileUnaryExpr: runtime error} {
list [catch {expr {~"xx"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "~"}}
+} {1 {can't use non-numeric string "xx" as operand of "~"}}
test compExpr-old-13.11 {CompileUnaryExpr: runtime error} {
list [catch {expr ~4.0} msg] $msg
-} {1 {can't use floating-point value as operand of "~"}}
+} {1 {can't use floating-point value "4.0" as operand of "~"}}
test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} {
set a 27
@@ -590,6 +590,7 @@ test compExpr-old-15.5 {CompileMathFuncCall: not enough arguments} -body {
test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
expr sin(1
} -returnCodes error -match glob -result *
+
test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
catch {unset a}
set a(VALUE) ff15
diff --git a/tests/execute.test b/tests/execute.test
index d86ad0e..8702de6 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -179,7 +179,7 @@ test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj}
test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {$x + 1}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string "foo" as operand of "+"}}
test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {
set x [testintobj set 0 1]
expr {1 + $x}
@@ -204,7 +204,7 @@ test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj}
test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {1 + $x}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string "foo" as operand of "+"}}
# INST_SUB is partially tested:
test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {
@@ -231,7 +231,7 @@ test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj}
test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {$x - 1}} msg] $msg
-} {1 {can't use non-numeric string as operand of "-"}}
+} {1 {can't use non-numeric string "foo" as operand of "-"}}
test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {
set x [testintobj set 0 1]
expr {1 - $x}
@@ -256,7 +256,7 @@ test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj}
test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {1 - $x}} msg] $msg
-} {1 {can't use non-numeric string as operand of "-"}}
+} {1 {can't use non-numeric string "foo" as operand of "-"}}
# INST_MULT is partially tested:
test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {
@@ -283,7 +283,7 @@ test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj
test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {$x * 1}} msg] $msg
-} {1 {can't use non-numeric string as operand of "*"}}
+} {1 {can't use non-numeric string "foo" as operand of "*"}}
test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {
set x [testintobj set 1 1]
expr {1 * $x}
@@ -308,7 +308,7 @@ test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj
test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {1 * $x}} msg] $msg
-} {1 {can't use non-numeric string as operand of "*"}}
+} {1 {can't use non-numeric string "foo" as operand of "*"}}
# INST_DIV is partially tested:
test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {
@@ -335,7 +335,7 @@ test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj}
test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {$x / 1}} msg] $msg
-} {1 {can't use non-numeric string as operand of "/"}}
+} {1 {can't use non-numeric string "foo" as operand of "/"}}
test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {
set x [testintobj set 1 1]
expr {2 / $x}
@@ -360,7 +360,7 @@ test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj}
test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {1 / $x}} msg] $msg
-} {1 {can't use non-numeric string as operand of "/"}}
+} {1 {can't use non-numeric string "foo" as operand of "/"}}
# INST_UPLUS is partially tested:
test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
@@ -387,7 +387,7 @@ test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj
test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {+ $x}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string "foo" as operand of "+"}}
# INST_UMINUS is partially tested:
test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
@@ -414,7 +414,7 @@ test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testob
test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {- $x}} msg] $msg
-} {1 {can't use non-numeric string as operand of "-"}}
+} {1 {can't use non-numeric string "foo" as operand of "-"}}
# INST_LNOT is partially tested:
test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
@@ -462,7 +462,7 @@ test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj}
test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {! $x}} msg] $msg
-} {1 {can't use non-numeric string as operand of "!"}}
+} {1 {can't use non-numeric string "foo" as operand of "!"}}
# INST_BITNOT not tested
# INST_CALL_BUILTIN_FUNC1 not tested
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 676443a..2401bd4 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -194,34 +194,34 @@ test expr-old-2.38 {floating-point operators} {
test expr-old-3.1 {illegal floating-point operations} {
list [catch {expr ~4.0} msg] $msg
-} {1 {can't use floating-point value as operand of "~"}}
+} {1 {can't use floating-point value "4.0" as operand of "~"}}
test expr-old-3.2 {illegal floating-point operations} {
list [catch {expr 27%4.0} msg] $msg
-} {1 {can't use floating-point value as operand of "%"}}
+} {1 {can't use floating-point value "4.0" as operand of "%"}}
test expr-old-3.3 {illegal floating-point operations} {
list [catch {expr 27.0%4} msg] $msg
-} {1 {can't use floating-point value as operand of "%"}}
+} {1 {can't use floating-point value "27.0" as operand of "%"}}
test expr-old-3.4 {illegal floating-point operations} {
list [catch {expr 1.0<<3} msg] $msg
-} {1 {can't use floating-point value as operand of "<<"}}
+} {1 {can't use floating-point value "1.0" as operand of "<<"}}
test expr-old-3.5 {illegal floating-point operations} {
list [catch {expr 3<<1.0} msg] $msg
-} {1 {can't use floating-point value as operand of "<<"}}
+} {1 {can't use floating-point value "1.0" as operand of "<<"}}
test expr-old-3.6 {illegal floating-point operations} {
list [catch {expr 24.0>>3} msg] $msg
-} {1 {can't use floating-point value as operand of ">>"}}
+} {1 {can't use floating-point value "24.0" as operand of ">>"}}
test expr-old-3.7 {illegal floating-point operations} {
list [catch {expr 24>>3.0} msg] $msg
-} {1 {can't use floating-point value as operand of ">>"}}
+} {1 {can't use floating-point value "3.0" as operand of ">>"}}
test expr-old-3.8 {illegal floating-point operations} {
list [catch {expr 24&3.0} msg] $msg
-} {1 {can't use floating-point value as operand of "&"}}
+} {1 {can't use floating-point value "3.0" as operand of "&"}}
test expr-old-3.9 {illegal floating-point operations} {
list [catch {expr 24.0|3} msg] $msg
-} {1 {can't use floating-point value as operand of "|"}}
+} {1 {can't use floating-point value "24.0" as operand of "|"}}
test expr-old-3.10 {illegal floating-point operations} {
list [catch {expr 24.0^3} msg] $msg
-} {1 {can't use floating-point value as operand of "^"}}
+} {1 {can't use floating-point value "24.0" as operand of "^"}}
# Check the string operators individually.
@@ -262,46 +262,46 @@ test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar
test expr-old-5.1 {illegal string operations} {
list [catch {expr {-"a"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "-"}}
+} {1 {can't use non-numeric string "a" as operand of "-"}}
test expr-old-5.2 {illegal string operations} {
list [catch {expr {+"a"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string "a" as operand of "+"}}
test expr-old-5.3 {illegal string operations} {
list [catch {expr {~"a"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "~"}}
+} {1 {can't use non-numeric string "a" as operand of "~"}}
test expr-old-5.4 {illegal string operations} {
list [catch {expr {!"a"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "!"}}
+} {1 {can't use non-numeric string "a" as operand of "!"}}
test expr-old-5.5 {illegal string operations} {
list [catch {expr {"a"*"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "*"}}
+} {1 {can't use non-numeric string "a" as operand of "*"}}
test expr-old-5.6 {illegal string operations} {
list [catch {expr {"a"/"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "/"}}
+} {1 {can't use non-numeric string "a" as operand of "/"}}
test expr-old-5.7 {illegal string operations} {
list [catch {expr {"a"%"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "%"}}
+} {1 {can't use non-numeric string "a" as operand of "%"}}
test expr-old-5.8 {illegal string operations} {
list [catch {expr {"a"+"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string "a" as operand of "+"}}
test expr-old-5.9 {illegal string operations} {
list [catch {expr {"a"-"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "-"}}
+} {1 {can't use non-numeric string "a" as operand of "-"}}
test expr-old-5.10 {illegal string operations} {
list [catch {expr {"a"<<"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "<<"}}
+} {1 {can't use non-numeric string "a" as operand of "<<"}}
test expr-old-5.11 {illegal string operations} {
list [catch {expr {"a">>"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of ">>"}}
+} {1 {can't use non-numeric string "a" as operand of ">>"}}
test expr-old-5.12 {illegal string operations} {
list [catch {expr {"a"&"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "&"}}
+} {1 {can't use non-numeric string "a" as operand of "&"}}
test expr-old-5.13 {illegal string operations} {
list [catch {expr {"a"^"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "^"}}
+} {1 {can't use non-numeric string "a" as operand of "^"}}
test expr-old-5.14 {illegal string operations} {
list [catch {expr {"a"|"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "|"}}
+} {1 {can't use non-numeric string "a" as operand of "|"}}
test expr-old-5.15 {illegal string operations} {
list [catch {expr {"a"&&"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
@@ -490,7 +490,7 @@ test expr-old-25.20 {type conversions} {expr 10.0} 10.0
test expr-old-26.1 {error conditions} {
list [catch {expr 2+"a"} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string "a" as operand of "+"}}
test expr-old-26.2 {error conditions} -body {
expr 2+4*
} -returnCodes error -match glob -result *
@@ -504,10 +504,10 @@ test expr-old-26.4 {error conditions} {
set a xx
test expr-old-26.5 {error conditions} {
list [catch {expr {2+$a}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string "xx" as operand of "+"}}
test expr-old-26.6 {error conditions} {
list [catch {expr {2+[set a]}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string "xx" as operand of "+"}}
test expr-old-26.7 {error conditions} -body {
expr {2+(4}
} -returnCodes error -match glob -result *
@@ -531,7 +531,7 @@ test expr-old-26.12 {error conditions} -body {
} -returnCodes error -match glob -result *
test expr-old-26.13 {error conditions} {
list [catch {expr {"a"/"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "/"}}
+} {1 {can't use non-numeric string "a" as operand of "/"}}
test expr-old-26.14 {error conditions} -body {
expr 2:3
} -returnCodes error -match glob -result *
@@ -943,13 +943,14 @@ test expr-old-34.15 {errors in math functions} {
test expr-old-34.16 {errors in math functions} {
expr round(-1.0e30)
} -1000000000000000019884624838656
+
test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
expr 0o289
} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
set x 0o289
list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use invalid octal number as operand of "+"}}
+} {1 {can't use invalid octal number "0o289" as operand of "+"}}
test expr-old-36.3 {ExprLooksLikeInt procedure} {
list [catch {expr 0289.1} msg] $msg
} {0 289.1}
@@ -989,11 +990,11 @@ test expr-old-36.11 {ExprLooksLikeInt procedure} {
test expr-old-36.12 {ExprLooksLikeInt procedure} {
set x "10;"
list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string "10;" as operand of "+"}}
test expr-old-36.13 {ExprLooksLikeInt procedure} {
set x " +"
list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string " +" as operand of "+"}}
test expr-old-36.14 {ExprLooksLikeInt procedure} {
set x "123456789012345678901234567890 "
expr {$x+1}
@@ -1001,7 +1002,7 @@ test expr-old-36.14 {ExprLooksLikeInt procedure} {
test expr-old-36.15 {ExprLooksLikeInt procedure} {
set x "0o99 "
list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use invalid octal number as operand of "+"}}
+} {1 {can't use invalid octal number "0o99 " as operand of "+"}}
test expr-old-36.16 {ExprLooksLikeInt procedure} {
set x " 0xffffffffffffffffffffffffffffffffffffff "
expr {$x+1}
diff --git a/tests/expr.test b/tests/expr.test
index 32706d9..25a02e3 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -138,9 +138,9 @@ proc do_twelve_days {} {
catch {unset a b i x}
-test expr-1.1 {TclCompileExprCmd: no expression} {
- list [catch {expr } msg] $msg
-} {1 {wrong # args: should be "expr arg ?arg ...?"}}
+test expr-1.1 {TclCompileExprCmd: no expression} -body {
+ expr
+} -returnCodes error -result {wrong # args: should be "expr arg ?arg ...?"}
test expr-1.2 {TclCompileExprCmd: one expression word} {
expr -25
} -25
@@ -187,12 +187,12 @@ test expr-1.13 {TclCompileExprCmd: second level of substitutions in expr not in
} foo
test expr-1.14 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
set a xxx
- set x 2; set b {$x}; set a [expr $b == 2]
+ set x 2; set b {$x}; set a [expr $b==2]
set a
} 1
test expr-1.15 {TclCompileExprCmd: second level of substitutions in expr with comparison as top-level operator} {
set a xxx
- set x 2; set b {$x}; set a [expr $b eq 2]
+ set x 2; set b {$x}; set a [expr "$b eq 2"]
set a
} 1
@@ -252,7 +252,7 @@ test expr-4.9 {CompileLorExpr: long lor arm} {
} 1
test expr-4.10 {CompileLorExpr: error compiling ! operand} {
list [catch {expr {!"a"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "!"}}
+} {1 {can't use non-numeric string "a" as operand of "!"}}
test expr-4.11 {CompileLorExpr: error compiling land arms} {
list [catch {expr {"a"||0}} msg] $msg
} {1 {expected boolean value but got "a"}}
@@ -299,10 +299,10 @@ test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
} -returnCodes error -match glob -result *
test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {24.0^3}} msg] $msg
-} {1 {can't use floating-point value as operand of "^"}}
+} {1 {can't use floating-point value "24.0" as operand of "^"}}
test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {"a"^"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "^"}}
+} {1 {can't use non-numeric string "a" as operand of "^"}}
test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
@@ -323,10 +323,10 @@ test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
} -returnCodes error -match glob -result *
test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {24.0&3}} msg] $msg
-} {1 {can't use floating-point value as operand of "&"}}
+} {1 {can't use floating-point value "24.0" as operand of "&"}}
test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {"a"&"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "&"}}
+} {1 {can't use non-numeric string "a" as operand of "&"}}
test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0
test expr-7.20 {CompileBitAndExpr: error in equality expr} -body {
@@ -468,10 +468,10 @@ test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body {
} -returnCodes error -match glob -result *
test expr-10.10 {CompileShiftExpr: runtime error} {
list [catch {expr {24.0>>43}} msg] $msg
-} {1 {can't use floating-point value as operand of ">>"}}
+} {1 {can't use floating-point value "24.0" as operand of ">>"}}
test expr-10.11 {CompileShiftExpr: runtime error} {
list [catch {expr {"a"<<"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "<<"}}
+} {1 {can't use non-numeric string "a" as operand of "<<"}}
test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
@@ -490,10 +490,10 @@ test expr-11.9 {CompileAddExpr: error compiling add arm} -body {
} -returnCodes error -match glob -result *
test expr-11.10 {CompileAddExpr: runtime error} {
list [catch {expr {24.0+"xx"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string "xx" as operand of "+"}}
test expr-11.11 {CompileAddExpr: runtime error} {
list [catch {expr {"a"-"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "-"}}
+} {1 {can't use non-numeric string "a" as operand of "-"}}
test expr-11.12 {CompileAddExpr: runtime error} {
list [catch {expr {3/0}} msg] $msg
} {1 {divide by zero}}
@@ -521,10 +521,10 @@ test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
} -returnCodes error -match glob -result *
test expr-12.10 {CompileMultiplyExpr: runtime error} {
list [catch {expr {24.0*"xx"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "*"}}
+} {1 {can't use non-numeric string "xx" as operand of "*"}}
test expr-12.11 {CompileMultiplyExpr: runtime error} {
list [catch {expr {"a"/"b"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "/"}}
+} {1 {can't use non-numeric string "a" as operand of "/"}}
test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
@@ -541,10 +541,10 @@ test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
} -returnCodes error -match glob -result *
test expr-13.10 {CompileUnaryExpr: runtime error} {
list [catch {expr {~"xx"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "~"}}
+} {1 {can't use non-numeric string "xx" as operand of "~"}}
test expr-13.11 {CompileUnaryExpr: runtime error} {
list [catch {expr ~4.0} msg] $msg
-} {1 {can't use floating-point value as operand of "~"}}
+} {1 {can't use floating-point value "4.0" as operand of "~"}}
test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
test expr-13.13 {CompileUnaryExpr: just primary expr} {
set a 27
@@ -821,15 +821,15 @@ test expr-21.13 {non-numeric boolean literals} -body {
} -returnCodes error -match glob -result *
test expr-21.14 {non-numeric boolean literals} {
list [catch {expr !"truef"} err] $err
-} {1 {can't use non-numeric string as operand of "!"}}
+} {1 {can't use non-numeric string "truef" as operand of "!"}}
test expr-21.15 {non-numeric boolean variables} {
set v truef
list [catch {expr {!$v}} err] $err
-} {1 {can't use non-numeric string as operand of "!"}}
+} {1 {can't use non-numeric string "truef" as operand of "!"}}
test expr-21.16 {non-numeric boolean variables} {
set v "true "
list [catch {expr {!$v}} err] $err
-} {1 {can't use non-numeric string as operand of "!"}}
+} {1 {can't use non-numeric string "true " as operand of "!"}}
test expr-21.17 {non-numeric boolean variables} {
set v "tru"
list [catch {expr {!$v}} err] $err
@@ -849,23 +849,23 @@ test expr-21.20 {non-numeric boolean variables} {
test expr-21.21 {non-numeric boolean variables} {
set v "o"
list [catch {expr {!$v}} err] $err
-} {1 {can't use non-numeric string as operand of "!"}}
+} {1 {can't use non-numeric string "o" as operand of "!"}}
test expr-21.22 {non-numeric boolean variables} {
set v ""
list [catch {expr {!$v}} err] $err
-} {1 {can't use empty string as operand of "!"}}
+} {1 {can't use empty string "" as operand of "!"}}
# Test for non-numeric float handling.
test expr-22.1 {non-numeric floats} {
list [catch {expr {NaN + 1}} msg] $msg
-} {1 {can't use non-numeric floating-point value as operand of "+"}}
+} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}}
test expr-22.2 {non-numeric floats} !ieeeFloatingPoint {
list [catch {expr {Inf + 1}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "+"}}
test expr-22.3 {non-numeric floats} {
set nan NaN
list [catch {expr {$nan + 1}} msg] $msg
-} {1 {can't use non-numeric floating-point value as operand of "+"}}
+} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}}
test expr-22.4 {non-numeric floats} !ieeeFloatingPoint {
set inf Inf
list [catch {expr {$inf + 1}} msg] $msg
@@ -878,7 +878,7 @@ test expr-22.6 {non-numeric floats} !ieeeFloatingPoint {
} {1 {floating-point value too large to represent}}
test expr-22.7 {non-numeric floats} {
list [catch {expr {1 / NaN}} msg] $msg
-} {1 {can't use non-numeric floating-point value as operand of "/"}}
+} {1 {can't use non-numeric floating-point value "NaN" as operand of "/"}}
test expr-22.8 {non-numeric floats} !ieeeFloatingPoint {
list [catch {expr {1 / Inf}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "/"}}
@@ -914,10 +914,10 @@ test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body {
} -returnCodes error -match glob -result *
test expr-23.9 {CompileExponentialExpr: runtime error} {
list [catch {expr {24.0**"xx"}} msg] $msg
-} {1 {can't use non-numeric string as operand of "**"}}
+} {1 {can't use non-numeric string "xx" as operand of "**"}}
test expr-23.10 {CompileExponentialExpr: runtime error} {
list [catch {expr {"a"**2}} msg] $msg
-} {1 {can't use non-numeric string as operand of "**"}}
+} {1 {can't use non-numeric string "a" as operand of "**"}}
test expr-23.11 {CompileExponentialExpr: runtime error} {
list [catch {expr {0**-1}} msg] $msg
} {1 {exponentiation of zero by negative power}}
diff --git a/tests/http.test b/tests/http.test
index e88210a..1218536 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -409,10 +409,10 @@ test http-3.27 {http::geturl: -headers override -type} -body {
http::cleanup $token
} -match regexp -result {(?n)Host .*
User-Agent .*
-Connection close
Content-Type {text/plain;charset=utf-8}
Accept \*/\*
Accept-Encoding .*
+Connection close
Content-Length 5}
test http-3.28 {http::geturl: -headers override -type default} -body {
set token [http::geturl $url/headers -query dummy \
@@ -422,10 +422,10 @@ test http-3.28 {http::geturl: -headers override -type default} -body {
http::cleanup $token
} -match regexp -result {(?n)Host .*
User-Agent .*
-Connection close
Content-Type {text/plain;charset=utf-8}
Accept \*/\*
Accept-Encoding .*
+Connection close
Content-Length 5}
test http-3.29 {http::geturl IPv6 address} -body {
# We only want to see if the URL gets parsed correctly. This is
@@ -462,9 +462,9 @@ test http-3.32 {http::geturl: -headers override -accept default} -body {
http::cleanup $token
} -match regexp -result {(?n)Host .*
User-Agent .*
-Connection close
Accept text/plain,application/tcl-test-value
Accept-Encoding .*
+Connection close
Content-Type application/x-www-form-urlencoded
Content-Length 5}
# Bug 838e99a76d
diff --git a/tests/io.test b/tests/io.test
index 96abadd..f928cd3 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -9052,7 +9052,7 @@ test io-75.5 {incomplete shiftjis encoding read is ignored} -setup {
-test io-75.0 {channel modes} -setup {
+test io-76.0 {channel modes} -setup {
set datafile [makeFile {some characters} dummy]
set f [open $datafile r]
} -constraints testchannel -body {
@@ -9062,7 +9062,7 @@ test io-75.0 {channel modes} -setup {
removeFile dummy
} -result {read {}}
-test io-75.1 {channel modes} -setup {
+test io-76.1 {channel modes} -setup {
set datafile [makeFile {some characters} dummy]
set f [open $datafile w]
} -constraints testchannel -body {
@@ -9072,7 +9072,7 @@ test io-75.1 {channel modes} -setup {
removeFile dummy
} -result {{} write}
-test io-75.2 {channel modes} -setup {
+test io-76.2 {channel modes} -setup {
set datafile [makeFile {some characters} dummy]
set f [open $datafile r+]
} -constraints testchannel -body {
@@ -9082,7 +9082,7 @@ test io-75.2 {channel modes} -setup {
removeFile dummy
} -result {read write}
-test io-75.3 {channel mode dropping} -setup {
+test io-76.3 {channel mode dropping} -setup {
set datafile [makeFile {some characters} dummy]
set f [open $datafile r]
} -constraints testchannel -body {
@@ -9093,7 +9093,7 @@ test io-75.3 {channel mode dropping} -setup {
removeFile dummy
} -result {{read {}} {read {}}}
-test io-75.4 {channel mode dropping} -setup {
+test io-76.4 {channel mode dropping} -setup {
set datafile [makeFile {some characters} dummy]
set f [open $datafile r]
} -constraints testchannel -body {
@@ -9103,7 +9103,7 @@ test io-75.4 {channel mode dropping} -setup {
removeFile dummy
} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}
-test io-75.5 {channel mode dropping} -setup {
+test io-76.5 {channel mode dropping} -setup {
set datafile [makeFile {some characters} dummy]
set f [open $datafile w]
} -constraints testchannel -body {
@@ -9114,7 +9114,7 @@ test io-75.5 {channel mode dropping} -setup {
removeFile dummy
} -result {{{} write} {{} write}}
-test io-75.6 {channel mode dropping} -setup {
+test io-76.6 {channel mode dropping} -setup {
set datafile [makeFile {some characters} dummy]
set f [open $datafile w]
} -constraints testchannel -body {
@@ -9124,7 +9124,7 @@ test io-75.6 {channel mode dropping} -setup {
removeFile dummy
} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}
-test io-75.7 {channel mode dropping} -setup {
+test io-76.7 {channel mode dropping} -setup {
set datafile [makeFile {some characters} dummy]
set f [open $datafile r+]
} -constraints testchannel -body {
@@ -9135,7 +9135,7 @@ test io-75.7 {channel mode dropping} -setup {
removeFile dummy
} -result {{{} write} {read write}}
-test io-75.8 {channel mode dropping} -setup {
+test io-76.8 {channel mode dropping} -setup {
set datafile [makeFile {some characters} dummy]
set f [open $datafile r+]
} -constraints testchannel -body {
@@ -9146,7 +9146,7 @@ test io-75.8 {channel mode dropping} -setup {
removeFile dummy
} -result {{read {}} {read write}}
-test io-75.9 {channel mode dropping} -setup {
+test io-76.9 {channel mode dropping} -setup {
set datafile [makeFile {some characters} dummy]
set f [open $datafile r+]
} -constraints testchannel -body {
@@ -9157,7 +9157,7 @@ test io-75.9 {channel mode dropping} -setup {
removeFile dummy
} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}
-test io-75.10 {channel mode dropping} -setup {
+test io-76.10 {channel mode dropping} -setup {
set datafile [makeFile {some characters} dummy]
set f [open $datafile r+]
} -constraints testchannel -body {
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 9c8ebda..6fc4de0 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -294,7 +294,7 @@ removeFile fconfigure.dummy
test iocmd-8.14 {fconfigure command} {
fconfigure stdin -buffers
} 4096
-test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup {
+test iocmd-8.15 {fconfigure command / tcp channel} -constraints {socket unixOrWin} -setup {
set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $srv -sockname] 2]
proc iocmdSRV {sock ip port} {close $sock}
@@ -306,7 +306,7 @@ test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOr
close $srv
unset cli srv port
rename iocmdSRV {}
-} -returnCodes error -result [expectedOpts "-blah" {-connecting -peername -sockname}]
+} -returnCodes error -result [expectedOpts "-blah" {-connecting -keepalive -nodelay -peername -sockname}]
test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup {
set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
set port [lindex [fconfigure $srv -sockname] 2]
@@ -2914,7 +2914,7 @@ test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body
rename foo {}
set res
} -constraints {testchannel thread} \
- -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
+ -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} * -translation {auto *}}}
test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body {
set res {}
proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
@@ -2927,7 +2927,7 @@ test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body {
rename foo {}
set res
} -constraints {testchannel thread} \
- -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
+ -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} * -translation {auto *}}}
test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body {
set res {}
proc foo {args} {
@@ -2943,7 +2943,7 @@ test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body {
rename foo {}
set res
} -constraints {testchannel thread} \
- -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}}
+ -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} * -translation {auto *} -bar foo -snarf x}}
test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
set res {}
proc foo {args} {
diff --git a/tests/mathop.test b/tests/mathop.test
index e38001d..13a0543 100644
--- a/tests/mathop.test
+++ b/tests/mathop.test
@@ -114,22 +114,22 @@ namespace eval ::testmathop {
test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003
test mathop-1.11 {compiled +: errors} -returnCodes error -body {
+ x 0
- } -result {can't use non-numeric string as operand of "+"}
+ } -result {can't use non-numeric string "x" as operand of "+"}
test mathop-1.12 {compiled +: errors} -returnCodes error -body {
+ nan 0
- } -result {can't use non-numeric floating-point value as operand of "+"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
test mathop-1.13 {compiled +: errors} -returnCodes error -body {
+ 0 x
- } -result {can't use non-numeric string as operand of "+"}
+ } -result {can't use non-numeric string "x" as operand of "+"}
test mathop-1.14 {compiled +: errors} -returnCodes error -body {
+ 0 nan
- } -result {can't use non-numeric floating-point value as operand of "+"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
test mathop-1.15 {compiled +: errors} -returnCodes error -body {
+ 0o8 0
- } -result {can't use invalid octal number as operand of "+"}
+ } -result {can't use invalid octal number "0o8" as operand of "+"}
test mathop-1.16 {compiled +: errors} -returnCodes error -body {
+ 0 0o8
- } -result {can't use invalid octal number as operand of "+"}
+ } -result {can't use invalid octal number "0o8" as operand of "+"}
test mathop-1.17 {compiled +: errors} -returnCodes error -body {
+ 0 [error expectedError]
} -result expectedError
@@ -152,22 +152,22 @@ namespace eval ::testmathop {
test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003
test mathop-1.29 {interpreted +: errors} -returnCodes error -body {
$op x 0
- } -result {can't use non-numeric string as operand of "+"}
+ } -result {can't use non-numeric string "x" as operand of "+"}
test mathop-1.30 {interpreted +: errors} -returnCodes error -body {
$op nan 0
- } -result {can't use non-numeric floating-point value as operand of "+"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
test mathop-1.31 {interpreted +: errors} -returnCodes error -body {
$op 0 x
- } -result {can't use non-numeric string as operand of "+"}
+ } -result {can't use non-numeric string "x" as operand of "+"}
test mathop-1.32 {interpreted +: errors} -returnCodes error -body {
$op 0 nan
- } -result {can't use non-numeric floating-point value as operand of "+"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
test mathop-1.33 {interpreted +: errors} -returnCodes error -body {
$op 0o8 0
- } -result {can't use invalid octal number as operand of "+"}
+ } -result {can't use invalid octal number "0o8" as operand of "+"}
test mathop-1.34 {interpreted +: errors} -returnCodes error -body {
$op 0 0o8
- } -result {can't use invalid octal number as operand of "+"}
+ } -result {can't use invalid octal number "0o8" as operand of "+"}
test mathop-1.35 {interpreted +: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
@@ -189,22 +189,22 @@ namespace eval ::testmathop {
test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000
test mathop-2.11 {compiled *: errors} -returnCodes error -body {
* x 0
- } -result {can't use non-numeric string as operand of "*"}
+ } -result {can't use non-numeric string "x" as operand of "*"}
test mathop-2.12 {compiled *: errors} -returnCodes error -body {
* nan 0
- } -result {can't use non-numeric floating-point value as operand of "*"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
test mathop-2.13 {compiled *: errors} -returnCodes error -body {
* 0 x
- } -result {can't use non-numeric string as operand of "*"}
+ } -result {can't use non-numeric string "x" as operand of "*"}
test mathop-2.14 {compiled *: errors} -returnCodes error -body {
* 0 nan
- } -result {can't use non-numeric floating-point value as operand of "*"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
test mathop-2.15 {compiled *: errors} -returnCodes error -body {
* 0o8 0
- } -result {can't use invalid octal number as operand of "*"}
+ } -result {can't use invalid octal number "0o8" as operand of "*"}
test mathop-2.16 {compiled *: errors} -returnCodes error -body {
* 0 0o8
- } -result {can't use invalid octal number as operand of "*"}
+ } -result {can't use invalid octal number "0o8" as operand of "*"}
test mathop-2.17 {compiled *: errors} -returnCodes error -body {
* 0 [error expectedError]
} -result expectedError
@@ -227,22 +227,22 @@ namespace eval ::testmathop {
test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000
test mathop-2.29 {interpreted *: errors} -returnCodes error -body {
$op x 0
- } -result {can't use non-numeric string as operand of "*"}
+ } -result {can't use non-numeric string "x" as operand of "*"}
test mathop-2.30 {interpreted *: errors} -returnCodes error -body {
$op nan 0
- } -result {can't use non-numeric floating-point value as operand of "*"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
test mathop-2.31 {interpreted *: errors} -returnCodes error -body {
$op 0 x
- } -result {can't use non-numeric string as operand of "*"}
+ } -result {can't use non-numeric string "x" as operand of "*"}
test mathop-2.32 {interpreted *: errors} -returnCodes error -body {
$op 0 nan
- } -result {can't use non-numeric floating-point value as operand of "*"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
test mathop-2.33 {interpreted *: errors} -returnCodes error -body {
$op 0o8 0
- } -result {can't use invalid octal number as operand of "*"}
+ } -result {can't use invalid octal number "0o8" as operand of "*"}
test mathop-2.34 {interpreted *: errors} -returnCodes error -body {
$op 0 0o8
- } -result {can't use invalid octal number as operand of "*"}
+ } -result {can't use invalid octal number "0o8" as operand of "*"}
test mathop-2.35 {interpreted *: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
@@ -261,7 +261,7 @@ namespace eval ::testmathop {
test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0
test mathop-3.8 {compiled !: errors} -body {
! foobar
- } -returnCodes error -result {can't use non-numeric string as operand of "!"}
+ } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"}
test mathop-3.9 {compiled !: errors} -body {
! 0 0
} -returnCodes error -result "wrong # args: should be \"! boolean\""
@@ -278,7 +278,7 @@ namespace eval ::testmathop {
test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0
test mathop-3.18 {interpreted !: errors} -body {
$op foobar
- } -returnCodes error -result {can't use non-numeric string as operand of "!"}
+ } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"}
test mathop-3.19 {interpreted !: errors} -body {
$op 0 0
} -returnCodes error -result "wrong # args: should be \"! boolean\""
@@ -287,10 +287,10 @@ namespace eval ::testmathop {
} -returnCodes error -result "wrong # args: should be \"! boolean\""
test mathop-3.21 {compiled !: error} -returnCodes error -body {
! NaN
- } -result {can't use non-numeric floating-point value as operand of "!"}
+ } -result {can't use non-numeric floating-point value "NaN" as operand of "!"}
test mathop-3.22 {interpreted !: error} -returnCodes error -body {
$op NaN
- } -result {can't use non-numeric floating-point value as operand of "!"}
+ } -result {can't use non-numeric floating-point value "NaN" as operand of "!"}
test mathop-4.1 {compiled ~} {~ 0} -1
test mathop-4.2 {compiled ~} {~ 1} -2
@@ -301,7 +301,7 @@ namespace eval ::testmathop {
test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001
test mathop-4.8 {compiled ~: errors} -body {
~ foobar
- } -returnCodes error -result {can't use non-numeric string as operand of "~"}
+ } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"}
test mathop-4.9 {compiled ~: errors} -body {
~ 0 0
} -returnCodes error -result "wrong # args: should be \"~ integer\""
@@ -310,10 +310,10 @@ namespace eval ::testmathop {
} -returnCodes error -result "wrong # args: should be \"~ integer\""
test mathop-4.11 {compiled ~: errors} -returnCodes error -body {
~ 0.0
- } -result {can't use floating-point value as operand of "~"}
+ } -result {can't use floating-point value "0.0" as operand of "~"}
test mathop-4.12 {compiled ~: errors} -returnCodes error -body {
~ NaN
- } -result {can't use non-numeric floating-point value as operand of "~"}
+ } -result {can't use non-numeric floating-point value "NaN" as operand of "~"}
set op ~
test mathop-4.13 {interpreted ~} {$op 0} -1
test mathop-4.14 {interpreted ~} {$op 1} -2
@@ -324,7 +324,7 @@ namespace eval ::testmathop {
test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001
test mathop-4.20 {interpreted ~: errors} -body {
$op foobar
- } -returnCodes error -result {can't use non-numeric string as operand of "~"}
+ } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"}
test mathop-4.21 {interpreted ~: errors} -body {
$op 0 0
} -returnCodes error -result "wrong # args: should be \"~ integer\""
@@ -333,10 +333,10 @@ namespace eval ::testmathop {
} -returnCodes error -result "wrong # args: should be \"~ integer\""
test mathop-4.23 {interpreted ~: errors} -returnCodes error -body {
$op 0.0
- } -result {can't use floating-point value as operand of "~"}
+ } -result {can't use floating-point value "0.0" as operand of "~"}
test mathop-4.24 {interpreted ~: errors} -returnCodes error -body {
$op NaN
- } -result {can't use non-numeric floating-point value as operand of "~"}
+ } -result {can't use non-numeric floating-point value "NaN" as operand of "~"}
test mathop-5.1 {compiled eq} {eq {} a} 0
test mathop-5.2 {compiled eq} {eq a a} 1
@@ -377,32 +377,32 @@ namespace eval ::testmathop {
test mathop-6.4 {compiled &} { & 3 7 6 } 2
test mathop-6.5 {compiled &} -returnCodes error -body {
& 1.0 2 3
- } -result {can't use floating-point value as operand of "&"}
+ } -result {can't use floating-point value "1.0" as operand of "&"}
test mathop-6.6 {compiled &} -returnCodes error -body {
& 1 2 3.0
- } -result {can't use floating-point value as operand of "&"}
+ } -result {can't use floating-point value "3.0" as operand of "&"}
test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2
test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85
test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2
test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85
test mathop-6.11 {compiled &: errors} -returnCodes error -body {
& x 0
- } -result {can't use non-numeric string as operand of "&"}
+ } -result {can't use non-numeric string "x" as operand of "&"}
test mathop-6.12 {compiled &: errors} -returnCodes error -body {
& nan 0
- } -result {can't use non-numeric floating-point value as operand of "&"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
test mathop-6.13 {compiled &: errors} -returnCodes error -body {
& 0 x
- } -result {can't use non-numeric string as operand of "&"}
+ } -result {can't use non-numeric string "x" as operand of "&"}
test mathop-6.14 {compiled &: errors} -returnCodes error -body {
& 0 nan
- } -result {can't use non-numeric floating-point value as operand of "&"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
test mathop-6.15 {compiled &: errors} -returnCodes error -body {
& 0o8 0
- } -result {can't use invalid octal number as operand of "&"}
+ } -result {can't use invalid octal number "0o8" as operand of "&"}
test mathop-6.16 {compiled &: errors} -returnCodes error -body {
& 0 0o8
- } -result {can't use invalid octal number as operand of "&"}
+ } -result {can't use invalid octal number "0o8" as operand of "&"}
test mathop-6.17 {compiled &: errors} -returnCodes error -body {
& 0 [error expectedError]
} -result expectedError
@@ -419,32 +419,32 @@ namespace eval ::testmathop {
test mathop-6.22 {interpreted &} { $op 3 7 6 } 2
test mathop-6.23 {interpreted &} -returnCodes error -body {
$op 1.0 2 3
- } -result {can't use floating-point value as operand of "&"}
+ } -result {can't use floating-point value "1.0" as operand of "&"}
test mathop-6.24 {interpreted &} -returnCodes error -body {
$op 1 2 3.0
- } -result {can't use floating-point value as operand of "&"}
+ } -result {can't use floating-point value "3.0" as operand of "&"}
test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2
test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85
test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2
test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85
test mathop-6.29 {interpreted &: errors} -returnCodes error -body {
$op x 0
- } -result {can't use non-numeric string as operand of "&"}
+ } -result {can't use non-numeric string "x" as operand of "&"}
test mathop-6.30 {interpreted &: errors} -returnCodes error -body {
$op nan 0
- } -result {can't use non-numeric floating-point value as operand of "&"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
test mathop-6.31 {interpreted &: errors} -returnCodes error -body {
$op 0 x
- } -result {can't use non-numeric string as operand of "&"}
+ } -result {can't use non-numeric string "x" as operand of "&"}
test mathop-6.32 {interpreted &: errors} -returnCodes error -body {
$op 0 nan
- } -result {can't use non-numeric floating-point value as operand of "&"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
test mathop-6.33 {interpreted &: errors} -returnCodes error -body {
$op 0o8 0
- } -result {can't use invalid octal number as operand of "&"}
+ } -result {can't use invalid octal number "0o8" as operand of "&"}
test mathop-6.34 {interpreted &: errors} -returnCodes error -body {
$op 0 0o8
- } -result {can't use invalid octal number as operand of "&"}
+ } -result {can't use invalid octal number "0o8" as operand of "&"}
test mathop-6.35 {interpreted &: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
@@ -487,32 +487,32 @@ namespace eval ::testmathop {
test mathop-7.4 {compiled |} { | 3 7 6 } 7
test mathop-7.5 {compiled |} -returnCodes error -body {
| 1.0 2 3
- } -result {can't use floating-point value as operand of "|"}
+ } -result {can't use floating-point value "1.0" as operand of "|"}
test mathop-7.6 {compiled |} -returnCodes error -body {
| 1 2 3.0
- } -result {can't use floating-point value as operand of "|"}
+ } -result {can't use floating-point value "3.0" as operand of "|"}
test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110
test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503
test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110
test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503
test mathop-7.11 {compiled |: errors} -returnCodes error -body {
| x 0
- } -result {can't use non-numeric string as operand of "|"}
+ } -result {can't use non-numeric string "x" as operand of "|"}
test mathop-7.12 {compiled |: errors} -returnCodes error -body {
| nan 0
- } -result {can't use non-numeric floating-point value as operand of "|"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
test mathop-7.13 {compiled |: errors} -returnCodes error -body {
| 0 x
- } -result {can't use non-numeric string as operand of "|"}
+ } -result {can't use non-numeric string "x" as operand of "|"}
test mathop-7.14 {compiled |: errors} -returnCodes error -body {
| 0 nan
- } -result {can't use non-numeric floating-point value as operand of "|"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
test mathop-7.15 {compiled |: errors} -returnCodes error -body {
| 0o8 0
- } -result {can't use invalid octal number as operand of "|"}
+ } -result {can't use invalid octal number "0o8" as operand of "|"}
test mathop-7.16 {compiled |: errors} -returnCodes error -body {
| 0 0o8
- } -result {can't use invalid octal number as operand of "|"}
+ } -result {can't use invalid octal number "0o8" as operand of "|"}
test mathop-7.17 {compiled |: errors} -returnCodes error -body {
| 0 [error expectedError]
} -result expectedError
@@ -529,32 +529,32 @@ namespace eval ::testmathop {
test mathop-7.22 {interpreted |} { $op 3 7 6 } 7
test mathop-7.23 {interpreted |} -returnCodes error -body {
$op 1.0 2 3
- } -result {can't use floating-point value as operand of "|"}
+ } -result {can't use floating-point value "1.0" as operand of "|"}
test mathop-7.24 {interpreted |} -returnCodes error -body {
$op 1 2 3.0
- } -result {can't use floating-point value as operand of "|"}
+ } -result {can't use floating-point value "3.0" as operand of "|"}
test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110
test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503
test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110
test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503
test mathop-7.29 {interpreted |: errors} -returnCodes error -body {
$op x 0
- } -result {can't use non-numeric string as operand of "|"}
+ } -result {can't use non-numeric string "x" as operand of "|"}
test mathop-7.30 {interpreted |: errors} -returnCodes error -body {
$op nan 0
- } -result {can't use non-numeric floating-point value as operand of "|"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
test mathop-7.31 {interpreted |: errors} -returnCodes error -body {
$op 0 x
- } -result {can't use non-numeric string as operand of "|"}
+ } -result {can't use non-numeric string "x" as operand of "|"}
test mathop-7.32 {interpreted |: errors} -returnCodes error -body {
$op 0 nan
- } -result {can't use non-numeric floating-point value as operand of "|"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
test mathop-7.33 {interpreted |: errors} -returnCodes error -body {
$op 0o8 0
- } -result {can't use invalid octal number as operand of "|"}
+ } -result {can't use invalid octal number "0o8" as operand of "|"}
test mathop-7.34 {interpreted |: errors} -returnCodes error -body {
$op 0 0o8
- } -result {can't use invalid octal number as operand of "|"}
+ } -result {can't use invalid octal number "0o8" as operand of "|"}
test mathop-7.35 {interpreted |: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
@@ -597,32 +597,32 @@ namespace eval ::testmathop {
test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2
test mathop-8.5 {compiled ^} -returnCodes error -body {
^ 1.0 2 3
- } -result {can't use floating-point value as operand of "^"}
+ } -result {can't use floating-point value "1.0" as operand of "^"}
test mathop-8.6 {compiled ^} -returnCodes error -body {
^ 1 2 3.0
- } -result {can't use floating-point value as operand of "^"}
+ } -result {can't use floating-point value "3.0" as operand of "^"}
test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110
test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333
test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110
test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333
test mathop-8.11 {compiled ^: errors} -returnCodes error -body {
^ x 0
- } -result {can't use non-numeric string as operand of "^"}
+ } -result {can't use non-numeric string "x" as operand of "^"}
test mathop-8.12 {compiled ^: errors} -returnCodes error -body {
^ nan 0
- } -result {can't use non-numeric floating-point value as operand of "^"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
test mathop-8.13 {compiled ^: errors} -returnCodes error -body {
^ 0 x
- } -result {can't use non-numeric string as operand of "^"}
+ } -result {can't use non-numeric string "x" as operand of "^"}
test mathop-8.14 {compiled ^: errors} -returnCodes error -body {
^ 0 nan
- } -result {can't use non-numeric floating-point value as operand of "^"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
test mathop-8.15 {compiled ^: errors} -returnCodes error -body {
^ 0o8 0
- } -result {can't use invalid octal number as operand of "^"}
+ } -result {can't use invalid octal number "0o8" as operand of "^"}
test mathop-8.16 {compiled ^: errors} -returnCodes error -body {
^ 0 0o8
- } -result {can't use invalid octal number as operand of "^"}
+ } -result {can't use invalid octal number "0o8" as operand of "^"}
test mathop-8.17 {compiled ^: errors} -returnCodes error -body {
^ 0 [error expectedError]
} -result expectedError
@@ -639,32 +639,32 @@ namespace eval ::testmathop {
test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2
test mathop-8.23 {interpreted ^} -returnCodes error -body {
$op 1.0 2 3
- } -result {can't use floating-point value as operand of "^"}
+ } -result {can't use floating-point value "1.0" as operand of "^"}
test mathop-8.24 {interpreted ^} -returnCodes error -body {
$op 1 2 3.0
- } -result {can't use floating-point value as operand of "^"}
+ } -result {can't use floating-point value "3.0" as operand of "^"}
test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110
test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333
test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110
test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333
test mathop-8.29 {interpreted ^: errors} -returnCodes error -body {
$op x 0
- } -result {can't use non-numeric string as operand of "^"}
+ } -result {can't use non-numeric string "x" as operand of "^"}
test mathop-8.30 {interpreted ^: errors} -returnCodes error -body {
$op nan 0
- } -result {can't use non-numeric floating-point value as operand of "^"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
test mathop-8.31 {interpreted ^: errors} -returnCodes error -body {
$op 0 x
- } -result {can't use non-numeric string as operand of "^"}
+ } -result {can't use non-numeric string "x" as operand of "^"}
test mathop-8.32 {interpreted ^: errors} -returnCodes error -body {
$op 0 nan
- } -result {can't use non-numeric floating-point value as operand of "^"}
+ } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
test mathop-8.33 {interpreted ^: errors} -returnCodes error -body {
$op 0o8 0
- } -result {can't use invalid octal number as operand of "^"}
+ } -result {can't use invalid octal number "0o8" as operand of "^"}
test mathop-8.34 {interpreted ^: errors} -returnCodes error -body {
$op 0 0o8
- } -result {can't use invalid octal number as operand of "^"}
+ } -result {can't use invalid octal number "0o8" as operand of "^"}
test mathop-8.35 {interpreted ^: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
@@ -775,13 +775,13 @@ test mathop-20.6 { one arg, error } {
# skipping - for now, knownbug...
foreach op {+ * / & | ^ **} {
lappend res [TestOp $op {*}$vals]
- lappend exp "can't use non-numeric string as operand of \"$op\"\
+ lappend exp "can't use non-numeric string \"x\" as operand of \"$op\"\
ARITH DOMAIN {non-numeric string}"
}
}
foreach op {+ * / & | ^ **} {
lappend res [TestOp $op NaN 1]
- lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\
+ lappend exp "can't use non-numeric floating-point value \"NaN\" as operand of \"$op\"\
ARITH DOMAIN {non-numeric floating-point value}"
}
expr {$res eq $exp ? 0 : $res}
@@ -850,15 +850,15 @@ test mathop-21.5 { unary ops, bad values } {
set res {}
set exp {}
lappend res [TestOp / x]
- lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string \"x\" as operand of \"/\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp - x]
- lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string \"x\" as operand of \"-\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp ~ x]
- lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string \"x\" as operand of \"~\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp ! x]
- lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string \"x\" as operand of \"!\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp ~ 5.0]
- lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}"
+ lappend exp "can't use floating-point value \"5.0\" as operand of \"~\" ARITH DOMAIN {floating-point value}"
expr {$res eq $exp ? 0 : $res}
} 0
test mathop-21.6 { unary ops, too many } {
@@ -965,9 +965,9 @@ test mathop-22.4 { unary ops, bad values } {
set exp {}
foreach op {& | ^} {
lappend res [TestOp $op x 5]
- lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp $op 5 x]
- lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
}
expr {$res eq $exp ? 0 : $res}
} 0
@@ -1080,15 +1080,15 @@ test mathop-24.3 { binary ops, bad values } {
set exp {}
foreach op {% << >>} {
lappend res [TestOp $op x 1]
- lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp $op 1 x]
- lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
}
foreach op {% << >>} {
lappend res [TestOp $op 5.0 1]
- lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
+ lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}"
lappend res [TestOp $op 1 5.0]
- lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
+ lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}"
}
foreach op {in ni} {
lappend res [TestOp $op 5 "a b \{ c"]
@@ -1266,9 +1266,9 @@ test mathop-25.41 { exp operator errors } {
lappend res [TestOp ** $huge 2.1]
lappend exp "Inf"
lappend res [TestOp ** 2 foo]
- lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp ** foo 2]
- lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}"
expr {$res eq $exp ? 0 : $res}
} 0
diff --git a/tests/safe-stock.test b/tests/safe-stock.test
index bfea85c..d23d86e 100644
--- a/tests/safe-stock.test
+++ b/tests/safe-stock.test
@@ -101,8 +101,15 @@ proc mapAndSortList {map listIn} {
# thus un-autoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}
+testConstraint AutoSyncDefined 1
+
# high level general test
-test safe-stock-7.1 {tests that everything works at high level, uses pkg opt} -setup {
+test safe-stock-7.1 {tests that everything works at high level with conventional AutoPathSync, use pkg opt} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set i [safe::interpCreate]
} -body {
# no error shall occur:
@@ -114,8 +121,18 @@ test safe-stock-7.1 {tests that everything works at high level, uses pkg opt} -s
set v
} -cleanup {
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result 0.4.*
-test safe-stock-7.2 {tests specific path and interpFind/AddToAccessPath, uses pkg opt} -setup {
+test safe-stock-7.2 {tests specific path and interpFind/AddToAccessPath with conventional AutoPathSync, use pkg opt} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ } else {
+ set SyncVal_TMP 1
+ }
} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not add anything (p0)
@@ -130,9 +147,19 @@ test safe-stock-7.2 {tests specific path and interpFind/AddToAccessPath, uses pk
[catch {interp eval $i {package require opt}} msg] $msg -- \
$mappA -- [safe::interpDelete $i]
} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result "{\$p(:0:)} {\$p(:*:)} -- 1 {$pkgOptErrMsg} --\
{TCLLIB */dummy/unixlike/test/path} -- {}"
-test safe-stock-7.4 {tests specific path and positive search, uses pkg opt} -setup {
+test safe-stock-7.4 {tests specific path and positive search with conventional AutoPathSync, use pkg opt} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ } else {
+ set SyncVal_TMP 1
+ }
} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not add anything (p0)
@@ -148,8 +175,35 @@ test safe-stock-7.4 {tests specific path and positive search, uses pkg opt} -set
# Note that the glob match elides directories (those from the module path)
# other than the first and last in the access path.
} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 0.4.* --\
{TCLLIB * TCLLIB/OPTDIR} -- {}}
+test safe-stock-7.5 {tests positive and negative module loading with conventional AutoPathSync} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
+ set i [safe::interpCreate]
+ interp eval $i {
+ package forget platform::shell
+ package forget platform
+ catch {namespace delete ::platform}
+ }
+} -body {
+ # Should raise an error (module ancestor directory issue)
+ set code1 [catch {interp eval $i {package require shell}} msg1]
+ # Should not raise an error
+ set code2 [catch {interp eval $i {package require platform::shell}} msg2]
+ return [list $code1 $msg1 $code2]
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {1 {can't find package shell} 0}
# The following test checks whether the definition of tcl_endOfWord can be
# obtained from auto_loading. It was previously test "safe-5.1".
@@ -161,7 +215,12 @@ test safe-stock-9.8 {test auto-loading in safe interpreters, was safe-5.1} -setu
} -cleanup {
safe::interpDelete a
} -result -1
-test safe-stock-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, uses pkg opt and tcl::idna} -setup {
+test safe-stock-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement with conventional AutoPathSync, uses pkg opt and tcl::idna} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $tcl_library $pkgOptDir] \
@@ -196,11 +255,19 @@ test safe-stock-9.11 {interpConfigure change the access path; pkgIndex.tcl packa
$mappA -- $mappB -- $code5 $msg5 $code6 $msg6
} -cleanup {
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 1.* 0 0.4.* --\
{TCLLIB TCLLIB/OPTDIR TCLLIB/JARDIR*} --\
{TCLLIB TCLLIB/JARDIR TCLLIB/OPTDIR*} --\
0 0 0 example.com}
-test safe-stock-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, uses pkg opt and tcl::idna} -setup {
+test safe-stock-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed with conventional AutoPathSync, uses pkg opt and tcl::idna} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $tcl_library $pkgOptDir] \
@@ -231,9 +298,138 @@ test safe-stock-9.13 {interpConfigure change the access path; pkgIndex.tcl packa
$mappA -- $mappB
} -cleanup {
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\
1 {* not found in access path} -- 1 1 --\
{TCLLIB TCLLIB/OPTDIR TCLLIB/JARDIR*} -- {TCLLIB*}}
+
+test safe-stock-18.1 {cf. safe-stock-7.1opt - tests that everything works at high level without conventional AutoPathSync, use pkg opt} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ # Without AutoPathSync, we need a more complete auto_path,
+ # because the child will use the same value.
+ set lib1 [info library]
+ set lib2 [file dirname $lib1]
+ set ::auto_TMP $::auto_path
+ set ::auto_path [list $lib1 $lib2]
+
+ set i [safe::interpCreate]
+ set ::auto_path $::auto_TMP
+} -body {
+ # no error shall occur:
+ # (because the default access_path shall include 1st level sub dirs so
+ # package require in a child works like in the parent)
+ set v [interp eval $i {package require opt}]
+ # no error shall occur:
+ interp eval $i {::tcl::Lempty {a list}}
+ set v
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result 0.4.*
+test safe-stock-18.2 {cf. safe-stock-7.2opt - tests specific path and interpFind/AddToAccessPath without conventional AutoPathSync, use pkg opt} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
+ set auto1 [interp eval $i {set ::auto_path}]
+ # This will differ from the value -autoPath {}
+ interp eval $i {set ::auto_path [list {$p(:0:)}]}
+ # should not add anything (p0)
+ set token1 [safe::interpAddToAccessPath $i [info library]]
+ # should add as p* (not p1 if parent has a module path)
+ set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
+ # an error shall occur (opt is not anymore in the secure 0-level
+ # provided deep path)
+ list $auto1 $token1 $token2 \
+ [catch {interp eval $i {package require opt}} msg] $msg \
+ [safe::interpConfigure $i]\
+ [safe::interpDelete $i]
+} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result "{} {\$p(:0:)} {\$p(:*:)} 1 {$pkgOptErrMsg}\
+ {-accessPath {[list $tcl_library */dummy/unixlike/test/path]}\
+ -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}"
+test safe-stock-18.4 {cf. safe-stock-7.4opt - tests specific path and positive search and auto_path without conventional AutoPathSync, use pkg opt} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
+
+ # should not have been set by Safe Base:
+ set auto1 [interp eval $i {set ::auto_path}]
+
+ # This will differ from the value -autoPath {}
+ interp eval $i {set ::auto_path [list {$p(:0:)}]}
+
+ # should not add anything (p0)
+ set token1 [safe::interpAddToAccessPath $i [info library]]
+
+ # should add as p* (not p1 if parent has a module path)
+ set token2 [safe::interpAddToAccessPath $i [file join [info library] $pkgOptDir]]
+
+ # should not have been changed by Safe Base:
+ set auto2 [interp eval $i {set ::auto_path}]
+
+ # This time, unlike test safe-stock-18.2opt and the try above, opt should be found:
+ list $auto1 $auto2 $token1 $token2 \
+ [catch {interp eval $i {package require opt}} msg] $msg \
+ [safe::interpConfigure $i]\
+ [safe::interpDelete $i]
+} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result "{} {{\$p(:0:)}} {\$p(:0:)} {\$p(:*:)} 0 0.4.*\
+ {-accessPath {[list $tcl_library *$tcl_library/$pkgOptDir]}\
+ -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}"
+test safe-stock-18.5 {cf. safe-stock-7.5 - tests positive and negative module loading without conventional AutoPathSync} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate]
+ interp eval $i {
+ package forget platform::shell
+ package forget platform
+ catch {namespace delete ::platform}
+ }
+} -body {
+ # Should raise an error (tests module ancestor directory rule)
+ set code1 [catch {interp eval $i {package require shell}} msg1]
+ # Should not raise an error
+ set code2 [catch {interp eval $i {package require platform::shell}} msg2]
+ return [list $code1 $msg1 $code2]
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {1 {can't find package shell} 0}
set ::auto_path $SaveAutoPath
unset pkgOptErrMsg pkgOptDir pkgJarDir SaveAutoPath TestsDir PathMapp
diff --git a/tests/safe-zipfs.test b/tests/safe-zipfs.test
index a6088c4..41c4b78 100644
--- a/tests/safe-zipfs.test
+++ b/tests/safe-zipfs.test
@@ -55,6 +55,8 @@ apply [list {} {
# thus un-autoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}
+ testConstraint AutoSyncDefined 1
+
# Tests 5.* test the example files before using them to test safe interpreters.
test safe-zipfs-5.1 {example tclIndex commands, test in parent interpreter; zipfs} -setup {
@@ -104,8 +106,7 @@ apply [list {} {
} -match glob -result {0 1.2.3 0 2.3.4 0 OK1 0 OK2}
test safe-zipfs-5.4 {example pkgIndex.tcl packages, test in parent interpreter, main directories; zipfs} -setup {
set tmpAutoPath $::auto_path
- lappend ::auto_path [file join $ZipMountPoint auto0 auto1] \
- [file join $ZipMountPoint auto0 auto2]
+ lappend ::auto_path [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]
} -body {
# Try to load the packages and run a command from each one.
set code3 [catch {package require SafeTestPackage1} msg3]
@@ -168,7 +169,12 @@ apply [list {} {
# high level general test
# Use zipped example packages not http1.0 etc
- test safe-zipfs-7.1 {tests that everything works at high level; zipfs} -setup {
+ test safe-zipfs-7.1 {tests that everything works at high level with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set tmpAutoPath $::auto_path
lappend ::auto_path [file join $ZipMountPoint auto0]
set i [safe::interpCreate]
@@ -183,8 +189,18 @@ apply [list {} {
set v
} -cleanup {
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result 1.2.3
- test safe-zipfs-7.2 {tests specific path and interpFind/AddToAccessPath; zipfs} -setup {
+ test safe-zipfs-7.2 {tests specific path and interpFind/AddToAccessPath with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ } else {
+ set SyncVal_TMP 1
+ }
} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not add anything (p0)
@@ -197,14 +213,20 @@ apply [list {} {
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
# an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level
# provided deep path)
- list $token1 $token2 $token3 -- \
- [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
- $mappA -- [safe::interpDelete $i]
+ list $token1 $token2 $token3 -- [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- $mappA -- [safe::interpDelete $i]
} -cleanup {
- } -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\
- 1 {can't find package SafeTestPackage1} --\
- {TCLLIB */dummy/unixlike/test/path ZIPDIR/auto0} -- {}}
- test safe-zipfs-7.4 {tests specific path and positive search; zipfs} -setup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} -- 1 {can't find package SafeTestPackage1} -- {TCLLIB */dummy/unixlike/test/path ZIPDIR/auto0} -- {}}
+ test safe-zipfs-7.4 {tests specific path and positive search with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ } else {
+ set SyncVal_TMP 1
+ }
} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not add anything (p0)
@@ -214,20 +236,23 @@ apply [list {} {
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
# this time, unlike test safe-zipfs-7.2, SafeTestPackage1 should be found
- list $token1 $token2 -- \
- [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
- $mappA -- [safe::interpDelete $i]
+ list $token1 $token2 -- [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- $mappA -- [safe::interpDelete $i]
# Note that the glob match elides directories (those from the module path)
# other than the first and last in the access path.
} -cleanup {
- } -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\
- {TCLLIB * ZIPDIR/auto0/auto1} -- {}}
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 -- {TCLLIB * ZIPDIR/auto0/auto1} -- {}}
- test safe-zipfs-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset); zipfs} -setup {
+ test safe-zipfs-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset) with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
- set i [safe::interpCreate -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0 auto1] \
- [file join $ZipMountPoint auto0 auto2]]]
+ set i [safe::interpCreate -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]]
# Inspect.
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
@@ -243,9 +268,7 @@ apply [list {} {
set code2 [catch {interp eval $i {report2}} msg2]
# Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
- safe::interpConfigure $i -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0 auto2] \
- [file join $ZipMountPoint auto0 auto1]]
+ safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto2] [file join $ZipMountPoint auto0 auto1]]
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
@@ -259,14 +282,18 @@ apply [list {} {
list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
} -cleanup {
safe::interpDelete $i
- } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\
- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
- {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}}
- test safe-zipfs-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset); zipfs} -setup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}}
+ test safe-zipfs-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset) with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
- set i [safe::interpCreate -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0 auto1] \
- [file join $ZipMountPoint auto0 auto2]]]
+ set i [safe::interpCreate -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]]
# Inspect.
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
@@ -280,9 +307,7 @@ apply [list {} {
# will pass only if the Safe Base has called auto_reset.
# Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
- safe::interpConfigure $i -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0 auto2] \
- [file join $ZipMountPoint auto0 auto1]]
+ safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto2] [file join $ZipMountPoint auto0 auto1]]
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
@@ -296,17 +321,19 @@ apply [list {} {
list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
} -cleanup {
safe::interpDelete $i
- } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
- 0 ok1 0 ok2 --\
- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
- {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}}
- test safe-zipfs-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement; zipfs} -setup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*}}
+ test safe-zipfs-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
- # For complete correspondence to safe-stock87-9.11, include auto0 in access path.
- set i [safe::interpCreate -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0] \
- [file join $ZipMountPoint auto0 auto1] \
- [file join $ZipMountPoint auto0 auto2]]]
+ # For complete correspondence to safe-stock-9.11, include auto0 in access path.
+ set i [safe::interpCreate -accessPath [list $tcl_library [file join $ZipMountPoint auto0] [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]]
# Inspect.
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
@@ -320,10 +347,7 @@ apply [list {} {
# Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}.
# This would have no effect because the records in Pkg of these directories
# were from access as children of {$p(:1:)}.
- safe::interpConfigure $i -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0] \
- [file join $ZipMountPoint auto0 auto2] \
- [file join $ZipMountPoint auto0 auto1]]
+ safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0] [file join $ZipMountPoint auto0 auto2] [file join $ZipMountPoint auto0 auto1]]
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
@@ -336,19 +360,21 @@ apply [list {} {
set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
- list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
- $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
} -cleanup {
safe::interpDelete $i
- } -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\
- {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
- {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} --\
- 0 OK1 0 OK2}
- test safe-zipfs-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0; zipfs} -setup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 -- {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB ZIPDIR/auto0 ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} -- 0 OK1 0 OK2}
+ test safe-zipfs-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0 with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
- set i [safe::interpCreate -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0 auto1] \
- [file join $ZipMountPoint auto0 auto2]]]
+ set i [safe::interpCreate -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]]
# Inspect.
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
@@ -359,9 +385,7 @@ apply [list {} {
catch {interp eval $i {package require NOEXIST}}
# Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
- safe::interpConfigure $i -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0 auto2] \
- [file join $ZipMountPoint auto0 auto1]]
+ safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto2] [file join $ZipMountPoint auto0 auto1]]
# Inspect.
set confB [safe::interpConfigure $i]
set mappB [mapList $PathMapp [dict get $confB -accessPath]]
@@ -374,20 +398,21 @@ apply [list {} {
set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
- list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
- $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB -- $code5 $msg5 $code6 $msg6
} -cleanup {
safe::interpDelete $i
- } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
- 0 1.2.3 0 2.3.4 --\
- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} --\
- {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} --\
- 0 OK1 0 OK2}
- test safe-zipfs-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed; zipfs} -setup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 1.2.3 0 2.3.4 -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB ZIPDIR/auto0/auto2 ZIPDIR/auto0/auto1*} -- 0 OK1 0 OK2}
+ test safe-zipfs-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
- set i [safe::interpCreate -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0 auto1] \
- [file join $ZipMountPoint auto0 auto2]]]
+ set i [safe::interpCreate -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]]
# Inspect.
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
@@ -410,14 +435,19 @@ apply [list {} {
set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3]
set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6]
- list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \
- $mappA -- $mappB
+ list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- $mappA -- $mappB
} -cleanup {
safe::interpDelete $i
- } -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\
- 1 {* not found in access path} -- 1 1 --\
- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB*}}
- test safe-zipfs-9.20 {check module loading; zipfs} -setup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} -- 1 {* not found in access path} -- 1 1 -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2*} -- {TCLLIB*}}
+ test safe-zipfs-9.20 {check module loading, with conventional AutoPathSync; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
@@ -442,18 +472,17 @@ apply [list {} {
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
- list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
foreach path [lreverse $oldTm] {
tcl::tm::path add $path
}
safe::interpDelete $i
- } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
- 0 0.5 0 1.0 0 2.0 --\
- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
- ZIPDIR/auto0/modules/mod2} -- res0 res1 res2}
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} -- 0 0.5 0 1.0 0 2.0 -- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- res0 res1 res2}
# - The command safe::InterpSetConfig adds the parent's [tcl::tm::list] in
# tokenized form to the child's access path, and then adds all the
# descendants, discovered recursively by using glob.
@@ -463,7 +492,12 @@ apply [list {} {
# directories in the access path. Both those things must be sorted before
# comparing with expected results. The test is therefore not totally strict,
# but will notice missing or surplus directories.
- test safe-zipfs-9.21 {interpConfigure change the access path; check module loading; stale data case 1; zipfs} -setup {
+ test safe-zipfs-9.21 {interpConfigure change the access path; check module loading, with conventional AutoPathSync; stale data case 1; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
@@ -482,9 +516,7 @@ apply [list {} {
# Add to access path.
# This injects more tokens, pushing modules to higher token numbers.
- safe::interpConfigure $i -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0 auto1] \
- [file join $ZipMountPoint auto0 auto2]]
+ safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]
# Inspect.
set confB [safe::interpConfigure $i]
set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
@@ -506,26 +538,24 @@ apply [list {} {
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
- list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
- [lsort [list $path3 $path4 $path5]] -- $modsB -- \
- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
- $out0 $out1 $out2
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
foreach path [lreverse $oldTm] {
tcl::tm::path add $path
}
safe::interpDelete $i
- } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
- {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
- 0 0.5 0 1.0 0 2.0 --\
- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
- ZIPDIR/auto0/modules/mod2} --\
- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
- ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
- res0 res1 res2}
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} -- {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} -- 0 0.5 0 1.0 0 2.0 -- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- res0 res1 res2}
# See comments on lsort after test safe-zipfs-9.20.
- test safe-zipfs-9.22 {interpConfigure change the access path; check module loading; stale data case 0; zipfs} -setup {
+ test safe-zipfs-9.22 {interpConfigure change the access path; check module loading, with conventional AutoPathSync; stale data case 0; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
@@ -544,9 +574,7 @@ apply [list {} {
# Add to access path.
# This injects more tokens, pushing modules to higher token numbers.
- safe::interpConfigure $i -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0 auto1] \
- [file join $ZipMountPoint auto0 auto2]]
+ safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]
# Inspect.
set confB [safe::interpConfigure $i]
set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
@@ -563,26 +591,24 @@ apply [list {} {
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
- list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
- [lsort [list $path3 $path4 $path5]] -- $modsB -- \
- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
- $out0 $out1 $out2
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
foreach path [lreverse $oldTm] {
tcl::tm::path add $path
}
safe::interpDelete $i
- } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
- {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
- 0 0.5 0 1.0 0 2.0 --\
- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
- ZIPDIR/auto0/modules/mod2} --\
- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
- ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
- res0 res1 res2}
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} -- {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} -- 0 0.5 0 1.0 0 2.0 -- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- res0 res1 res2}
# See comments on lsort after test safe-zipfs-9.20.
- test safe-zipfs-9.23 {interpConfigure change the access path; check module loading; stale data case 3; zipfs} -setup {
+ test safe-zipfs-9.23 {interpConfigure change the access path; check module loading, with conventional AutoPathSync; stale data case 3; zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
@@ -606,9 +632,7 @@ apply [list {} {
# Add to access path.
# This injects more tokens, pushing modules to higher token numbers.
- safe::interpConfigure $i -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0 auto1] \
- [file join $ZipMountPoint auto0 auto2]]
+ safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]
# Inspect.
set confB [safe::interpConfigure $i]
set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
@@ -630,26 +654,24 @@ apply [list {} {
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
- list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
- [lsort [list $path3 $path4 $path5]] -- $modsB -- \
- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
- $out0 $out1 $out2
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
foreach path [lreverse $oldTm] {
tcl::tm::path add $path
}
safe::interpDelete $i
- } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
- {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
- 0 0.5 0 1.0 0 2.0 --\
- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
- ZIPDIR/auto0/modules/mod2} --\
- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
- ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
- res0 res1 res2}
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} -- {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} -- 0 0.5 0 1.0 0 2.0 -- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- res0 res1 res2}
# See comments on lsort after test safe-zipfs-9.20.
- test safe-zipfs-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case); zipfs} -setup {
+ test safe-zipfs-9.24 {interpConfigure change the access path; check module loading, with conventional AutoPathSync; stale data case 2 (worst case); zipfs} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
@@ -673,9 +695,7 @@ apply [list {} {
# Add to access path.
# This injects more tokens, pushing modules to higher token numbers.
- safe::interpConfigure $i -accessPath [list $tcl_library \
- [file join $ZipMountPoint auto0 auto1] \
- [file join $ZipMountPoint auto0 auto2]]
+ safe::interpConfigure $i -accessPath [list $tcl_library [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]]
# Inspect.
set confB [safe::interpConfigure $i]
set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
@@ -692,26 +712,116 @@ apply [list {} {
set out1 [interp eval $i {mod1::test1::try1}]
set out2 [interp eval $i {mod2::test2::try2}]
- list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
- [lsort [list $path3 $path4 $path5]] -- $modsB -- \
- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
- $out0 $out1 $out2
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- [lsort [list $path3 $path4 $path5]] -- $modsB -- $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- $out0 $out1 $out2
} -cleanup {
tcl::tm::path remove [file join $ZipMountPoint auto0 modules]
foreach path [lreverse $oldTm] {
tcl::tm::path add $path
}
safe::interpDelete $i
- } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
- {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
- 0 0.5 0 1.0 0 2.0 --\
- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1\
- ZIPDIR/auto0/modules/mod2} --\
- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules\
- ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} --\
- res0 res1 res2}
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} -- {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} -- 0 0.5 0 1.0 0 2.0 -- {TCLLIB ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- {TCLLIB ZIPDIR/auto0/auto1 ZIPDIR/auto0/auto2 ZIPDIR/auto0/modules ZIPDIR/auto0/modules/mod1 ZIPDIR/auto0/modules/mod2} -- res0 res1 res2}
# See comments on lsort after test safe-zipfs-9.20.
-
+
+ test safe-zipfs-18.1 {cf. safe-zipfs-7.1 - tests that everything works at high level without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ # Without AutoPathSync, we need a more complete auto_path,
+ # because the child will use the same value.
+ set lib1 [info library]
+ set lib2 [file join $ZipMountPoint auto0]
+ set ::auto_TMP $::auto_path
+ set ::auto_path [list $lib1 $lib2]
+
+ set i [safe::interpCreate]
+ set ::auto_path $::auto_TMP
+ } -body {
+ # no error shall occur:
+ # (because the default access_path shall include 1st level sub dirs so
+ # package require in a child works like in the parent)
+ set v [interp eval $i {package require SafeTestPackage1}]
+ # no error shall occur:
+ interp eval $i HeresPackage1
+ set v
+ } -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result 1.2.3
+ test safe-zipfs-18.2 {cf. safe-zipfs-7.2 - tests specific path and interpFind/AddToAccessPath without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ } -body {
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
+ set auto1 [interp eval $i {set ::auto_path}]
+ interp eval $i {set ::auto_path [list {$p(:0:)}]}
+ # should not add anything (p0)
+ set token1 [safe::interpAddToAccessPath $i [info library]]
+ # should add as p* (not p1 if parent has a module path)
+ set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
+ # should add as p* (not p2 if parent has a module path)
+ set token3 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0]]
+ # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level
+ # provided deep path)
+ list $auto1 $token1 $token2 $token3 [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg [safe::interpConfigure $i] [safe::interpDelete $i]
+ } -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result "{} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)} 1 {can't find package SafeTestPackage1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path $ZipMountPoint/auto0]} -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}"
+ test safe-zipfs-18.4 {cf. safe-zipfs-7.4 - tests specific path and positive search and auto_path without conventional AutoPathSync; zipfs} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ } -body {
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
+
+ # should not have been set by Safe Base:
+ set auto1 [interp eval $i {set ::auto_path}]
+
+ # This will differ from the value -autoPath {}
+ interp eval $i {set ::auto_path [list {$p(:0:)}]}
+
+ # should not add anything (p0)
+ set token1 [safe::interpAddToAccessPath $i [info library]]
+
+ # should add as p* (not p1 if parent has a module path)
+ set token2 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0]]
+
+ # should add as p* (not p2 if parent has a module path)
+ set token3 [safe::interpAddToAccessPath $i [file join $ZipMountPoint auto0 auto1]]
+
+ # should not have been changed by Safe Base:
+ set auto2 [interp eval $i {set ::auto_path}]
+
+ # This will differ from the value -autoPath {}
+ set auto3 [interp eval $i [list set ::auto_path [list {$p(:0:)} $token2]]]
+
+ # This time, unlike test safe-zipfs-18.2 and the try above, SafeTestPackage1 should be found:
+ list $auto1 $auto2 $token1 $token2 $token3 [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg [safe::interpConfigure $i] [safe::interpDelete $i]
+ } -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+ } -match glob -result "{} {{\$p(:0:)}} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)} 0 1.2.3 {-accessPath {[list $tcl_library *$ZipMountPoint/auto0 $ZipMountPoint/auto0/auto1]} -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}"
+
# cleanup
set ::auto_path $SaveAutoPath
zipfs unmount ${ZipMountPoint}
diff --git a/tests/safe.test b/tests/safe.test
index 148215a..e5d4d18 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -8,7 +8,7 @@
# - Tests that used http are replaced here with tests that use example packages
# provided in subdirectory auto0 of the tests directory, which are independent
# of any changes made to the packages provided with Tcl itself.
-# - These are tests 7.1 7.2 7.4 9.11 9.13
+# - These are tests 7.1 7.2 7.4 9.11 9.13 17.1 17.2 17.4
# - Tests 5.* test the example packages themselves before they
# are used to test Safe Base interpreters.
# - Alternative tests using stock packages of Tcl 8.7 are in file
@@ -36,6 +36,11 @@ set ::auto_path [info library]
set TestsDir [file normalize [file dirname [info script]]]
set PathMapp [list $tcl_library TCLLIB $TestsDir TESTSDIR]
+proc getAutoPath {child} {
+ set ap1 [lrange [lindex [safe::interpConfigure $child -autoPath] 1] 0 end]
+ set ap2 [::safe::DetokPath $child [interp eval $child set ::auto_path]]
+ list $ap1 -- $ap2
+}
proc mapList {map listIn} {
set listOut {}
foreach element $listIn {
@@ -59,13 +64,28 @@ catch {safe::interpConfigure}
# package - tcl::test - but it might be absent if we're in standard tclsh)
testConstraint tcl::test [expr {![catch {package require tcl::test}]}]
+testConstraint AutoSyncDefined 1
+### 1. Basic help/error messages.
+
test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body {
safe::interpConfigure
} -result {no value given for parameter "child" (use -help for full usage) :
child name () name of the child}
-test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
+test safe-1.2 {safe::interpCreate syntax, Sync Mode on} -returnCodes error -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ } else {
+ set SyncVal_TMP 1
+ }
+} -body {
safe::interpCreate -help
+} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -result {Usage information:
Var/FlagName Type Value Help
------------ ---- ----- ----
@@ -77,11 +97,39 @@ test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
-nestedLoadOk boolflag (false) allow nested loading
-nested boolean (false) nested loading
-deleteHook script () delete hook}
+test safe-1.2.1 {safe::interpCreate syntax, Sync Mode off} -returnCodes error -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ safe::interpCreate -help
+} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {Usage information:
+ Var/FlagName Type Value Help
+ ------------ ---- ----- ----
+ (-help gives this help)
+ ?child? name () name of the child (optional)
+ -accessPath list () access path for the child
+ -noStatics boolflag (false) prevent loading of statically linked pkgs
+ -statics boolean (true) loading of statically linked pkgs
+ -nestedLoadOk boolflag (false) allow nested loading
+ -nested boolean (false) nested loading
+ -deleteHook script () delete hook
+ -autoPath list () ::auto_path for the child}
test safe-1.3 {safe::interpInit syntax} -returnCodes error -body {
safe::interpInit -noStatics
} -result {bad value "-noStatics" for parameter
child name () name of the child}
+### 2. Aliases in a new "interp create" interpreter.
+
test safe-2.1 {creating interpreters, should have no aliases} emptyTest {
# Disabled this test. It tests nothing sensible. [Bug 999612]
# interp aliases
@@ -105,6 +153,9 @@ test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -s
interp delete a
} -result {clock}
+### 3. Simple use of interpCreate, interpInit.
+### Aliases in a new "interpCreate/interpInit" interpreter.
+
test safe-3.1 {calling safe::interpInit is safe} -setup {
catch {safe::interpDelete a}
interp create a -safe
@@ -139,6 +190,8 @@ test safe-3.4 {calling safe::interpCreate on trusted interp} -setup {
safe::interpDelete a
} -result {}
+### 4. Testing safe::interpDelete, double interpCreate.
+
test safe-4.1 {safe::interpDelete} -setup {
catch {safe::interpDelete a}
} -body {
@@ -171,9 +224,9 @@ test safe-4.6 {safe::interpDelete, indirectly} -setup {
a eval exit
} -result ""
-# The old test "safe-5.1" has been moved to "safe-stock-9.8".
-# A replacement test using example files is "safe-9.8".
-# Tests 5.* test the example files before using them to test safe interpreters.
+### 5. Test the example files before using them to test safe interpreters.
+### The old test "safe-5.1" has been moved to "safe-stock-9.8".
+### A replacement test using example files is "safe-9.8".
unset -nocomplain path
@@ -286,7 +339,8 @@ test safe-5.6 {example modules packages, test in parent interpreter, append to p
catch {namespace delete ::mod1}
} -match glob -result {0 0.5 0 1.0 0 2.0 -- res0 res1 res2}
-# test safe interps 'information leak'
+### 6. Test safe interps 'information leak'.
+
proc SafeEval {script} {
# Helper procedure that ensures the safe interp is cleaned up even if
# there is a failure in the script.
@@ -316,9 +370,16 @@ rename SafeEval {}
# More test should be added to check that hostname, nameofexecutable, aren't
# leaking infos, but they still do...
-# high level general test
-# Use example packages not http1.0 etc
-test safe-7.1 {tests that everything works at high level} -setup {
+### 7. Test the use of ::auto_path for loading commands (via tclIndex files)
+### and non-module packages (via pkgIndex.tcl files).
+### Corresponding tests with Sync Mode off are 17.*
+
+test safe-7.1 {positive non-module package require, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set tmpAutoPath $::auto_path
lappend ::auto_path [file join $TestsDir auto0]
set i [safe::interpCreate]
@@ -333,8 +394,18 @@ test safe-7.1 {tests that everything works at high level} -setup {
set v
} -cleanup {
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result 1.2.3
-test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup {
+test safe-7.2 {negative non-module package require with specific path and interpAddToAccessPath, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ } else {
+ set SyncVal_TMP 1
+ }
} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not add anything (p0)
@@ -345,12 +416,14 @@ test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -setup {
set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]]
set confA [safe::interpConfigure $i]
set mappA [mapList $PathMapp [dict get $confA -accessPath]]
- # an error shall occur (SafeTestPackage1 is not anymore in the secure 0-level
- # provided deep path)
+ # an error shall occur (SafeTestPackage1 is not in auto0 but a subdirectory)
list $token1 $token2 $token3 -- \
[catch {interp eval $i {package require SafeTestPackage1}} msg] $msg -- \
$mappA -- [safe::interpDelete $i]
} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{$p(:0:)} {$p(:*:)} {$p(:*:)} --\
1 {can't find package SafeTestPackage1} --\
{TCLLIB */dummy/unixlike/test/path TESTSDIR/auto0} -- {}}
@@ -385,7 +458,14 @@ test safe-7.3.1 {check that safe subinterpreters work with namespace names} -set
[safe::interpDelete $i] \
[interp exists $j] [info vars ::safe::S*]
} -match glob -result {{} {} ok ok {} 0 {}}
-test safe-7.4 {tests specific path and positive search} -setup {
+test safe-7.4 {positive non-module package require with specific path and interpAddToAccessPath, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ } else {
+ set SyncVal_TMP 1
+ }
} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not add anything (p0)
@@ -401,10 +481,39 @@ test safe-7.4 {tests specific path and positive search} -setup {
# Note that the glob match elides directories (those from the module path)
# other than the first and last in the access path.
} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{$p(:0:)} {$p(:*:)} -- 0 1.2.3 --\
{TCLLIB * TESTSDIR/auto0/auto1} -- {}}
+test safe-7.5 {positive and negative module package require, including ancestor directory issue, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+ set i [safe::interpCreate]
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ interp eval $i {
+ package forget mod1::test1
+ catch {namespace delete ::mod1}
+ }
+} -body {
+ # Should raise an error (module ancestor directory issue)
+ set code1 [catch {interp eval $i {package require test1}} msg1]
+ # Should not raise an error
+ set code2 [catch {interp eval $i {package require mod1::test1}} msg2]
+ return [list $code1 $msg1 $code2]
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {1 {can't find package test1} 0}
+
+### 8. Test source control on file name.
-# test source control on file name
test safe-8.1 {safe source control on file} -setup {
set i "a"
catch {safe::interpDelete $i}
@@ -549,6 +658,9 @@ test safe-8.10 {safe source and return} -setup {
unset i
} -result ok
+### 9. Assorted options, including changes to option values.
+### If Sync Mode is on, a corresponding test with Sync Mode off is 19.*
+
test safe-9.1 {safe interps' deleteHook} -setup {
set i "a"
catch {safe::interpDelete $i}
@@ -651,7 +763,12 @@ test safe-9.7 {interpConfigure widget like behaviour (demystified)} -body {
{-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}}\
{-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}}\
{-accessPath * -statics 0 -nested 0 -deleteHook toto}}
-test safe-9.8 {test autoloading commands indexed in tclIndex files} -setup {
+test safe-9.8 {autoloading commands indexed in tclIndex files, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto1] \
@@ -669,9 +786,17 @@ test safe-9.8 {test autoloading commands indexed in tclIndex files} -setup {
list $path1 $path2 -- $code1 $msg1 $code2 $msg2 -- $mappA
} -cleanup {
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{$p(:1:)} {$p(:2:)} -- 0 ok1 0 ok2 --\
{TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*}}
-test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset)} -setup {
+test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset), Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto1] \
@@ -707,10 +832,18 @@ test safe-9.9 {interpConfigure change the access path; tclIndex commands unaffec
list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
} -cleanup {
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\
{TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
{TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}}
-test safe-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset)} -setup {
+test safe-9.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset), Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto1] \
@@ -744,11 +877,19 @@ test safe-9.10 {interpConfigure change the access path; tclIndex commands unaffe
list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- $mappA -- $mappB
} -cleanup {
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
0 ok1 0 ok2 --\
{TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
{TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*}}
-test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement} -setup {
+test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
# For complete correspondence to safe-9.10opt, include auto0 in access path.
set i [safe::interpCreate -accessPath [list $tcl_library \
@@ -788,11 +929,19 @@ test safe-9.11 {interpConfigure change the access path; pkgIndex.tcl packages un
$mappA -- $mappB -- $code5 $msg5 $code6 $msg6
} -cleanup {
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\
{TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
{TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
0 OK1 0 OK2}
-test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, 9.10 without path auto0} -setup {
+test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, safe-9.11 without path auto0, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto1] \
@@ -827,12 +976,20 @@ test safe-9.12 {interpConfigure change the access path; pkgIndex.tcl packages un
$code5 $msg5 $code6 $msg6
} -cleanup {
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
0 1.2.3 0 2.3.4 --\
{TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
{TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
0 OK1 0 OK2}
-test safe-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed} -setup {
+test safe-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
} -body {
set i [safe::interpCreate -accessPath [list $tcl_library \
[file join $TestsDir auto0 auto1] \
@@ -863,10 +1020,18 @@ test safe-9.13 {interpConfigure change the access path; pkgIndex.tcl packages fa
$mappA -- $mappB
} -cleanup {
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{$p(:1:)} {$p(:2:)} -- 1 {* not found in access path} --\
1 {* not found in access path} -- 1 1 --\
{TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} -- {TCLLIB*}}
-test safe-9.20 {check module loading} -setup {
+test safe-9.20 {check module loading, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
@@ -899,6 +1064,9 @@ test safe-9.20 {check module loading} -setup {
tcl::tm::path add $path
}
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
0 0.5 0 1.0 0 2.0 --\
{TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
@@ -912,7 +1080,12 @@ test safe-9.20 {check module loading} -setup {
# directories in the access path. Both those things must be sorted before
# comparing with expected results. The test is therefore not totally strict,
# but will notice missing or surplus directories.
-test safe-9.21 {interpConfigure change the access path; check module loading; stale data case 1} -setup {
+test safe-9.21 {interpConfigure change the access path; check module loading, Sync Mode on; stale data case 1} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
@@ -965,6 +1138,9 @@ test safe-9.21 {interpConfigure change the access path; check module loading; st
tcl::tm::path add $path
}
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
{{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
0 0.5 0 1.0 0 2.0 --\
@@ -974,7 +1150,12 @@ test safe-9.21 {interpConfigure change the access path; check module loading; st
TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
res0 res1 res2}
# See comments on lsort after test safe-9.20.
-test safe-9.22 {interpConfigure change the access path; check module loading; stale data case 0} -setup {
+test safe-9.22 {interpConfigure change the access path; check module loading, Sync Mode on; stale data case 0} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
@@ -1022,6 +1203,9 @@ test safe-9.22 {interpConfigure change the access path; check module loading; st
tcl::tm::path add $path
}
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
{{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
0 0.5 0 1.0 0 2.0 --\
@@ -1031,7 +1215,12 @@ test safe-9.22 {interpConfigure change the access path; check module loading; st
TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
res0 res1 res2}
# See comments on lsort after test safe-9.20.
-test safe-9.23 {interpConfigure change the access path; check module loading; stale data case 3} -setup {
+test safe-9.23 {interpConfigure change the access path; check module loading, Sync Mode on; stale data case 3} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
@@ -1089,6 +1278,9 @@ test safe-9.23 {interpConfigure change the access path; check module loading; st
tcl::tm::path add $path
}
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
{{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
0 0.5 0 1.0 0 2.0 --\
@@ -1098,7 +1290,12 @@ test safe-9.23 {interpConfigure change the access path; check module loading; st
TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
res0 res1 res2}
# See comments on lsort after test safe-9.20.
-test safe-9.24 {interpConfigure change the access path; check module loading; stale data case 2 (worst case)} -setup {
+test safe-9.24 {interpConfigure change the access path; check module loading, Sync Mode on; stale data case 2 (worst case)} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
set oldTm [tcl::tm::path list]
foreach path $oldTm {
tcl::tm::path remove $path
@@ -1151,6 +1348,9 @@ test safe-9.24 {interpConfigure change the access path; check module loading; st
tcl::tm::path add $path
}
safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
{{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
0 0.5 0 1.0 0 2.0 --\
@@ -1161,6 +1361,8 @@ test safe-9.24 {interpConfigure change the access path; check module loading; st
res0 res1 res2}
# See comments on lsort after test safe-9.20.
+### 10. Test options -statics -nostatics -nested -nestedloadok
+
catch {teststaticlibrary Safepfx1 0 0}
test safe-10.1 {testing statics loading} -constraints tcl::test -setup {
set i [safe::interpCreate]
@@ -1214,6 +1416,8 @@ test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints t
invoked from within
"interp eval $i {interp create x; load {} Safepfx1 x}"}
+### 11. Safe encoding.
+
test safe-11.1 {testing safe encoding} -setup {
set i [safe::interpCreate]
} -body {
@@ -1308,6 +1512,9 @@ test safe-11.8.1 {testing safe encoding} -setup {
invoked from within
"interp eval $i encoding convertto"}
+### 12. Safe glob.
+### More tests of glob in sections 13, 16.
+
test safe-12.1 {glob is restricted [Bug 2906841]} -setup {
set i [safe::interpCreate]
} -body {
@@ -1358,6 +1565,9 @@ test safe-12.7 {glob is restricted} -setup {
safe::interpDelete $i
} -result {permission denied}
+### 13. More tests for Safe base glob, with patches @ Bug 2964715
+### More tests of glob in sections 12, 16.
+
proc buildEnvironment {filename} {
upvar 1 testdir testdir testdir2 testdir2 testfile testfile
set testdir [makeDirectory deletethisdir]
@@ -1373,7 +1583,7 @@ proc buildEnvironment2 {filename} {
set testdir3 [makeDirectory deleteme $testdir]
set testfile2 [makeFile {} $filename $testdir3]
}
-#### New tests for Safe base glob, with patches @ Bug 2964715
+
test safe-13.1 {glob is restricted [Bug 2964715]} -setup {
set i [safe::interpCreate]
} -body {
@@ -1510,7 +1720,8 @@ test safe-13.10 {as 13.8 but test silent failure when result is outside access_p
rename buildEnvironment {}
rename buildEnvironment2 {}
-#### Test for the module path
+### 14. Sanity checks on paths - module path, access path, auto_path.
+
test safe-14.1 {Check that module path is the same as in the parent interpreter [Bug 2964715]} -setup {
set i [safe::interpCreate]
} -body {
@@ -1522,6 +1733,122 @@ test safe-14.1 {Check that module path is the same as in the parent interpreter
} -cleanup {
safe::interpDelete $i
} -result [::tcl::tm::path list]
+test safe-14.2 {Check that first element of child auto_path (and access path) is Tcl Library, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
+
+ set lib1 [info library]
+ set lib2 [file dirname $lib1]
+ set ::auto_TMP $::auto_path
+ set ::auto_path [list $lib1 $lib2]
+
+ set i [safe::interpCreate]
+} -body {
+ set autoList {}
+ set token [lindex [$i eval set ::auto_path] 0]
+ set auto0 [dict get [set ::safe::S${i}(access_path,map)] $token]
+ set accessList [lindex [safe::interpConfigure $i -accessPath] 1]
+ return [list [lindex $accessList 0] $auto0]
+} -cleanup {
+ set ::auto_path $::auto_TMP
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [info library] [info library]]
+test safe-14.2.1 {Check that first element of child auto_path (and access path) is Tcl Library, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+
+ set lib1 [info library]
+ set lib2 [file dirname $lib1]
+ set ::auto_TMP $::auto_path
+ set ::auto_path [list $lib1 $lib2]
+
+ set i [safe::interpCreate]
+} -body {
+ set autoList {}
+ set token [lindex [$i eval set ::auto_path] 0]
+ set auto0 [dict get [set ::safe::S${i}(access_path,map)] $token]
+ set accessList [lindex [safe::interpConfigure $i -accessPath] 1]
+ set autoList [lindex [safe::interpConfigure $i -autoPath] 1]
+ return [list [lindex $accessList 0] [lindex $autoList 0] $auto0]
+} -cleanup {
+ set ::auto_path $::auto_TMP
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [info library] [info library] [info library]]
+test safe-14.3 {Check that first element of child auto_path (and access path) is Tcl Library, even if not true for parent, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
+
+ set lib1 [info library]
+ set lib2 [file dirname $lib1]
+ set ::auto_TMP $::auto_path
+ set ::auto_path [list $lib2 $lib1]
+ # Unexpected order, should be reversed in the child
+
+ set i [safe::interpCreate]
+} -body {
+ set autoList {}
+ set token [lindex [$i eval set ::auto_path] 0]
+ set auto0 [dict get [set ::safe::S${i}(access_path,map)] $token]
+ set accessList [lindex [safe::interpConfigure $i -accessPath] 1]
+
+ return [list [lindex $accessList 0] $auto0]
+} -cleanup {
+ set ::auto_path $::auto_TMP
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [info library] [info library]]
+test safe-14.3.1 {Check that first element of child auto_path (and access path) is Tcl Library, even if not true for parent, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+
+ set lib1 [info library]
+ set lib2 [file dirname $lib1]
+ set ::auto_TMP $::auto_path
+ set ::auto_path [list $lib2 $lib1]
+ # Unexpected order, should be reversed in the child
+
+ set i [safe::interpCreate]
+} -body {
+ set autoList {}
+ set token [lindex [$i eval set ::auto_path] 0]
+ set auto0 [dict get [set ::safe::S${i}(access_path,map)] $token]
+ set accessList [lindex [safe::interpConfigure $i -accessPath] 1]
+ set autoList [lindex [safe::interpConfigure $i -autoPath] 1]
+
+ return [list [lindex $accessList 0] [lindex $autoList 0] $auto0]
+} -cleanup {
+ set ::auto_path $::auto_TMP
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [info library] [info library] [info library]]
+
+### 15. Safe file ensemble.
test safe-15.1 {safe file ensemble does not surprise code} -setup {
set i [interp create -safe]
@@ -1560,7 +1887,10 @@ test safe-15.2 {safe file ensemble does not surprise code} -setup {
invoked from within
"interp eval $i {file isdirectory .}"}}
-### ~ should have no special meaning in paths in safe interpreters
+### 16. ~ should have no special meaning in paths in safe interpreters.
+### Defang it in glob.
+### More tests of glob in sections 12, 13.
+
test safe-16.1 {Bug 3529949: defang ~ in paths} -setup {
set savedHOME $env(HOME)
set env(HOME) /foo/bar
@@ -1654,10 +1984,1576 @@ test safe-16.8 {Bug 3529949: defang ~user in paths used by AliasGlob (2)} -setup
safe::interpDelete $i
unset user
} -result {~USER}
+
+### 17. Test the use of ::auto_path for loading commands (via tclIndex files)
+### and non-module packages (via pkgIndex.tcl files).
+### Corresponding tests with Sync Mode on are 7.*
+
+test safe-17.1 {cf. safe-7.1 - positive non-module package require, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ # Without AutoPathSync, we need a more complete auto_path,
+ # because the child will use the same value.
+ set lib1 [info library]
+ set lib2 [file join $TestsDir auto0]
+ set ::auto_TMP $::auto_path
+ set ::auto_path [list $lib1 $lib2]
+
+ set i [safe::interpCreate]
+ set ::auto_path $::auto_TMP
+} -body {
+ # no error shall occur:
+ # (because the default access_path shall include 1st level sub dirs so
+ # package require in a child works like in the parent)
+ set v [interp eval $i {package require SafeTestPackage1}]
+ # no error shall occur:
+ interp eval $i HeresPackage1
+ set v
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result 1.2.3
+test safe-17.2 {cf. safe-7.2 - negative non-module package require with specific path and interpAddToAccessPath, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
+ # should not have been set by Safe Base:
+ set auto1 [interp eval $i {set ::auto_path}]
+ # This does not change the value of option -autoPath:
+ interp eval $i {set ::auto_path [list {$p(:0:)}]}
+ # should not add anything (p0)
+ set token1 [safe::interpAddToAccessPath $i [info library]]
+ # should add as p* (not p1 if parent has a module path)
+ set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
+ # should add as p* (not p2 if parent has a module path)
+ set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]]
+ # an error shall occur (SafeTestPackage1 is not in auto0 but a subdirectory)
+ list $auto1 $token1 $token2 $token3 \
+ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \
+ [safe::interpConfigure $i]\
+ [safe::interpDelete $i]
+} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result "{} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)}\
+ 1 {can't find package SafeTestPackage1}\
+ {-accessPath {[list $tcl_library \
+ */dummy/unixlike/test/path \
+ $TestsDir/auto0]}\
+ -statics 0 -nested 1 -deleteHook {} -autoPath {}} {}"
+# (not a counterpart of safe-7.3)
+test safe-17.3 {Check that default auto_path is the same as in the parent interpreter, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate]
+} -body {
+ # This file's header sets auto_path to a single directory [info library],
+ # which is the one required by Safe Base to be present & first in the list.
+ set ap {}
+ foreach token [$i eval set ::auto_path] {
+ lappend ap [dict get [set ::safe::S${i}(access_path,map)] $token]
+ }
+ return [list $ap [lindex [::safe::interpConfigure $i -autoPath] 1]]
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list $::auto_path $::auto_path]
+test safe-17.4 {cf. safe-7.4 - positive non-module package require with specific path and interpAddToAccessPath, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
+
+ # should not have been set by Safe Base:
+ set auto1 [interp eval $i {set ::auto_path}]
+
+ # This does not change the value of option -autoPath.
+ interp eval $i {set ::auto_path [list {$p(:0:)}]}
+
+ # should not add anything (p0)
+ set token1 [safe::interpAddToAccessPath $i [info library]]
+
+ # should add as p* (not p1 if parent has a module path)
+ set token2 [safe::interpAddToAccessPath $i [file join $TestsDir auto0]]
+
+ # should add as p* (not p2 if parent has a module path)
+ set token3 [safe::interpAddToAccessPath $i [file join $TestsDir auto0 auto1]]
+
+ # should not have been changed by Safe Base:
+ set auto2 [interp eval $i {set ::auto_path}]
+
+ set auto3 [interp eval $i [list set ::auto_path [list {$p(:0:)} $token2]]]
+
+ # This time, unlike test safe-17.2 and the try above, SafeTestPackage1 should be found:
+ list $auto1 $auto2 $token1 $token2 $token3 \
+ [catch {interp eval $i {package require SafeTestPackage1}} msg] $msg \
+ [safe::interpConfigure $i]\
+ [safe::interpDelete $i]
+} -cleanup {
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result "{} {{\$p(:0:)}} {\$p(:0:)} {\$p(:*:)} {\$p(:*:)} 0 1.2.3\
+ {-accessPath {[list $tcl_library *$TestsDir/auto0 $TestsDir/auto0/auto1]}\
+ -statics 0 -nested 1 -deleteHook {}\
+ -autoPath {}} {}"
+test safe-17.5 {cf. safe-7.5 - positive and negative module package require, including ancestor directory issue, Sync Mode off} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+ set i [safe::interpCreate]
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ interp eval $i {
+ package forget mod1::test1
+ catch {namespace delete ::mod1}
+ }
+} -body {
+ # Should raise an error (tests module ancestor directory rule)
+ set code1 [catch {interp eval $i {package require test1}} msg1]
+ # Should not raise an error
+ set code2 [catch {interp eval $i {package require mod1::test1}} msg2]
+ return [list $code1 $msg1 $code2]
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {1 {can't find package test1} 0}
+
+### 18. Test tokenization of directories available to a child.
+
+test safe-18.1 {Check that each directory of the default auto_path is a valid token, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
+ set i [safe::interpCreate]
+} -body {
+ set badTokens {}
+ foreach dir [$i eval {set ::auto_path}] {
+ if {[regexp {^\$p\(:[0-9]+:\)$} $dir]} {
+ # Match - OK - token has expected form
+ } else {
+ # No match - possibly an ordinary path has not been tokenized
+ lappend badTokens $dir
+ }
+ }
+ set badTokens
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {}
+test safe-18.1.1 {Check that each directory of the default auto_path is a valid token, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate]
+} -body {
+ set badTokens {}
+ foreach dir [$i eval {set ::auto_path}] {
+ if {[regexp {^\$p\(:[0-9]+:\)$} $dir]} {
+ # Match - OK - token has expected form
+ } else {
+ # No match - possibly an ordinary path has not been tokenized
+ lappend badTokens $dir
+ }
+ }
+ set badTokens
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {}
+test safe-18.2 {Check that each directory of the module path is a valid token, Sync Mode on} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 1
+ }
+ set i [safe::interpCreate]
+} -body {
+ set badTokens {}
+ foreach dir [$i eval {::tcl::tm::path list}] {
+ if {[regexp {^\$p\(:[0-9]+:\)$} $dir]} {
+ # Match - OK - token has expected form
+ } else {
+ # No match - possibly an ordinary path has not been tokenized
+ lappend badTokens $dir
+ }
+ }
+ set badTokens
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {}
+test safe-18.2.1 {Check that each directory of the module path is a valid token, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate]
+} -body {
+ set badTokens {}
+ foreach dir [$i eval {::tcl::tm::path list}] {
+ if {[regexp {^\$p\(:[0-9]+:\)$} $dir]} {
+ # Match - OK - token has expected form
+ } else {
+ # No match - possibly an ordinary path has not been tokenized
+ lappend badTokens $dir
+ }
+ }
+ set badTokens
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {}
+
+### 19. Assorted options, including changes to option values.
+### Mostly these are changes to access path, auto_path, module path.
+### If Sync Mode is on, a corresponding test with Sync Mode off is 9.*
+
+test safe-19.8 {autoloading commands indexed in tclIndex files, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load and run the commands.
+ set code1 [catch {interp eval $i {report1}} msg1]
+ set code2 [catch {interp eval $i {report2}} msg2]
+
+ list $path1 $path2 -- $code1 $msg1 $code2 $msg2 -- $mappA -- $mappC -- $toksC
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- 0 ok1 0 ok2 --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {{$p(:0:)} {$p(:1:)} {$p(:2:)}}}
+test safe-19.9 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (dummy test of doreset), Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load auto_load data.
+ interp eval $i {catch nonExistentCommand}
+
+ # Load and run the commands.
+ # This guarantees the test will pass even if the tokens are swapped.
+ set code1 [catch {interp eval $i {report1}} msg1]
+ set code2 [catch {interp eval $i {report2}} msg2]
+
+ # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto2] \
+ [file join $TestsDir auto0 auto1]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappD [mapList $PathMapp [dict get $confB -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # Run the commands.
+ set code3 [catch {interp eval $i {report1}} msg3]
+ set code4 [catch {interp eval $i {report2}} msg4]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- $mappC -- $mappD -- $toksC -- $toksD
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} -- 0 ok1 0 ok2 --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {{$p(:0:)} {$p(:1:)} {$p(:2:)}} -- {{$p(:0:)} {$p(:2:)} {$p(:1:)}}}
+test safe-19.10 {interpConfigure change the access path; tclIndex commands unaffected by token rearrangement (actual test of doreset), Sync Mode off} -constraints {AutoSyncDefined} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load auto_load data.
+ interp eval $i {catch nonExistentCommand}
+
+ # Do not load the commands. With the tokens swapped, the test
+ # will pass only if the Safe Base has called auto_reset.
+
+ # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:2:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto2] \
+ [file join $TestsDir auto0 auto1]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappD [mapList $PathMapp [dict get $confB -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # Load and run the commands.
+ set code3 [catch {interp eval $i {report1}} msg3]
+ set code4 [catch {interp eval $i {report2}} msg4]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- $mappC -- $mappD -- $toksC -- $toksD
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
+ 0 ok1 0 ok2 --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\
+ {{$p(:0:)} {$p(:1:)} {$p(:2:)}} -- {{$p(:0:)} {$p(:2:)} {$p(:1:)}}}
+test safe-19.11 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement (1), Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}.
+ # This would have no effect because the records in Pkg of these directories
+ # were from access as children of {$p(:1:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto2] \
+ [file join $TestsDir auto0 auto1]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappD [mapList $PathMapp [dict get $confB -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
+ set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
+ set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
+ set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- $mappC -- $mappD -- $toksC -- $toksD -- \
+ $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} -- 0 1.2.3 0 2.3.4 --\
+ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
+ {TCLLIB TESTSDIR/auto0} -- {TCLLIB TESTSDIR/auto0} --\
+ {{$p(:0:)} {$p(:1:)}} -- {{$p(:0:)} {$p(:1:)}} --\
+ 0 OK1 0 OK2}
+test safe-19.12 {interpConfigure change the access path; pkgIndex.tcl packages unaffected by token rearrangement, safe-19.11 without path auto0, Sync Mode off} -constraints {AutoSyncDefined} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ # To manage without path auto0, use an auto_path that is unusual for
+ # package discovery.
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Swap tokens {$p(:2:)} and {$p(:3:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto2] \
+ [file join $TestsDir auto0 auto1]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0 auto2] \
+ [file join $TestsDir auto0 auto1]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappD [mapList $PathMapp [dict get $confB -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
+ set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
+ set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
+ set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
+
+ list $path1 $path2 -- $path3 $path4 -- $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- $mappC -- $mappD -- $toksC -- $toksD -- \
+ $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:2:)} {$p(:1:)} --\
+ 0 1.2.3 0 2.3.4 --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1*} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\
+ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1} --\
+ {{$p(:0:)} {$p(:1:)} {$p(:2:)}} -- {{$p(:0:)} {$p(:1:)} {$p(:2:)}} --\
+ 0 OK1 0 OK2}
+test safe-19.13 {interpConfigure change the access path; pkgIndex.tcl packages fail if directory de-listed, Sync Mode off} -constraints {AutoSyncDefined} -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ # Path auto0 added (cf. safe-9.3) because it is needed for auto_path.
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Limit access path. Remove tokens {$p(:2:)} and {$p(:3:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library]
+
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set code4 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]} path4]
+ set code5 [catch {::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]} path5]
+ set mappD [mapList $PathMapp [dict get $confB -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # Try to load the packages.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3]
+ set code6 [catch {interp eval $i {package require SafeTestPackage2}} msg6]
+
+ list $path1 $path2 -- $code4 $path4 -- $code5 $path5 -- $code3 $code6 -- \
+ $mappA -- $mappB -- $mappC -- $mappD -- $toksC -- $toksD
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:2:)} {$p(:3:)} -- 1 {* not found in access path} --\
+ 1 {* not found in access path} -- 1 1 --\
+ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB*} -- {TCLLIB TESTSDIR/auto0} -- {TCLLIB TESTSDIR/auto0} --\
+ {{$p(:0:)} {$p(:1:)}} -- {{$p(:0:)}}}
+# (no counterpart safe-9.14)
+test safe-19.14 {when interpConfigure changes the access path, ::auto_path uses -autoPath value and new tokens, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ # Test that although -autoPath is unchanged, the child's ::auto_path changes to
+ # reflect the changes in token mappings.
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Swap tokens {$p(:1:)} and {$p(:3:)}.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto2] \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappD [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
+ set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
+ set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
+ set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
+
+ list $path0 $path1 $path2 -- $path5 $path3 $path4 -- $toksC -- $toksD -- \
+ $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- $mappC -- $mappD -- $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:1:)} {$p(:2:)} {$p(:3:)} -- {$p(:3:)} {$p(:2:)} {$p(:1:)} -- {{$p(:0:)} {$p(:1:)}} -- {{$p(:0:)} {$p(:3:)}} -- 0 1.2.3 0 2.3.4 --\
+ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto2 TESTSDIR/auto0/auto1 TESTSDIR/auto0*} --\
+ {TCLLIB TESTSDIR/auto0} --\
+ {TCLLIB TESTSDIR/auto0} --\
+ 0 OK1 0 OK2}
+# (no counterpart safe-9.15)
+test safe-19.15 {when interpConfigure changes the access path, ::auto_path uses -autoPath value and new tokens, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ # Test that although -autoPath is unchanged, the child's ::auto_path changes to
+ # reflect the changes in token mappings; and that it is based on the -autoPath
+ # value, not the previously restricted child ::auto_path.
+ set i [safe::interpCreate -accessPath [list $tcl_library \
+ [file join $TestsDir auto0]] \
+ -autoPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]]
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappA [mapList $PathMapp [dict get $confA -accessPath]]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Add more directories.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto2]]
+ set mappD [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3 opts3]
+ set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4 opts4]
+ set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
+ set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
+
+ list $path0 -- $path5 $path3 $path4 -- $toksC -- $toksD -- \
+ $code3 $msg3 $code4 $msg4 -- \
+ $mappA -- $mappB -- $mappC -- $mappD -- $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:1:)} -- {$p(:1:)} {$p(:2:)} {$p(:3:)} -- {{$p(:0:)}} -- {{$p(:0:)} {$p(:2:)} {$p(:3:)}} -- 0 1.2.3 0 2.3.4 --\
+ {TCLLIB TESTSDIR/auto0*} --\
+ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2*} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2} --\
+ 0 OK1 0 OK2}
+# (no counterpart safe-9.16)
+test safe-19.16 {default value for -accessPath and -autoPath on creation; -autoPath preserved when -accessPath changes, ::auto_path using changed tokens, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set tmpAutoPath $::auto_path
+ set ::auto_path [list $tcl_library [file join $TestsDir auto0]]
+ set i [safe::interpCreate]
+ set ::auto_path $tmpAutoPath
+} -body {
+ # Test that the -autoPath acquires and keeps the parent's value unless otherwise specified.
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set mappC [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksC [interp eval $i set ::auto_path]
+
+ # Load pkgIndex.tcl data.
+ catch {interp eval $i {package require NOEXIST}}
+
+ # Rearrange access path. Remove a directory.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0] \
+ [file join $TestsDir auto0 auto1]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set mappB [mapList $PathMapp [dict get $confB -accessPath]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0]]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 auto1]]
+ set mappD [mapList $PathMapp [dict get $confA -autoPath]]
+ set toksD [interp eval $i set ::auto_path]
+
+ # Try to load the packages and run a command from each one.
+ set code3 [catch {interp eval $i {package require SafeTestPackage1}} msg3]
+ set code4 [catch {interp eval $i {package require SafeTestPackage2}} msg4]
+ set code5 [catch {interp eval $i {HeresPackage1}} msg5 opts5]
+ set code6 [catch {interp eval $i {HeresPackage2}} msg6 opts6]
+
+ list $path5 $path3 -- [lindex $toksC 0] [llength $toksC] -- \
+ $toksD -- $code3 $msg3 $code4 $msg4 -- \
+ $mappB -- $mappC -- $mappD -- $code5 $msg5 $code6 $msg6
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{$p(:1:)} {$p(:2:)} -- {$p(:0:)} 2 --\
+ {{$p(:0:)} {$p(:1:)}} -- 0 1.2.3 1 {can't find package SafeTestPackage2} --\
+ {TCLLIB TESTSDIR/auto0 TESTSDIR/auto0/auto1*} --\
+ {TCLLIB TESTSDIR/auto0} -- {TCLLIB TESTSDIR/auto0} --\
+ 0 OK1 1 {invalid command name "HeresPackage2"}}
+test safe-19.20 {check module loading, Sync Mode off} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
+ TESTSDIR/auto0/modules/mod2} -- res0 res1 res2}
+# See comments on lsort after test safe-9.20.
+test safe-19.21 {interpConfigure change the access path; check module loading, Sync Mode off; stale data case 1} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Add to access path.
+ # This injects more tokens, pushing modules to higher token numbers.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
+ set modsB [interp eval $i {tcl::tm::path list}]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Load pkg data.
+ catch {interp eval $i {package require NOEXIST}}
+ catch {interp eval $i {package require mod1::NOEXIST}}
+ catch {interp eval $i {package require mod2::NOEXIST}}
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
+ TESTSDIR/auto0/modules/mod2} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
+ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
+ res0 res1 res2}
+# See comments on lsort after test safe-9.20.
+test safe-19.22 {interpConfigure change the access path; check module loading, Sync Mode off; stale data case 0} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Add to access path.
+ # This injects more tokens, pushing modules to higher token numbers.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
+ set modsB [interp eval $i {tcl::tm::path list}]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
+ TESTSDIR/auto0/modules/mod2} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
+ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
+ res0 res1 res2}
+# See comments on lsort after test safe-9.20.
+test safe-19.23 {interpConfigure change the access path; check module loading, Sync Mode off; stale data case 3} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Force the interpreter to acquire pkg data which will soon become stale.
+ catch {interp eval $i {package require NOEXIST}}
+ catch {interp eval $i {package require mod1::NOEXIST}}
+ catch {interp eval $i {package require mod2::NOEXIST}}
+
+ # Add to access path.
+ # This injects more tokens, pushing modules to higher token numbers.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
+ set modsB [interp eval $i {tcl::tm::path list}]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Refresh stale pkg data.
+ catch {interp eval $i {package require NOEXIST}}
+ catch {interp eval $i {package require mod1::NOEXIST}}
+ catch {interp eval $i {package require mod2::NOEXIST}}
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
+ TESTSDIR/auto0/modules/mod2} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
+ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
+ res0 res1 res2}
+# See comments on lsort after test safe-9.20.
+test safe-19.24 {interpConfigure change the access path; check module loading, Sync Mode off; stale data case 2 (worst case)} -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set oldTm [tcl::tm::path list]
+ foreach path $oldTm {
+ tcl::tm::path remove $path
+ }
+ tcl::tm::path add [file join $TestsDir auto0 modules]
+} -body {
+ set i [safe::interpCreate -accessPath [list $tcl_library]]
+
+ # Inspect.
+ set confA [safe::interpConfigure $i]
+ set sortA [mapAndSortList $PathMapp [dict get $confA -accessPath]]
+ set modsA [interp eval $i {tcl::tm::path list}]
+ set path0 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path1 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path2 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Force the interpreter to acquire pkg data which will soon become stale.
+ catch {interp eval $i {package require NOEXIST}}
+ catch {interp eval $i {package require mod1::NOEXIST}}
+ catch {interp eval $i {package require mod2::NOEXIST}}
+
+ # Add to access path.
+ # This injects more tokens, pushing modules to higher token numbers.
+ safe::interpConfigure $i -accessPath [list $tcl_library \
+ [file join $TestsDir auto0 auto1] \
+ [file join $TestsDir auto0 auto2]]
+ # Inspect.
+ set confB [safe::interpConfigure $i]
+ set sortB [mapAndSortList $PathMapp [dict get $confB -accessPath]]
+ set modsB [interp eval $i {tcl::tm::path list}]
+ set path3 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules]]
+ set path4 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod1]]
+ set path5 [::safe::interpFindInAccessPath $i [file join $TestsDir auto0 modules mod2]]
+
+ # Try to load the packages and run a command from each one.
+ set code0 [catch {interp eval $i {package require test0}} msg0]
+ set code1 [catch {interp eval $i {package require mod1::test1}} msg1]
+ set code2 [catch {interp eval $i {package require mod2::test2}} msg2]
+ set out0 [interp eval $i {test0::try0}]
+ set out1 [interp eval $i {mod1::test1::try1}]
+ set out2 [interp eval $i {mod2::test2::try2}]
+
+ list [lsort [list $path0 $path1 $path2]] -- $modsA -- \
+ [lsort [list $path3 $path4 $path5]] -- $modsB -- \
+ $code0 $msg0 $code1 $msg1 $code2 $msg2 -- $sortA -- $sortB -- \
+ $out0 $out1 $out2
+} -cleanup {
+ tcl::tm::path remove [file join $TestsDir auto0 modules]
+ foreach path [lreverse $oldTm] {
+ tcl::tm::path add $path
+ }
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -match glob -result {{{$p(:1:)} {$p(:2:)} {$p(:3:)}} -- {{$p(:1:)}} --\
+ {{$p(:3:)} {$p(:4:)} {$p(:5:)}} -- {{$p(:3:)}} --\
+ 0 0.5 0 1.0 0 2.0 --\
+ {TCLLIB TESTSDIR/auto0/modules TESTSDIR/auto0/modules/mod1\
+ TESTSDIR/auto0/modules/mod2} --\
+ {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
+ TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
+ res0 res1 res2}
+# See comments on lsort after test safe-9.20.
+
+
+### 20. safe::interpCreate with different cases of -accessPath, -autoPath.
+
+set ::auto_path [list $tcl_library [file dirname $tcl_library] [file join $TestsDir auto0]]
+
+test safe-20.1 "create -accessPath NULL -autoPath NULL -> parent's ::auto_path" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list $::auto_path -- $::auto_path]
+test safe-20.2 "create -accessPath {} -autoPath NULL -> parent's ::auto_path" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath {}]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list $::auto_path -- $::auto_path]
+test safe-20.3 "create -accessPath path1 -autoPath NULL -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1]]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-20.4 "create -accessPath NULL -autoPath {} -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -autoPath {}]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-20.5 "create -accessPath {} -autoPath {} -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath {} -autoPath {}]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-20.6 "create -accessPath path1 -autoPath {} -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath {}]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-20.7 "create -accessPath NULL -autoPath path2 -> path2" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -autoPath [lrange $::auto_path 0 0]]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]]
+test safe-20.8 "create -accessPath {} -autoPath path2 -> path2" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath {} -autoPath [lrange $::auto_path 0 0]]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]]
+test safe-20.9 "create -accessPath path1 -autoPath path2 -> path2" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]]
+test safe-20.10 "create -accessPath NULL -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -autoPath /not/in/access/path]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {/not/in/access/path -- {}}
+test safe-20.11 "create -accessPath {} -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath {} -autoPath /not/in/access/path]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {/not/in/access/path -- {}}
+test safe-20.12 "create -accessPath path1 -autoPath pathX -> {pathX}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+} -body {
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath /not/in/access/path]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {/not/in/access/path -- {}}
+
+### 21. safe::interpConfigure with different cases of -accessPath, -autoPath.
+
+test safe-21.1 "interpConfigure -accessPath NULL -autoPath NULL -> no change" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -deleteHook {}
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]]
+test safe-21.2 "interpConfigure -accessPath {} -autoPath NULL -> parent's ::auto_path" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath {}
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list $::auto_path -- $::auto_path]
+test safe-21.3 "interpConfigure -accessPath path1 -autoPath NULL -> no change" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath [lrange $::auto_path 0 1]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 0 0] -- [lrange $::auto_path 0 0]]
+test safe-21.4 "interpConfigure -accessPath NULL -autoPath {} -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -autoPath {}
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-21.5 "interpConfigure -accessPath {} -autoPath {} -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath {} -autoPath {}
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-21.6 "interpConfigure -accessPath {path1} -autoPath {} -> {}" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath [lrange $::auto_path 1 1] -autoPath {}
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {{} -- {}}
+test safe-21.7 "interpConfigure -accessPath NULL -autoPath path2 -> path2" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -autoPath [lrange $::auto_path 1 1]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 1 1] -- [lrange $::auto_path 1 1]]
+test safe-21.8 "interpConfigure -accessPath {} -autoPath path2 -> path2" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath {} -autoPath [lrange $::auto_path 1 1]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 1 1] -- [lrange $::auto_path 1 1]]
+test safe-21.9 "interpConfigure -accessPath path1 -autoPath path2 -> path2" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath [lrange $::auto_path 0 2] -autoPath [lrange $::auto_path 1 1]
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result [list [lrange $::auto_path 1 1] -- [lrange $::auto_path 1 1]]
+test safe-21.10 "interpConfigure -accessPath NULL -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -autoPath /not/in/access/path
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {/not/in/access/path -- {}}
+test safe-21.11 "interpConfigure -accessPath {} -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath {} -autoPath /not/in/access/path
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {/not/in/access/path -- {}}
+test safe-21.12 "interpConfigure -accessPath path1 -autoPath pathX -> pathX" -constraints AutoSyncDefined -setup {
+ set SyncExists [expr {[info commands ::safe::setSyncMode] ne {}}]
+ if {$SyncExists} {
+ set SyncVal_TMP [safe::setSyncMode]
+ safe::setSyncMode 0
+ } else {
+ error {This test is meaningful only if the command ::safe::setSyncMode is defined}
+ }
+ set i [safe::interpCreate -accessPath [lrange $::auto_path 0 1] -autoPath [lrange $::auto_path 0 0]]
+} -body {
+ safe::interpConfigure $i -accessPath [lrange $::auto_path 0 2] -autoPath /not/in/access/path
+ getAutoPath $i
+} -cleanup {
+ safe::interpDelete $i
+ if {$SyncExists} {
+ safe::setSyncMode $SyncVal_TMP
+ }
+} -result {/not/in/access/path -- {}}
# cleanup
set ::auto_path $SaveAutoPath
unset SaveAutoPath TestsDir PathMapp
+rename getAutoPath {}
unset -nocomplain path
rename mapList {}
rename mapAndSortList {}
diff --git a/tests/socket.test b/tests/socket.test
index 7250cb8..7fdb09d 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1071,7 +1071,7 @@ test socket_$af-7.3 {testing socket specific options} -constraints [list socket
close $s
update
llength $l
-} -result 18
+} -result 22
test socket_$af-7.4 {testing socket specific options} -constraints [list socket supported_$af] -setup {
set timer [after 10000 "set x timed_out"]
set l ""
diff --git a/tests/while-old.test b/tests/while-old.test
index 9c8cacc..b5b69dc 100644
--- a/tests/while-old.test
+++ b/tests/while-old.test
@@ -92,7 +92,7 @@ test while-old-4.3 {errors in while loops} {
test while-old-4.4 {errors in while loops} {
set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
list $err $msg
-} {1 {can't use non-numeric string as operand of "+"}}
+} {1 {can't use non-numeric string "a" as operand of "+"}}
test while-old-4.5 {errors in while loops} {
catch {unset x}
set x 1
diff --git a/tests/while.test b/tests/while.test
index 6ea8548..2bfab2a 100644
--- a/tests/while.test
+++ b/tests/while.test
@@ -32,7 +32,7 @@ test while-1.2 {TclCompileWhileCmd: error in test expression} -body {
} -match glob -result {*"while {$i<} break"}
test while-1.3 {TclCompileWhileCmd: error in test expression} -body {
while {"a"+"b"} {error "loop aborted"}
-} -returnCodes error -result {can't use non-numeric string as operand of "+"}
+} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"}
test while-1.4 {TclCompileWhileCmd: multiline test expr} -body {
set value 1
while {($tcl_platform(platform) != "foobar1") && \
@@ -343,7 +343,7 @@ test while-4.3 {while (not compiled): error in test expression} -body {
test while-4.4 {while (not compiled): error in test expression} -body {
set z while
$z {"a"+"b"} {error "loop aborted"}
-} -returnCodes error -result {can't use non-numeric string as operand of "+"}
+} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"}
test while-4.5 {while (not compiled): multiline test expr} -body {
set value 1
set z while