gitlab.com/CoiaPrant/sqlite3@v1.19.1/testdata/tcl/badutf2.test (about) 1 # 2011 March 15 2 # 3 # The author disclaims copyright to this source code. In place of 4 # a legal notice, here is a blessing: 5 # 6 # May you do good and not evil. 7 # May you find forgiveness for yourself and forgive others. 8 # May you share freely, never taking more than you give. 9 # 10 #*********************************************************************** 11 # This file implements regression tests for SQLite library. 12 # 13 # This file checks to make sure SQLite is able to gracEFully 14 # handle malformed UTF-8. 15 # 16 17 set testdir [file dirname $argv0] 18 source $testdir/tester.tcl 19 20 proc utf8_to_ustr2 {s} { 21 set r "" 22 foreach i [split $s ""] { 23 scan $i %c c 24 append r [format \\u%04.4X $c] 25 } 26 set r 27 } 28 29 proc utf8_to_hstr {in} { 30 regsub -all -- {(..)} $in {%[format "%s" \1]} out 31 subst $out 32 } 33 34 proc utf8_to_xstr {in} { 35 regsub -all -- {(..)} $in {\\\\x[format "%s" \1]} out 36 subst $out 37 } 38 39 proc utf8_to_ustr {in} { 40 regsub -all -- {(..)} $in {\\\\u[format "%04.4X" 0x\1]} out 41 subst $out 42 } 43 44 do_test badutf2-1.0 { 45 db close 46 forcedelete test.db 47 sqlite3 db test.db 48 db eval "PRAGMA encoding = 'UTF-8'" 49 } {} 50 51 do_test badutf2-4.0 { 52 set S [sqlite3_prepare_v2 db "SELECT ?" -1 dummy] 53 sqlite3_expired $S 54 } {0} 55 56 foreach { i len uval xstr ustr u2u } { 57 1 1 00 \x00 {} {} 58 2 1 01 \x01 "\\u0001" 01 59 3 1 3F \x3F "\\u003F" 3F 60 4 1 7F \x7F "\\u007F" 7F 61 5 1 80 \x80 "\\u0080" C280 62 6 1 C3BF \xFF "\\u00FF" C3BF 63 7 3 EFBFBD \xEF\xBF\xBD "\\uFFFD" {} 64 } { 65 66 set hstr [ utf8_to_hstr $uval ] 67 68 ifcapable bloblit { 69 if {$hstr != "%00"} { 70 do_test badutf2-2.1.$i { 71 set sql "SELECT '$hstr'=CAST(x'$uval' AS text) AS x;" 72 set res [ sqlite3_exec db $sql ] 73 lindex [ lindex $res 1] 1 74 } {1} 75 do_test badutf2-2.2.$i { 76 set sql "SELECT CAST('$hstr' AS blob)=x'$uval' AS x;" 77 set res [ sqlite3_exec db $sql ] 78 lindex [ lindex $res 1] 1 79 } {1} 80 } 81 do_test badutf2-2.3.$i { 82 set sql "SELECT hex(CAST(x'$uval' AS text)) AS x;" 83 set res [ sqlite3_exec db $sql ] 84 lindex [ lindex $res 1] 1 85 } $uval 86 do_test badutf2-2.4.$i { 87 set sql "SELECT hex(CAST(x'$uval' AS text)) AS x;" 88 set res [ sqlite3_exec db $sql ] 89 lindex [ lindex $res 1] 1 90 } $uval 91 } 92 93 if {$hstr != "%00"} { 94 do_test badutf2-3.1.$i { 95 set sql "SELECT hex('$hstr') AS x;" 96 set res [ sqlite3_exec db $sql ] 97 lindex [ lindex $res 1] 1 98 } $uval 99 } 100 101 # Tcl 8.7 and later do automatic bad-utf8 correction for 102 # characters 0x80 thru 0x9f so test case 5 does not work here. 103 if {$i==5 && $tcl_version>=8.7} { 104 # no-op 105 } else { 106 do_test badutf2-4.1.$i { 107 sqlite3_reset $S 108 sqlite3_bind_text $S 1 $xstr $len 109 sqlite3_step $S 110 utf8_to_ustr2 [ sqlite3_column_text $S 0 ] 111 } $ustr 112 } 113 114 ifcapable debug { 115 do_test badutf2-5.1.$i { 116 utf8_to_utf8 $uval 117 } $u2u 118 } 119 120 } 121 122 do_test badutf2-4.2 { 123 sqlite3_finalize $S 124 } {SQLITE_OK} 125 126 127 finish_test