From 916277c1f6ca30e08bbdd22a6fbd0c22946149af Mon Sep 17 00:00:00 2001
From: drh <>
Date: Thu, 16 Feb 2023 01:21:51 +0000
Subject: [PATCH] Update test cases so that they work with TCL 8.7 and later.

FossilOrigin-Name: e9b762de0e8c505f2334d931a5b6db862733e99bc12025ebf9d8882c696959fd
---
 manifest           | 18 +++++++++---------
 manifest.uuid      |  2 +-
 test/badutf2.test  | 18 ++++++++++++------
 test/btree02.test  | 18 +++++++++++++-----
 test/journal3.test |  4 ++--
 test/wal2.test     | 12 +++++++-----
 6 files changed, 44 insertions(+), 28 deletions(-)

diff --git a/manifest b/manifest
index d66d95101f..868f09d845 100644
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C Update\sthe\sconfigure\sscript\sso\sthat\sit\scontains\sthe\scorrect\sversion\snumber.
-D 2023-02-15T13:00:26.268
+C Update\stest\scases\sso\sthat\sthey\swork\swith\sTCL\s8.7\sand\slater.
+D 2023-02-16T01:21:51.925
 F .fossil-settings/empty-dirs dbb81e8fc0401ac46a1491ab34a7f2c7c0452f2f06b54ebb845d024ca8283ef1
 F .fossil-settings/ignore-glob 35175cdfcf539b2318cb04a9901442804be81cd677d8b889fcc9149c21f239ea
 F Makefile.in a050c8670ea0d7b37b2192306cbb50d392acd9902b84e9b56f3444d006f97a6c
@@ -666,7 +666,7 @@ F test/backup5.test ee5da6d7fe5082f5b9b0bbfa31d016f52412a2e4
 F test/backup_ioerr.test 4c3c7147cee85b024ecf6e150e090c32fdbb5135
 F test/backup_malloc.test 0c9abdf74c51e7bedb66d504cd684f28d4bd4027
 F test/badutf.test d5360fc31f643d37a973ab0d8b4fb85799c3169f
-F test/badutf2.test f5bc7f2d280670ecd79b9cf4f0f1760c607fe51f
+F test/badutf2.test f310fd3b24a491b6b77bccdf14923b85d6ebcce751068c180d93a6b8ff854399
 F test/bc_common.tcl b5e42d80305be95697e6370e015af571e5333a1c
 F test/bestindex1.test 852170bddbb21daa121fabcc274640ff83d7d8705912e8b5fe7ed2c5a9a9224a
 F test/bestindex2.test 9a0ccd320b6525eec3a706aae6cdab7e1b7b5abca75027e39f39f755e76e5928
@@ -693,7 +693,7 @@ F test/boundary3.test 56ef82096b4329aca2be74fa1e2b0f762ea0eb45
 F test/boundary4.tcl 0bb4b1a94f4fc5ae59b79b9a2b7a140c405e2983
 F test/boundary4.test 89e02fa66397b8a325d5eb102b5806f961f8ec4b
 F test/btree01.test e08b3613540145b353f20c81cb18ead54ff12e0f
-F test/btree02.test a0f33669ba76632247c14718af32db939fa6de5cd13890798ad3f2a362cf7fe4
+F test/btree02.test 7555a5440453d900410160a52554fe6478af4faf53098f7235f1f443d5a1d6cc
 F test/btreefault.test c2bcb542685eea44621275cfedbd8a13f65201e3
 F test/busy.test 510dc6daaad18bcbbc085bcc6217d6dc418def5e73f72ce1475eea0cb7834727
 F test/cache.test 13bc046b26210471ca6f2889aceb1ea52dc717de
@@ -1049,7 +1049,7 @@ F test/join5.test 5a2da0c3ea852a7063d3e72fc7d5a04a6de5ef6e6d85092582f69033f7459a
 F test/join6.test cfe6503791ceb0cbb509966740286ec423cbf10b
 F test/journal1.test c7b768041b7f494471531e17abc2f4f5ebf9e5096984f43ed17c4eb80ba34497
 F test/journal2.test 9dac6b4ba0ca79c3b21446bbae993a462c2397c4
-F test/journal3.test c9c29883f5bf535ae82ae21c472df6263806a22e467b6db7cd0d6d545305b4f6
+F test/journal3.test 0d27fead867a78ef008dd8a4d7a6bdabcba998675fbde962dc2a98bfe4d97d6b
 F test/jrnlmode.test a6693f2bed4541a21e703aaa37bb3e10de154130645952933b82b2dec0a8b539
 F test/jrnlmode2.test 8759a1d4657c064637f8b079592651530db738419e1d649c6df7048cd724363d
 F test/jrnlmode3.test 556b447a05be0e0963f4311e95ab1632b11c9eaa
