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