20all.t

一个俄国人实现的数据库系统

#!/usr/local/bin/perl
# $Id: 20all.t,v 1.3 2001/11/21 20:09:28 pavlo Exp $
# 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..15\n"; }
END {print "not ok 1\n" unless $loaded;}
 {
  require DBD::Gigabase;
 }
$loaded = 1;
print "ok 1\n";
use strict;

sub t{
 my $num=shift;
 print (($@) ? "not ok $num\n" : "ok $num\n" );
}

# starting server;
=off
my $scriptname;
chdir 't';
if ( -e 'clitest.dbs') {
 $scriptname='runserv.sql';
}
else {
 $scriptname='creatdb.sql';
}
my $subsql_started=open SUBSQL,"subsql $scriptname |";
my $srv_started;
while (<SUBSQL>) {
 if (/^Server started/) { $srv_started=1;last; }
 if (/^>>/) { last; }
}
scalar <SUBSQL>;
if ($srv_started) { print "ok 2\n";}
else { print "not ok 2\n";}
=cut 
print "ok 2\n";# dump
#
use DBI;
#close SUBSQL;
# connect
my $dbh;
eval {
 $dbh = DBI->connect(
   "dbi:Gigabase:host=localhost;port=6100","guest", "guest",{RaiseError=>1,AutoCommit=>0});
};
# do,insert with values
t(3);

eval{
 $dbh->do("insert into person values ('Joe Cooker',50000,\
 'Outlook drive, 15/3',1.76)");
};
t(4);

# insert into named fields
eval{
 my $sth=$dbh->prepare(q{
  insert into person (name,salary,address,rating) values (?,?,?,?)
 });
 $sth->execute("John Smith",80000,
               "1 Guildhall St., Cambridge CB2 3NH, UK",3.84);
 die "can't get oid" unless $sth->{gbase_oid};
};
t(5);

# Mixed values & parameters
eval{
 my $sth=$dbh->prepare(q{
  insert into person values ('Hugo Grant',65000,?,?)
 });
 $sth->execute('London, Baker street,12',2.14);
};
t(6);

# precommit
eval{
 $dbh->func('precommit');
};
t(7);
#
{
 my $sth;
 eval{
  $sth=$dbh->prepare("select * from person where salary > ? order by salary");
  my $rows=$sth->execute(65000);
  die "fetch 8:number of rows not match " unless $rows == 1;
  my ($name,$salary,$address,$rating)=$sth->fetchrow_array;
  die "fetch 8:name not match" unless $name eq 'John Smith';
 };
 t(8);

# bind_param
 eval {
  my $salary=50000;
  $sth->bind_param(1,\$salary);
  my $rows=$sth->execute;
  die "fetch 9: number of rows not match " unless $rows == 2;
  $sth->finish; 
 };
 t(9)
};

# update by key values
eval{
 my $sth=$dbh->prepare("select name,salary from person where rating > ? and salary between ? and ?");
 my $upd=$dbh->prepare("update person set salary=? where name=?");
 my $rows=$sth->execute(2.0,50000,100000);
 die "fetch 10.1: number of rows not match " unless $rows == 2;
 while (my ($name,$salary)=$sth->fetchrow_array) {
  $salary*=1.1;
  $rows=$upd->execute($salary,$name);
  die "fetch 10.2 with '$name' : number of rows not match " unless $rows == 1;
 }
};
t(10);

# commit
eval{
 $dbh->commit;
};
t(11);
#
# like
eval {
 my $sth=$dbh->prepare("select from person where address like ?");
 my $rows=$sth->execute('%');
 die "fetch 11: number of rows not match " unless $rows == 3;
};
t(12);
# select by reference
eval {
 my $by_name=$dbh->prepare('select from person where name = ?');
 my $by_oid=$dbh->prepare('select from person where current = ?');
 my $rows=$by_name->execute('John Smith');
 my ($name1,$salary1,$address1,$rating1)=$by_name->fetchrow_array;
 my $oid=$by_name->{gbase_oid};
 $by_oid->execute($oid);
 my ($name2,$salary2,$address2,$rating2)=$by_oid->fetchrow_array;
 die "not match" unless $name1 eq $name2;
 die "not match" unless $salary1 == $salary2;
 die "not match" unless $address1 eq $address2;
 die "not match" unless $rating1 == $rating2;
};
t(13);

# delete 
eval {
 my $del=$dbh->prepare("delete from person");
 my $rows=$del->execute;
 die "delete 12: number of rows not match " unless $rows == 3;
};
t(14);

# disconnect
eval{
 $dbh->disconnect;
};
t(15);

######################### 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):