1#!/usr/bin/env tclsh 2# %renumber<^\s*test >% 3 4source [file join [file dir [info script]] initests.tcl] 5 6test 0 {} { 7 catch { package require ? } 8 lindex [package versions Mk4tcl] end 9} $version 10 11test 1 {} { 12 package require Mk4tcl 13} $version 14 15test 2 {no databases} { 16 set v [mk::file open] 17 # ignore one entry if run from a VFS-based TclKit 18 if {[lindex $v 0] == "exe"} { 19 set v [lrange $v 2 end] 20 } 21} {} 22 23test 3 {temp database} -body { 24 # 2003-10-01: this was wrong when run from tclkit, which has "exe" open 25 #C [mk::file open] {db {}} 26 match "*db {}*" [mk::file open]] 27} -setup {mk::file open db} -cleanup {mk::file close db} 28 29test 4 {temp data} -body { 30 mk::view layout db.a {s i:I} 31 set n [mk::row append db.a s one i 1] 32 equal $n db.a!0 33 equal [mk::get $n] {s one i 1} 34 set n [mk::row append db.a s two i 2] 35 equal $n db.a!1 36 equal [mk::get $n] {s two i 2} 37 equal [mk::view size db.a] 2 38 mk::view size db.a 1 39 equal [mk::get db.a!0] {s one i 1} 40 catch {mk::get db.a!1} e 41 equal $e {view index is out of range} 42} -setup {mk::file open db} -cleanup {mk::file close db} 43 44test 5 {use same tag twice} -body { 45 catch {mk::file open db} e 46 equal $e {file already open} 47} -setup {mk::file open db} -cleanup {mk::file close db} 48 49set f f6.tmp 50test 6 {open file} -body { 51 file delete $f 52 set f $f 53 mk::file open db $f 54 # 2003-10-01: this was wrong when run from tclkit, which has "exe" open 55 #C [mk::file open] [list db $f] 56 match "*[list db $f]*" [mk::file open] 57 assert [file exists $f] 58 mk::file commit db 59 # the file size remains zero, because commit detects no change 60 equal [file size $f] 0 61 mk::view layout db.a s 62 mk::file commit db 63 equal [file size $f] 37 64} -cleanup {mk::file close db} 65file delete $f 66 67set f f7.tmp 68test 7 {open same file again} -body { 69 file delete $f 70 equal [mk::file open db2 $f] db2 71 mk::file close db2 72 return 73} -setup {mk::file open db1 $f} -cleanup {mk::file close db1} 74file delete $f 75 76test 8 {simple select} -body { 77 mk::view layout db.a s 78 foreach x {one One two Two three Three four Four} { 79 mk::row append db.a s $x 80 } 81 equal [mk::select db.a] {0 1 2 3 4 5 6 7} 82 equal [mk::select db.a s three] {4 5} 83 equal [mk::select db.a -exact s three] 4 84 equal [mk::select db.a -min s three] {2 3 4 5} 85 equal [mk::select db.a -max s three] {0 1 4 5 6 7} 86 equal [mk::select db.a -glob s t*] {2 4} 87 equal [mk::select db.a -glob s {[tT]*}] {2 3 4 5} 88 equal [mk::select db.a -regexp s o] {0 2 3 6 7} 89 equal [mk::select db.a -regexp s {[tT]+}] {2 3 4 5} 90 equal [mk::select db.a -keyword s t] {2 3 4 5} 91 equal [mk::select db.a -keyword s tw] {2 3} 92 equal [mk::select db.a -keyword s o] {0 1} 93} -setup {mk::file open db} -cleanup {mk::file close db} 94 95test 9 {simple sort} -body { 96 mk::view layout db.a s 97 foreach x {one One two Two three Three four Four} { 98 mk::row append db.a s $x 99 } 100 equal [mk::select db.a -sort s] {6 7 0 1 4 5 2 3} 101 equal [mk::select db.a -rsort s] {2 3 4 5 0 1 6 7} 102} -setup {mk::file open db} -cleanup {mk::file close db} 103 104test 10 {get size} -body { 105 mk::view layout db.v {a:I b:I} 106 mk::row append db.v 107 equal [mk::get db.v!0] {a 0 b 0} 108 equal [mk::get db.v!0 -size] {a 0 b 0} 109 equal [mk::get db.v!0 -size a] 0 110 equal [mk::get db.v!0 -size a b] {0 0} 111 foreach {v c} {1 -1 3 -2 15 -4 127 1 -128 1 32767 2 -32768 2 32768 4} { 112 mk::set db.v!0 a $v 113 equal [mk::get db.v!0 -size a] $c 114 } 115 equal [mk::get db.v!0 -size b a] {0 4} 116} -setup {mk::file open db} -cleanup {mk::file close db} 117 118test 11 {case-insensitive select} -body { 119 mk::view layout db.a s 120 foreach x {one One two Two three Three four Four} { 121 mk::row append db.a s $x 122 } 123 equal [mk::select db.a -glob s t*] {2 4} 124 equal [mk::select db.a -globnc s t*] {2 3 4 5} 125 equal [mk::select db.a -regexp s t] {2 4} 126 equal [mk::select db.a -regexp s (?i)t] {2 3 4 5} 127} -setup {mk::file open db} -cleanup {mk::file close db} 128 129test 12 {channel interface} -body { 130 mk::view layout db.a {m:B} 131 mk::view size db.a 1 132 133 set a 1234567890 134 set b $a$a$a$a$a$a$a$a$a$a 135 set c $b$b$b$b$b$b$b$b$b$b 136 set d $c$c$c$c$c$c$c$c$c$c 137 equal [string length $d] 10000 138 139 set fd [mk::channel db.a!0 m w] 140 puts $fd $a 141 puts $fd $b 142 puts $fd $c 143 puts $fd $d 144 close $fd 145 146 switch $::tcl_platform(platform) { 147 windows { set eolsize 2 } 148 default { set eolsize 1 } 149 } 150 151 equal [string length [mk::get db.a!0 m]] [expr {11110 + 4 * $eolsize}] 152 153 set fd [mk::channel db.a!0 m] 154 equal [gets $fd] $a 155 equal [gets $fd] $b 156 equal [gets $fd] $c 157 equal [gets $fd] $d 158 equal [gets $fd x] -1 159 close $fd 160} -setup {mk::file open db} -cleanup {mk::file close db} 161 162test 13 {recursive subviews} -body { 163 mk::view layout db.v {tag {nest ^}} 164 165 mk::row append db.v tag a 166 mk::row append db.v!0.nest tag b 167 mk::row append db.v!0.nest!0.nest tag c 168 169 equal [mk::get db.v!0 tag] a 170 equal [mk::get db.v!0.nest!0 tag] b 171 equal [mk::get db.v!0.nest!0.nest!0 tag] c 172} -setup {mk::file open db} -cleanup {mk::file close db} 173 174::tcltest::cleanupTests 175