Mercurial > hg > monetdb-perl

comparison DBD/t/44ddfk.t @ 0:cedccb7e0143

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
author Sjoerd Mullender <sjoerd@acm.org>
date Mon, 19 Sep 2016 15:15:52 +0200 (2016-09-19)
parents
children a0ec9e080a5b
comparison
equal deleted inserted replaced
-1:000000000000 0:cedccb7e0143
1 #!perl -I./t
2
3 # This Source Code Form is subject to the terms of the Mozilla Public
4 # License, v. 2.0. If a copy of the MPL was not distributed with this
5 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
6 #
7 # Copyright 1997 - July 2008 CWI, August 2008 - 2016 MonetDB B.V.
8
9 $| = 1;
10
11 use strict;
12 use warnings;
13 use DBI();
14 use DBD_TEST();
15
16 use Test::More;
17
18 if (defined $ENV{DBI_DSN}) {
19 plan tests => 14;
20 } else {
21 plan skip_all => 'Cannot test without DB info';
22 }
23
24 pass('Foreign key tests');
25
26 my $dbh = DBI->connect or die "Connect failed: $DBI::errstr\n";
27 pass('Database connection created');
28
29 eval { $dbh->foreign_key_info };
30 ok( $@,"Call to foreign_key_info with 0 arguments, error expected: $@");
31
32 {
33 local $dbh->{PrintWarn} = 0;
34
35 # my $sth = $dbh->foreign_key_info('', undef, undef, undef, undef, undef );
36 # ok( $dbh->errstr,'Call to foreign_key_info with catalog argument, warning expected: ' . $dbh->errstr );
37 }
38 # -----------------------------------------------------------------------------
39
40 my $catalog = undef;
41 my $schema = $dbh->selectrow_array(<<'SQL');
42 select name from sys.schemas where name = current_schema
43 SQL
44 ok( $schema,"Current schema: $schema");
45 my $tbl = lc $DBD_TEST::table_name;
46 my $tbl2 = $tbl . '_2';
47
48 my $ti = DBD_TEST::get_type_for_column( $dbh,'A');
49 is( ref $ti,'HASH','Type info');
50
51 {
52 local ($dbh->{Warn}, $dbh->{PrintError});
53 $dbh->{PrintError} = $dbh->{Warn} = 0;
54 $dbh->do("DROP TABLE $tbl2");
55 $dbh->do("DROP TABLE $tbl");
56 }
57 # -----------------------------------------------------------------------------
58 SKIP: {
59 my $sql = <<"SQL";
60 create table $tbl
61 (
62 n integer
63 , s varchar(9)
64 , d date
65 , constraint pk_t primary key ( n, s )
66 , constraint uk_t unique ( d )
67 )
68 SQL
69 $dbh->do( $sql );
70 is( $dbh->err, undef,"$sql");
71
72 skip('FK test 1', 4 ) if $dbh->err;
73
74 $sql = <<"SQL";
75 create table $tbl2
76 (
77 n2 integer
78 , s2 varchar(9)
79 , d2 date
80 , constraint pk2_t primary key ( n2, s2 )
81 , constraint uk2_t unique ( d2 )
82 , constraint fkp_t foreign key ( n2, s2 ) references $tbl
83 , constraint fku_t foreign key ( d2 ) references $tbl( d )
84 )
85 SQL
86 $dbh->do( $sql );
87 is( $dbh->err, undef,"$sql");
88
89 my $sth = $dbh->foreign_key_info( $catalog, $schema, $tbl, $catalog, $schema, $tbl2 );
90 ok( defined $sth,'Statement handle defined');
91
92 my $a = $sth->fetchall_arrayref;
93
94 print "# Foreign key columns:\n";
95 print '# ', DBI::neat_list( $_ ), "\n" for @$a;
96
97 is( $#$a, 2,'Exactly 3 foreign key columns');
98 is( $a->[2][3],'s', 'Foreign key column name');
99
100 ok( $dbh->do( $_ ), $_ ) for "DROP TABLE $tbl2";
101 ok( $dbh->do( $_ ), $_ ) for "DROP TABLE $tbl";
102 }
103 # -----------------------------------------------------------------------------
104 SKIP: {
105 skip('Invalid use of null pointer (SQL-HY009) when using DBD::ODBC', 1 )
106 if $dbh->{Driver}{Name} eq 'ODBC';
107 my $sth = $dbh->foreign_key_info( undef, undef, undef, undef, undef, undef );
108 ok( defined $sth,'Statement handle defined for foreign_key_info()');
109 DBD_TEST::dump_results( $sth );
110 }
111 # -----------------------------------------------------------------------------
112
113 ok( $dbh->disconnect,'Disconnect');