@@ -1591,7 +1591,7 @@ F test/vtab_alter.test 736e66fb5ec7b4fee58229aa3ada2f27ec58bc58c00edae4836890c37
 F test/vtab_err.test dcc8b7b9cb67522b3fe7a272c73856829dae4ab7fdb30399aea1b6981bda2b65
 F test/vtab_shared.test 5253bff2355a9a3f014c15337da7e177ab0ef8ad
 F test/wal.test 613efec03e517e1775d86b993a54877d2e29a477
-F test/wal2.test 155b9efa999bdb38ce1cd729b9a4fcdbffd6b88be27f039bad1d2929d287d918
+F test/wal2.test dd08803893bfaf208af195bfed986ae7870fdd497fb5aeda36792f917037cccc
 F test/wal3.test 2a93004bc0fb2b5c29888964024695bade278ab2
 F test/wal4.test 4744e155cd6299c6bd99d3eab1c82f77db9cdb3c
 F test/wal5.test 9c11da7aeccd83a46d79a556ad11a18d3cb15aa9
@@ -1779,8 +1779,8 @@ F vsixtest/vsixtest.tcl 6a9a6ab600c25a91a7acc6293828957a386a8a93
 F vsixtest/vsixtest.vcxproj.data 2ed517e100c66dc455b492e1a33350c1b20fbcdc
 F vsixtest/vsixtest.vcxproj.filters 37e51ffedcdb064aad6ff33b6148725226cd608e
 F vsixtest/vsixtest_TemporaryKey.pfx e5b1b036facdb453873e7084e1cae9102ccc67a0
-P 8790368b4a96606f6c925db217a8e8badb800ed0da51d1c97aa38982cbbabd71
-R 1a49ea5781bd1f86f0aba3d1f03776ff
+P a7cbf30808e2c0c25aecd30c921b45a9888aff1a53f32350c5fc0196fb55b238
+R 8c04d000120f3201c20cbb96dbedc183
 U drh
-Z 14006ca215451c205d3f92c65651d67f
+Z e19c4a4e958d5af50a94c7b8637d662f
 # Remove this line to create a well-formed Fossil manifest.
diff --git a/manifest.uuid b/manifest.uuid
index e4f6b9acb7..1731d4bf84 100644
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-a7cbf30808e2c0c25aecd30c921b45a9888aff1a53f32350c5fc0196fb55b238
\ No newline at end of file
+e9b762de0e8c505f2334d931a5b6db862733e99bc12025ebf9d8882c696959fd
\ No newline at end of file
diff --git a/test/badutf2.test b/test/badutf2.test
index 36b40fb95c..64a730d6fa 100644
--- a/test/badutf2.test
+++ b/test/badutf2.test
@@ -98,12 +98,18 @@ foreach { i len uval xstr ustr u2u } {
     } $uval
   }
 
