Mercurial > hg > monetdb-perl
comparison DBD/t/51qi.t @ 0:cedccb7e0143
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 => 9; | |
20 } else { | |
21 plan skip_all => 'Cannot test without DB info'; | |
22 } | |
23 | |
24 pass('Quote identifier tests'); | |
25 | |
26 my $dbh = DBI->connect or die "Connect failed: $DBI::errstr\n"; | |
27 $dbh->{RaiseError} = 1; | |
28 $dbh->{PrintError} = 0; | |
29 pass('Database connection created'); | |
30 | |
31 my $tbl = lc $DBD_TEST::table_name; | |
32 | |
33 ok( DBD_TEST::tab_create( $dbh ),"CREATE TABLE $tbl"); | |
34 | |
35 eval { $dbh->quote_identifier }; | |
36 ok( $@,"Call to quote_identifier with 0 arguments, error expected: $@"); | |
37 { | |
38 my $cst = $dbh->quote_identifier('catalog','schema','table'); | |
39 ok( $cst,"Test quote: $cst"); | |
40 } | |
41 my @cst; | |
42 { | |
43 my $sth = $dbh->table_info( undef, undef, $tbl,'TABLE'); | |
44 ok( defined $sth,"Called table_info for $tbl"); | |
45 | |
46 my $row = $sth->fetch; | |
47 @cst = @$row[0,1,2]; | |
48 } | |
49 { | |
50 my $cst = $dbh->quote_identifier( @cst ); | |
51 ok( $cst,"Test quote from table_info: $cst"); | |
52 | |
53 my $sth = $dbh->prepare("SELECT * FROM $cst"); | |
54 ok( $sth,"SELECT * FROM $cst prepared"); | |
55 $sth->execute; | |
56 while ( my $row = $sth->fetch ) { | |
57 print '-- ', DBI::neat_list( $row ),"\n"; | |
58 } | |
59 } | |
60 | |
61 ok( $dbh->disconnect,'Disconnect'); |