Mercurial > hg > monetdb-perl

annotate DBD/t/DBD_TEST.pm @ 12:8c8bd15f7a0b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Updated copyright year.
author Sjoerd Mullender <sjoerd@acm.org>
date Mon, 30 Sep 2019 21:27:37 +0200 (2019-09-30)
parents a0ec9e080a5b
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
1 # This Source Code Form is subject to the terms of the Mozilla Public
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
2 # License, v. 2.0. If a copy of the MPL was not distributed with this
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
3 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
4 #
12
8c8bd15f7a0b Updated copyright year.
Sjoerd Mullender <sjoerd@acm.org>
parents: 4
diff changeset
5 # Copyright 1997 - July 2008 CWI, August 2008 - 2019 MonetDB B.V.
0
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
6
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
7 package DBD_TEST;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
8
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
9 =head1 DESCRIPTION
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
10
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
11 This package is a common set of routines for the DBD::monetdb tests.
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
12
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
13 =cut
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
14
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
15 use strict;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
16 use warnings;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
17 use DBI qw(:sql_types);
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
18
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
19 our $VERSION = '0.07';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
20 our $table_name = 'PERL_DBD_TEST';
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
21
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
22 our %TestFieldInfo = (
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
23 'A' => [SQL_INTEGER, SQL_SMALLINT, SQL_TINYINT, SQL_NUMERIC, SQL_DECIMAL]
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
24 ,'B' => [SQL_WVARCHAR, SQL_VARCHAR, SQL_WCHAR, SQL_CHAR]
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
25 ,'C' => [SQL_WLONGVARCHAR, SQL_LONGVARCHAR, SQL_WVARCHAR, SQL_VARCHAR]
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
26 ,'D' => [SQL_TYPE_DATE, SQL_TYPE_TIMESTAMP, SQL_DATE, SQL_TIMESTAMP]
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
27 );
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
28
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
29
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
30 sub get_type_for_column {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
31 my $dbh = shift;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
32 my $col = shift;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
33
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
34 $dbh->type_info( $TestFieldInfo{$col} );
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
35 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
36
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
37
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
38 sub tab_create {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
39 my $dbh = shift;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
40 my $tbl = shift || $table_name;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
41 {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
42 local ($dbh->{PrintError}, $dbh->{RaiseError}, $dbh->{Warn});
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
43 $dbh->{PrintError} = $dbh->{RaiseError} = $dbh->{Warn} = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
44 $dbh->do("DROP TABLE $tbl");
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
45 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
46 my $fields;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
47 for my $f ( sort keys %TestFieldInfo ) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
48 my $ti = get_type_for_column( $dbh, $f );
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
49 $fields .= ', ' if $fields;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
50 $fields .= "$f ";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
51 $fields .= $ti->{TYPE_NAME};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
52
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
53 if ( defined $ti->{CREATE_PARAMS} ) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
54 my $size = $ti->{COLUMN_SIZE};
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
55 $size = 50 if $f eq 'B'; # TODO
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
56 $fields .= "( $size )" if $ti->{CREATE_PARAMS} =~ /LENGTH/i;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
57 $fields .= "( $size, 0 )" if $ti->{CREATE_PARAMS} =~ /PRECISION,SCALE/i;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
58 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
59 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
60 print "# Using fields: $fields\n";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
61 return $dbh->do("CREATE TABLE $tbl( $fields )");
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
62 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
63
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
64
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
65 sub tab_delete {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
66 my $dbh = shift;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
67 my $tbl = shift || $table_name;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
68
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
69 $dbh->do("DELETE FROM $tbl");
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
70 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
71
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
72
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
73 sub dump_results {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
74 my $sth = shift;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
75 my $rows = 0;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
76
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
77 return 0 unless $sth;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
78
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
79 while ( my $row = $sth->fetch ) {
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
80 $rows++;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
81 print '# ', DBI::neat_list( $row ),"\n";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
82 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
83 print "# $rows rows\n";
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
84 $rows;
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
85 }
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
86
cedccb7e0143 Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff changeset
87 1;