view release on metacpan or  search on metacpan

test.pl  view on Meta::CPAN

    test_smallint_unchecked 
    test_smallint_checked 
    test_integer_unchecked 
    test_integer_checked 
    test_bigint 
    test_tinyint_scaled 
    test_smallint_scaled 
    test_integer_scaled 
    test_double 
    test_float 
    test_date_1 
    test_date_2 
    test_interval_1 
    test_interval_2
    test_create_all_types 
    test_NAME 
    test_NAME_lc 
    test_NAME_uc 
    test_PRECISION 
    test_SCALE 
    test_TYPE 
    test_NULLABLE 
    test_CursorName 
    test_NUM_OF_FIELDS 
    test_NUM_OF_PARAMS
    test_hold_and_current_of
    test_bind
    test_bind_by_name
    test_get_info
 );


print "1..", scalar(@tests), "\n";
foreach my $test ( @tests ) {
    print "---- Start $test ----\n" if $debug;

    my $errors;
    DBI->trace(4) if $debug =~ /$test/i;
    eval {
	no strict 'refs';
	&{$test}();
    };
    DBI->trace(0);

    if ( !$@ ) {
	print "ok $cur_test\n";
    } else {
	print "not ok $cur_test\n";
	print "$@\n" if $debug;
    }
    $cur_test++;
}

########################## TEST ROUTINES ################################


#
#  load driver
#
sub test_load_dbd {
    my $ok = require DBD::RDB;
    check( $ok, 'require of DBD::RDB' );
}

#
# try to connect to a non existing database, expect error
#
sub test_connect_error {
    my $dbh = DBI->connect( 'dbi:RDB: ATTACH FILENAME XXXX.RDB', 
		            "", "", $std_attribs );
    my $ok = ($DBI::errstr =~ /RDB\-E\-BAD_DB_FORMAT/);
    check( $ok, 'connect to non existing DB', $DBI::errstr );
}

#
#  create test database
#  Additionally test return value of $dbh->do for non-select
#
sub test_create_db {
    $dbh = DBI->connect( 'dbi:RDB:', undef, undef, $std_attribs );
    check ( $dbh, 'connect', $DBI::errstr );
    my $ok = $dbh->do('CREATE DATABASE FILENAME TEST.RDB'); 
    check ( $ok == "0E0", 'CREATE DATABASE', $DBI::errstr );
    check ( $dbh->disconnect, 'disconnect', $DBI::errstr );
}    
#
#  connect to test database again and keep dbh
#
sub test_connect {
    $dbh = DBI->connect( 'dbi:RDB: ATTACH FILENAME TEST.RDB',
	                 "", "", $std_attribs );
    check( $dbh, 'connect', $DBI::errstr );
}

#
# set trans read write => to test 'do' and 'do' error handling
#
sub test_do_set_trans_rw {
    my $ok;

    $ok = $dbh->do('SET TRANSACTION READ WRITE');
    check( $ok == "0E0", 'do of SET TRANS READ WRITE', $DBI::errstr );

    $ok = $dbh->commit;
    check( $ok, 'COMMIT', $DBI::errstr );

    $ok = $dbh->rollback;
    check( !$ok, 'ROLLBACK', 'unexpected success' );

    check( ($DBI::errstr eq
            "%SQL-F-NOIMPTXN, no implicit transaction to commit or rollback"),
            'test DBI::errstr for double rollback (NOIMPTXN)', $DBI::errstr );
}

#
#  INSERT/FETCH of CHAR without option "chop"
#
sub test_char_unchopped {
    my $vals = [
	{ in => 'abcde' },
	{ in => 'abc ', out => 'abc  ' },