Mercurial > hg > monetdb-perl

annotate DBD/t/15many.t @ 27:536255410444

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Test fetchrow_array
author Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
date Wed, 16 Dec 2020 11:31:46 +0100 (2020-12-16)
parents a0b0ed79f8ab
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
26
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
1 #!perl -I./t
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
2
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
3 # This Source Code Form is subject to the terms of the Mozilla Public
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
4 # License, v. 2.0. If a copy of the MPL was not distributed with this
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
5 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
6 #
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
7 # Copyright 1997 - July 2008 CWI, August 2008 - 2020 MonetDB B.V.
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
8
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
9 $| = 1;
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
10
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
11 use strict;
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
12 use warnings;
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
13 use DBI();
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
14 use DBD_TEST();
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
15
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
16 use Test::More;
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
17
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
18 if (defined $ENV{DBI_DSN}) {
27
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
19 plan tests => 5;
26
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
20 } else {
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
21 plan skip_all => 'Cannot test without DB info';
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
22 }
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
23
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
24 my $dbh = DBI->connect or die "Connect failed: $DBI::errstr\n";
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
25 pass('Database connection created');
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
26
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
27 # fetch 1000 of the 5000 rows, see Bug 2889
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
28 my $query = qq{
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
29 SELECT * FROM sys.generate_series(0,5000);
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
30 };
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
31 my $sth = $dbh->prepare($query);
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
32 $sth->execute;
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
33 my $r = $sth->fetchall_arrayref(undef, 1000);
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
34 my $count = scalar(@{$r}); # don't say perl isn't weird
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
35 ok($count == 1000, 'got 1000 rows as requested');
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
36
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
37 # fetch a lot of rows and see we don't get disconnected halfway, see Bug 2897
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
38 $query = qq{
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
39 SELECT * FROM tables, sys.generate_series(0,1000);
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
40 };
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
41 $sth = $dbh->prepare($query);
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
42 $sth->execute;
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
43 $r = $sth->fetchall_arrayref();
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
44 $count = scalar(@{$r});
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
45 ok($count % 1000 == 0, "got $count rows");
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
46
27
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
47 # fetch some data using fetchrow_array
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
48 # fetch a lot of rows and see we don't get disconnected halfway, see Bug 2897
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
49 $query = qq{
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
50 SELECT value as i, value as j, value as k FROM sys.generate_series(0,100);
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
51 };
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
52 $sth = $dbh->prepare($query);
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
53 $sth->execute;
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
54 my $cells = 0;
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
55 while (my @row = $sth->fetchrow_array) {
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
56 $cells += 1 + $#row;
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
57 }
536255410444 Test fetchrow_array
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents: 26
diff changeset
58 is($cells, 300, 'fetch items using fetchrow_array');
26
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
59
a0b0ed79f8ab Move tests for Bugs 2885, 2889, 2897 and 3235 from main repo to here
Joeri van Ruth <joeri.van.ruth@monetdbsolutions.com>
parents:
diff changeset
60 ok( $dbh->disconnect,'Disconnect');