#!/usr/bin/perl -w use strict; BEGIN { $| = 1; print "1..12\n"; } END { print "not ok 1\n" unless $::XBaseloaded; } $| = 1; print "Load the module: use XBase\n"; use XBase; $::XBaseloaded = 1; print "ok 1\n"; my $dir = ( -d "t" ? "t" : "." ); $XBase::Base::DEBUG = 1; # We want to see any problems print "Open table $dir/ndx-char\n"; my $table = new XBase "$dir/ndx-char" or do { print XBase->errstr, "not ok 2\n"; exit }; print "ok 2\n"; print "prepare_select_with_index\n"; my $cur = $table->prepare_select_with_index("$dir/ndx-char.ndx") or print $table->errstr, 'not '; print "ok 3\n"; my $result = ''; print "Fetch all data\n"; while (my @data = $cur->fetch) { $result .= "@data\n"; } my $expected_result = ''; my $line; while (defined($line = )) { last if $line eq "__END_DATA__\n"; $expected_result .= $line; } if ($result ne $expected_result) { print "Expected:\n${expected_result}Got:\n${result}not "; } print "ok 4\n"; print "find_eq('6g') and fetch\n"; $cur->find_eq('6g'); $result = ''; $expected_result = ''; while (my @data = $cur->fetch()) { $result .= "@data\n"; } while (defined($line = )) { last if $line eq "__END_DATA__\n"; $expected_result .= $line; } if ($result ne $expected_result) { print "Expected:\n${expected_result}Got:\n${result}not "; } print "ok 5\n"; print "find_eq('6e') and fetch (it doesn't exist, so the result should be the same)\n"; $cur->find_eq('6e'); $result = ''; while (my @data = $cur->fetch()) { $result .= "@data\n"; } if ($result ne $expected_result) { print "Expected:\n${expected_result}Got:\n${result}not "; } print "ok 6\n"; print "Before we look at the numeric and data index files, let's check if it makes sense (because of the way we implement double floats ;-)\n"; my $doubleoneseven = pack 'd', 1.7; my $okoneseven = '3ffb333333333333'; if (join('', unpack 'H16', $doubleoneseven) ne $okoneseven and join('', unpack 'H16', reverse($doubleoneseven)) ne $okoneseven) { print "Number 1.7 encoded as natural double on your machine gives ", join('', unpack 'H16', $doubleoneseven), ",\nwhich is not what I would expect.\n"; print STDERR <errstr, 'not '; print "ok 7\n"; $cur = $table->prepare_select_with_index("$dir/ndx-num.ndx") or print $table->errstr, 'not '; print "ok 8\n"; print "find_eq(1042) and fetch results\n"; $cur->find_eq(1042); $result = ''; $expected_result = ''; while (my @data = $cur->fetch()) { last if $data[0] != 1042; $result .= "@data\n"; } while (defined($line = )) { last if $line eq "__END_DATA__\n"; $expected_result .= $line; } if ($result ne $expected_result) { print "Expected:\n${expected_result}Got:\n${result}not "; } print "ok 9\n"; print "Open ndx-date and index\n"; $table = new XBase "$dir/ndx-date.dbf" or print XBase->errstr, 'not '; print "ok 10\n"; $cur = $table->prepare_select_with_index("$dir/ndx-date.ndx") or print $table->errstr, 'not '; print "ok 11\n"; print "find_eq(2450795), which is Julian date for 1997/12/12 and fetch results\n"; ### use Data::Dumper; ### print Dumper $cur; $cur->find_eq(2450795); ### print Dumper $cur; $result = ''; $expected_result = ''; while (my @data = $cur->fetch()) { $result .= "@data\n"; } while (defined($line = )) { last if $line eq "__END_DATA__\n"; $expected_result .= $line; } if ($result ne $expected_result) { print "Expected:\n${expected_result}Got:\n${result}not "; } print "ok 12\n"; __END__ 1 1 10 10 15 1z 2 2 2h 2z 3 3 3a 4 4 4e 5 5 5b 6 6 6g 7 7 8 8 8d 9 __END_DATA__ 6g 7 7 8 8 8d 9 __END_DATA__ 1042 1042 1042 1042 1042 1042 __END_DATA__ 19971212 19971212 19971212 19971213 19971213 19971213 19971214 19971214 19971214 19971215 19971215 19971215 19971216 19971216 19971216 __END_DATA__