# Copyright (c) 2003, 2004 Jeffrey I Cohen. All rights reserved. # # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..57\n"; } END {print "not ok 1\n" unless $loaded;} use Genezzo::Block::Std; use Genezzo::Block::RowDir; use Genezzo::Block::RDBlock; use Genezzo::Util; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): use strict; use warnings; my $TEST_COUNT; $TEST_COUNT = 2; { tt1(150); # tt1(200); # tt1(1000); # tt2(150); # tt2(200); # tt2(1000); } sub tt1 { my $bsize = shift; local $Genezzo::Block::Std::DEFBLOCKSIZE = $bsize; my @buffarr; my $cnt = 50; my @hasharr; # build an array of hashes to tie, plus some byte buffers for my $i (1..$cnt) { push @hasharr, {}; push @buffarr, "\0" x (1+$bsize); } my @tiearr; # tie all the hashes for my $i (0..$cnt-1) { my $tie_thing = tie %{$hasharr[$i]}, "Genezzo::Block::RDBlock", (refbufstr => \$buffarr[$i], blocknum => $i) or not_ok( "Couldn't create new RDBlock" ); ok(); push @tiearr, $tie_thing; } # greet @tiearr; my $stat = $tiearr[0]->_update_meta_zero("alpha", "bravo") or not_ok( "Couldn't update metadata" ); ok(); $stat = $tiearr[0]->_update_meta_zero("charlie", "delta") or not_ok( "Couldn't update metadata" ); ok(); if ($tiearr[0]->_fetchmeta("alpha") =~ m/bravo/) { ok(); } else { not_ok( "Couldn't find metadata" ); } if ($tiearr[0]->_fetchmeta("charlie") =~ m/delta/) { ok(); } else { not_ok( "Couldn't find metadata" ); } my @plist = qw(romeo sierra tango); greet @plist; $stat = $tiearr[0]->_set_meta_row("I", \@plist) or not_ok( "Couldn't set metarow" ); ok(); greet $tiearr[0]->_fetchmeta("I"); my $glist = $tiearr[0]->_get_meta_row("I"); greet $glist; if (scalar(@{$glist}) != scalar(@plist)) { not_ok("row size mismatch"); not_ok("col mismatch"); } else { for my $i (0..(scalar(@plist) - 1)) { unless ($glist->[$i] eq $plist[$i]) { not_ok("col mismatch"); } } ok(); } # for my $i (@tiearr) # { # greet $i->_fetchmeta('#'); # } } # end tt1 sub ok { print "ok $TEST_COUNT\n"; $TEST_COUNT++; } sub not_ok { my ( $message ) = @_; print "not ok $TEST_COUNT # $message\n"; $TEST_COUNT++; } sub skip { my ( $message ) = @_; print "ok $TEST_COUNT # skipped: $message\n"; $TEST_COUNT++; }