-  do_test badutf2-4.1.$i {
-    sqlite3_reset $S
-    sqlite3_bind_text $S 1 $xstr $len
-    sqlite3_step $S
-    utf8_to_ustr2 [ sqlite3_column_text $S 0 ]
-  } $ustr
+  # Tcl 8.7 and later do automatic bad-utf8 correction for
+  # characters 0x80 thru 0x9f so test case 5 does not work here.
+  if {$i==5 && $tcl_version>=8.7} {
+     # no-op
+  } else {
+    do_test badutf2-4.1.$i {
+      sqlite3_reset $S
+      sqlite3_bind_text $S 1 $xstr $len
+      sqlite3_step $S
+      utf8_to_ustr2 [ sqlite3_column_text $S 0 ]
+    } $ustr
+  }
 
   ifcapable debug {
     do_test badutf2-5.1.$i {
diff --git a/test/btree02.test b/test/btree02.test
index da35c7fa48..c1fede5801 100644
--- a/test/btree02.test
+++ b/test/btree02.test
@@ -21,7 +21,7 @@ load_static_extension db eval
 do_execsql_test btree02-100 {
   CREATE TABLE t1(a TEXT, ax INTEGER, b INT, PRIMARY KEY(a,ax)) WITHOUT ROWID;
   WITH RECURSIVE c(i) AS (VALUES(1) UNION ALL SELECT i+1 FROM c WHERE i<10)
-    INSERT INTO t1(a,ax,b) SELECT printf('%02x',i), random(), i FROM c;
+    INSERT INTO t1(a,ax,b) SELECT printf('%02x',i+160), random(), i FROM c;
   CREATE INDEX t1a ON t1(a);
   CREATE TABLE t2(x,y);
   CREATE TABLE t3(cnt);
@@ -29,26 +29,34 @@ do_execsql_test btree02-100 {
     INSERT INTO t3(cnt) SELECT i FROM c;
   SELECT count(*) FROM t1;
 } {10}
+
+proc showt1 {} {
+  puts -nonewline "t1: "
+  puts [db eval {SELECT printf('(%s,%s)',quote(a),quote(b)) FROM t1}]
+}
+
 do_test btree02-110 {
   db eval BEGIN
   set i 0
+  # showt1
   db eval {SELECT a, ax, b, cnt FROM t1 CROSS JOIN t3 WHERE b IS NOT NULL} {
-    if {$a==""} {set a 0}
-    if {$b==""} {set b 0}    
+    if {$a==""} continue
     db eval {INSERT INTO t2(x,y) VALUES($b,$cnt)}
     # puts "a,b,cnt = ($a,$b,$cnt)"
     incr i
     if {$i%2==1} {
       set bx [expr {$b+1000}]
-      # puts "INSERT ($a),$bx"
+      #  puts "INSERT ($a),$bx"
       db eval {INSERT INTO t1(a,ax,b) VALUES(printf('(%s)',$a),random(),$bx)}
+      # showt1
     } else {
       # puts "DELETE a=$a"
       db eval {DELETE FROM t1 WHERE a=$a}
+      # showt1
     }
     db eval {COMMIT; BEGIN}
   }  
   db one {COMMIT; SELECT count(*) FROM t1;}
-} {27}
+} {10}
 
 finish_test
diff --git a/test/journal3.test b/test/journal3.test
index b907352329..73ce43322f 100644
--- a/test/journal3.test
+++ b/test/journal3.test
@@ -42,7 +42,7 @@ if {$::tcl_platform(platform) == "unix"
     do_test journal3-1.2.$tn.1 {
       catch { forcedelete test.db-journal }
       file attributes test.db -permissions $permissions
-      file attributes test.db -permissions
+      string map { o 0} [file attributes test.db -permissions]
     } $permissions
     do_test journal3-1.2.$tn.2 { file exists test.db-journal } {0}
     do_test journal3-1.2.$tn.3 {
@@ -54,7 +54,7 @@ if {$::tcl_platform(platform) == "unix"
       file exists test.db-journal
     } {1}
     do_test journal3-1.2.$tn.4 {
-      file attr test.db-journal -perm
+      string map {o 0} [file attr test.db-journal -perm]
     } $effective
     do_execsql_test journal3-1.2.$tn.5 { ROLLBACK } {}
   }
diff --git a/test/wal2.test b/test/wal2.test
index b26f5ca877..769e74b7ea 100644
--- a/test/wal2.test
+++ b/test/wal2.test
@@ -1085,7 +1085,7 @@ if {$::tcl_platform(platform) == "unix"} {
     set effective [format %.5o [expr $permissions & ~$umask]]
     do_test wal2-12.2.$tn.1 {
       file attributes test.db -permissions $permissions
-      file attributes test.db -permissions
+      string map {o 0} [file attributes test.db -permissions]
     } $permissions
     do_test wal2-12.2.$tn.2 {
       list [file exists test.db-wal] [file exists test.db-shm]
@@ -1096,7 +1096,9 @@ if {$::tcl_platform(platform) == "unix"} {
       list [file exists test.db-wal] [file exists test.db-shm]
     } {1 1}
     do_test wal2-12.2.$tn.4 {
-      list [file attr test.db-wal -perm] [file attr test.db-shm -perm]
+      list \
+       [string map {o 0} [file attr test.db-wal -perm]] \
+       [string map {o 0} [file attr test.db-shm -perm]]
     } [list $effective $effective]
     do_test wal2-12.2.$tn.5 {
       db close
@@ -1151,9 +1153,9 @@ if {$::tcl_platform(platform) == "unix"} {
       file attr test.db-wal -perm $wal_perm
       file attr test.db-shm -perm $shm_perm
 
-      set     L [file attr test.db -perm]
-      lappend L [file attr test.db-wal -perm]
-      lappend L [file attr test.db-shm -perm]
+      set     L [string map {o 0} [file attr test.db -perm]]
+      lappend L [string map {o 0} [file attr test.db-wal -perm]]
+      lappend L [string map {o 0} [file attr test.db-shm -perm]]
     } [list $db_perm $wal_perm $shm_perm]
 
     # If $can_open is true, then it should be possible to open a database
-- 
2.47.2