1# Copyright (c) 2003, 2004, 2005 Jeffrey I Cohen. All rights reserved. 2# 3# Before `make install' is performed this script should be runnable with 4# `make test'. After `make install' it should work as `perl test.pl' 5 6######################### We start with some black magic to print on failure. 7 8# Change 1..1 below to 1..last_test_to_print . 9# (It may become useful if the test is moved to ./t subdirectory.) 10 11BEGIN { $| = 1; print "1..23\n"; } 12END {print "not ok 1\n" unless $loaded;} 13use Genezzo::GenDBI; 14$loaded = 1; 15print "ok 1\n"; 16 17######################### End of black magic. 18 19# Insert your test code below (better if it prints "ok 13" 20# (correspondingly "not ok 13") depending on the success of chunk 13 21# of the test code): 22use strict; 23use warnings; 24use File::Path; 25use File::Spec; 26 27my $TEST_COUNT; 28 29$TEST_COUNT = 2; 30 31my $dbinit = 1; 32my $gnz_home = File::Spec->catdir("t", "gnz_home"); 33my $gnz_restore = File::Spec->catdir("t", "restore"); 34#rmtree($gnz_home, 1, 1); 35#mkpath($gnz_home, 1, 0755); 36 37my $ins_count = 50; 38my $dup_count = 4; 39 40if (1) 41{ 42 use Genezzo::Util; 43 my $starttime = time(); 44 45 my %t3arg = ( 46 unique_key => 1, 47 key_type => ["n", "c"], 48 use_keycount => 1 49 ); 50 51 my $bt = Genezzo::Index::bt2->new(%t3arg); 52 53 my @foo = qw(alpha bravo charlie delta echo foxtrot golf hotel india juliet kilo lima mike november oscar papa quebec romeo sierra tango uniform victor whiskey xray yankee zulu); 54 55 # 5 * 26 rows 56 for my $frid (@foo) 57 { 58 not_ok("failed to insert 1 $frid") 59 unless ($bt->insert([1, $frid], undef)); 60 } 61 for my $frid (@foo) 62 { 63 not_ok("failed to insert 2 $frid") 64 unless ($bt->insert([2, $frid], undef)); 65 } 66 for my $frid (@foo) 67 { 68 not_ok("failed to insert 3 $frid") 69 unless ($bt->insert([3, $frid], undef)); 70 } 71 for my $frid (@foo) 72 { 73 not_ok("failed to insert 4 $frid") 74 unless ($bt->insert([4, $frid], undef)); 75 } 76 for my $frid (@foo) 77 { 78 not_ok("failed to insert 5 $frid") 79 unless ($bt->insert([5, $frid], undef)); 80 } 81 82 83 # dup test 84 if ( $bt->insert([3, "echo"], undef)) 85 { 86 not_ok("duplicate key echo"); 87 } 88 else 89 { 90 ok() 91 } 92 if ($bt->insert([3, "golf"], undef)) 93 { 94 not_ok("duplicate key golf"); 95 } 96 else 97 { 98 ok() 99 } 100 101 greet $bt->stats(); 102 103 104 my $hcount = $bt->HCount(); 105 if ($hcount == 130) 106 { 107 ok(); 108 } 109 else 110 { 111 not_ok("count mismatch - $hcount vs 130"); 112 } 113 114 greet time() - $starttime; 115 116 117# greet $bt; 118 119 { # search 120 my $sth = $bt->SQLPrepare(start_key => [1, ""], stop_key => [3, ""]); 121 122 $sth->SQLExecute() ? ok() : not_ok("could not execute"); 123 124 my @row = $sth->SQLFetch(); 125 126 my $fcnt = 0; 127 while (scalar(@row) > 1) 128 { 129# greet @row; 130 131 unless ($row[0]->[-1] eq $row[1]) 132 { 133 my ($kk, $vv) = ($row[0], $row[1]); 134 not_ok("val mismatch: key $kk, val $vv"); 135 } 136 if ($fcnt < 26) 137 { 138 unless ($row[0]->[0] == 1) 139 { 140 my ($kk, $vv) = ($row[0], $row[1]); 141 not_ok("key 1: key $kk, val $vv"); 142 } 143 } 144 else 145 { 146 unless ($row[0]->[0] == 2) 147 { 148 my ($kk, $vv) = ($row[0], $row[1]); 149 not_ok("key 2: key $kk, val $vv"); 150 } 151 } 152 153 @row = $sth->SQLFetch(); 154 $fcnt++; 155 } 156 157 if ($fcnt == 52) 158 { 159 ok(); 160 } 161 else 162 { 163 not_ok("count mismatch - $fcnt vs 52"); 164 } 165 166 167 greet time() - $starttime; 168 169 170 } 171 172} 173 174if (1) 175{ 176 use Genezzo::TestSetup; 177 178 my $fb = 179 Genezzo::TestSetup::CreateOrRestoreDB( 180 gnz_home => $gnz_home, 181 restore_dir => $gnz_restore 182 ); 183 184 unless (defined($fb)) 185 { 186 not_ok ("could not create database"); 187 exit 1; 188 } 189 ok(); 190 $dbinit = 0; 191 192} 193 194if (1) 195{ 196 use Genezzo::Util; 197 198 my $dbh = Genezzo::GenDBI->connect($gnz_home, "NOUSER", "NOPASSWORD"); 199 200 unless (defined($dbh)) 201 { 202 not_ok ("could not find database"); 203 exit 1; 204 } 205 ok(); 206 207 if ($dbh->do("startup")) 208 { 209 ok(); 210 } 211 else 212 { 213 not_ok ("could not startup"); 214 } 215 $dbinit = 0; 216 217 if ($dbh->do("startup")) 218 { 219 ok(); 220 } 221 else 222 { 223 not_ok ("could not startup"); 224 } 225 226 if ($dbh->do("af filesize=16K")) 227 { 228 ok(); 229 } 230 else 231 { 232 not_ok ("could not addfile"); 233 } 234 if ($dbh->do("af filesize=16K")) 235 { 236 ok(); 237 } 238 else 239 { 240 not_ok ("could not addfile"); 241 } 242 if ($dbh->do("af ")) 243 { 244 ok(); 245 } 246 else 247 { 248 not_ok ("could not addfile"); 249 } 250 251 252 if ($dbh->do("ct duptab id=n cname=c")) 253 { 254 ok(); 255 } 256 else 257 { 258 not_ok ("could not create table"); 259 } 260 261 { 262 for my $ii (1..$ins_count) 263 { 264 my $ins = "i duptab $ii foo_$ii"; 265 266 if ($dbh->do($ins)) 267 { 268# ok(); 269 } 270 else 271 { 272 not_ok ("could not insert: $ins"); 273 last; 274 } 275 } 276 } 277 278 if ($dbh->do("ci dup_idx duptab id")) 279 { 280 ok(); 281 } 282 else 283 { 284 not_ok ("could not create index"); 285 } 286 287 for my $jj (1..$dup_count) 288 { 289 for my $ii (1..$ins_count) 290 { 291 my $ins = "i duptab $ii foo_$ii"; 292 293 if ($dbh->do($ins)) 294 { 295# ok(); 296 } 297 else 298 { 299 not_ok ("could not insert: $ins"); 300 last; 301 } 302 } 303 } 304 ok (); 305 306 my $fetchcount; 307 my $lastfetch = $dbh->selectrow_arrayref("select count(*) from duptab"); 308 if (scalar(@{$lastfetch})) 309 { 310 $fetchcount = $lastfetch->[0]; 311 312 if ($fetchcount != (($dup_count + 1) * $ins_count)) 313 { 314 not_ok("fetch count $fetchcount mismatch"); 315 } 316 else 317 { 318 ok(); 319 } 320 } 321 else 322 { 323 not_ok ("could not fetch ary ref count(*)"); 324 } 325 326 $lastfetch = $dbh->selectrow_arrayref("select count(*) from dup_idx"); 327 if (scalar(@{$lastfetch})) 328 { 329 $fetchcount = $lastfetch->[0]; 330 331 if ($fetchcount != (($dup_count + 1) * $ins_count)) 332 { 333 not_ok("idx fetch count $fetchcount mismatch"); 334 } 335 else 336 { 337 ok(); 338 } 339 } 340 else 341 { 342 not_ok ("could not fetch idx ary ref count(*)"); 343 } 344 345 my $del_posn = int($ins_count/2); 346 347 if ($dbh->do("delete from duptab where id = $del_posn")) 348 { 349 ok(); 350 } 351 else 352 { 353 not_ok ("could not delete"); 354 } 355 356 $lastfetch = $dbh->selectrow_arrayref("select count(*) from duptab"); 357 if (scalar(@{$lastfetch})) 358 { 359 $fetchcount = $lastfetch->[0]; 360 ok(); 361 } 362 else 363 { 364 not_ok ("could not fetch ary ref count(*)"); 365 } 366 367 $lastfetch = $dbh->selectrow_arrayref("select count(*) from dup_idx"); 368 if (scalar(@{$lastfetch})) 369 { 370 # check that index still has same rowcount as table 371 if ($fetchcount != $lastfetch->[0]) 372 { 373 not_ok("idx fetch count $fetchcount mismatch"); 374 } 375 else 376 { 377 ok(); 378 } 379 } 380 else 381 { 382 not_ok ("could not fetch idx ary ref count(*)"); 383 } 384 385 $del_posn++; 386 387 my $sth = 388 $dbh->prepare("select rid, id, cname from duptab where id = $del_posn"); 389 390 print $sth->execute(), " rows \n"; 391 392 for my $ii (1..(int($dup_count/2))) 393 { 394 my $ggg = $sth->fetchrow_hashref(); 395 396 last 397 unless (defined($ggg)); 398 $lastfetch = $ggg; 399 } 400 greet $lastfetch; 401 402 my $del_rid = $lastfetch->{rid}; 403 my $del_id = $lastfetch->{id}; 404 405 my $delstr = 'delete from duptab where rid = \'' . $del_rid . '\''; 406 407 if ($dbh->do($delstr)) 408 { 409 ok(); 410 } 411 else 412 { 413 not_ok ("could not delete"); 414 } 415 416 $sth = 417 $dbh->prepare("select rid, id, \"_trid\" as trid from dup_idx where id = $del_id"); 418 419 print $sth->execute(), " rows \n"; 420 421 while (1) 422 { 423 my $ggg = $sth->fetchrow_hashref(); 424 425 last 426 unless (defined($ggg)); 427 $lastfetch = $ggg; 428 429 if ($lastfetch->{trid} eq $del_rid) 430 { 431 not_ok("index delete failed : $del_rid"); 432 } 433 } 434 435 436 437 if ($dbh->do("commit")) 438 { 439 ok(); 440 } 441 else 442 { 443 not_ok ("could not commit"); 444 } 445 446 447} 448 449 450 451sub ok 452{ 453 print "ok $TEST_COUNT\n"; 454 455 $TEST_COUNT++; 456} 457 458 459sub not_ok 460{ 461 my ( $message ) = @_; 462 463 print "not ok $TEST_COUNT # $message\n"; 464 465 $TEST_COUNT++; 466} 467 468 469sub skip 470{ 471 my ( $message ) = @_; 472 473 print "ok $TEST_COUNT # skipped: $message\n"; 474 475 $TEST_COUNT++; 476} 477 478