Mercurial > hg > monetdb-perl

comparison DBD/t/15many.t @ 26:a0b0ed79f8ab

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
author Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
date Tue, 15 Dec 2020 15:05:24 +0100 (2020-12-15)
parents
children 536255410444
comparison
equal deleted inserted replaced
25:154519984d9b 26:a0b0ed79f8ab
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 - 2020 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 => 4;
20 } else {
21 plan skip_all => 'Cannot test without DB info';
22 }
23
24 my $dbh = DBI->connect or die "Connect failed: $DBI::errstr\n";
25 pass('Database connection created');
26
27 # fetch 1000 of the 5000 rows, see Bug 2889
28 my $query = qq{
29 SELECT * FROM sys.generate_series(0,5000);
30 };
31 my $sth = $dbh->prepare($query);
32 $sth->execute;
33 my $r = $sth->fetchall_arrayref(undef, 1000);
34 my $count = scalar(@{$r}); # don't say perl isn't weird
35 ok($count == 1000, 'got 1000 rows as requested');
36
37 # fetch a lot of rows and see we don't get disconnected halfway, see Bug 2897
38 $query = qq{
39 SELECT * FROM tables, sys.generate_series(0,1000);
40 };
41 $sth = $dbh->prepare($query);
42 $sth->execute;
43 $r = $sth->fetchall_arrayref();
44 $count = scalar(@{$r});
45 ok($count % 1000 == 0, "got $count rows");
46
47
48
49
50 ok( $dbh->disconnect,'Disconnect');