diff options
Diffstat (limited to 't/27_metadata.t')
-rw-r--r-- | t/27_metadata.t | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/t/27_metadata.t b/t/27_metadata.t new file mode 100644 index 0000000..57d9a32 --- /dev/null +++ b/t/27_metadata.t @@ -0,0 +1,59 @@ +#!/usr/bin/perl + +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 21; +use t::lib::Test; + +# 1-4. Connect & create tables +my $dbh = connect_ok(dbfile => 'foo'); +ok $dbh->do('CREATE TABLE meta1 (f1 INTEGER PRIMARY KEY, f2 CHAR(1))'), 'Create table meta1'; +ok $dbh->do('CREATE TABLE meta2 (f1 VARCHAR(2), f2 CHAR(1), PRIMARY KEY (f1))'), 'Create table meta2'; +ok $dbh->do('CREATE TABLE meta3 (f2 CHAR(1), f1 VARCHAR(2) PRIMARY KEY)'), 'Create table meta3'; + +$dbh->trace(0); +$DBI::neat_maxlen = 4000; + +# 5-10. Get & check primary_key_info +for my $table (qw(meta1 meta2 meta3)) { + ok my $sth = $dbh->primary_key_info(undef, undef, $table), "Get primary_key_info for $table"; + my $pki = $sth->fetchall_arrayref([3,4]); + #use Data::Dumper; print Dumper($pki); + is_deeply $pki, [['f1', 1]], "Correct primary_key_info returned for $table"; +} + +# 11-14. Multi column primary key +ok $dbh->do('CREATE TABLE meta4 (f1 VARCHAR(2), f2 CHAR(1), PRIMARY KEY (f1,f2))'), 'Create table meta4'; +ok my $sth = $dbh->primary_key_info(undef, undef, 'meta4'), 'Get primary_key_info for meta4'; +my $pki = $sth->fetchall_arrayref({COLUMN_NAME => 1, KEY_SEQ => 1}); +#use Data::Dumper; print Dumper($pki); +is @$pki, 2, 'Primary key contains 2 columns'; +is_deeply $pki, [{COLUMN_NAME => 'f1', KEY_SEQ => 1},{COLUMN_NAME => 'f2', KEY_SEQ => 2}], + 'Correct primary_key_info returned for meta4'; + +# 15,16. Test primary_key +ok my @pk = $dbh->primary_key(undef, undef, 'meta4'), 'Get primary_key for meta4'; +is_deeply \@pk, [qw(f1 f2)], 'Correct primary_key returned for meta4'; + +# 17-21. I'm not sure what this is testing +$dbh->do("INSERT INTO meta4 VALUES ('xyz', 'b')"); +$sth = $dbh->prepare('SELECT * FROM meta4'); +$sth->execute; +$sth->fetch; +my $types = $sth->{TYPE}; +my $names = $sth->{NAME}; +# diag "Types: @$types\nNames: @$names"; +is scalar @$types, scalar @$names, '$sth->{TYPE} array is same length as $sth->{NAME} array'; +# FIXME: This is wrong! $sth->{TYPE} should return an array of integers see: rt #46873 +TODO: { + local $TODO = '$sth->{TYPE} should return an array of integers.'; + isnt $types->[0], 'VARCHAR(2)', '$sth->{TYPE}[0] doesn\'t return a string'; + isnt $types->[1], 'CHAR(1)', '$sth->{TYPE}[1] doesn\'t return a string'; + like $types->[0], qr/^-?\d+$/, '$sth->{TYPE}[0] returns an integer'; + like $types->[1], qr/^-?\d+$/, '$sth->{TYPE}[1] returns an integer'; +} + |