Mercurial > hg > monetdb-perl
annotate DBD/t/31txn.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 |
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 #!perl -I./t |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
2 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
3 # 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
|
4 # 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
|
5 # 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
|
6 # |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
7 # Copyright 1997 - July 2008 CWI, August 2008 - 2016 MonetDB B.V. |
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 $| = 1; |
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 use strict; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
12 use warnings; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
13 use DBI(); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
14 use DBD_TEST(); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
15 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
16 use Test::More; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
17 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
18 if ( defined $ENV{DBI_DSN} ) { |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
19 plan tests => 19; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
20 } else { |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
21 plan skip_all => 'Cannot test without DB info'; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
22 } |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
23 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
24 my $tbl = $DBD_TEST::table_name; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
25 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
26 pass('Transaction / AutoCommit tests'); |
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 my $dbh = DBI->connect or die "Connect failed: $DBI::errstr\n"; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
29 $dbh->{RaiseError} = 1; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
30 $dbh->{PrintError} = 0; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
31 pass('Database connection created'); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
32 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
33 for ('rollback','commit') |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
34 { |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
35 my $Warning; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
36 local $SIG{__WARN__} = sub { $Warning = $_[0]; chomp $Warning; }; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
37 local $dbh->{Warn} = 1; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
38 $dbh->$_; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
39 like( $Warning, qr/ineffective/, "Warning expected: $Warning"); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
40 } |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
41 ok( DBD_TEST::tab_create( $dbh ),"CREATE TABLE $tbl"); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
42 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
43 $dbh->{AutoCommit} = 1; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
44 ok( $dbh->{AutoCommit}, "AutoCommit ON: $dbh->{AutoCommit}"); |
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 is( commitTest( $dbh ), 1,'Commit Test, AutoCommit ON'); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
47 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
48 $dbh->{AutoCommit} = 0; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
49 ok( !$dbh->{AutoCommit}, "AutoCommit OFF: $dbh->{AutoCommit}"); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
50 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
51 is( commitTest( $dbh ), 0,'Commit Test, AutoCommit OFF'); |
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 $dbh->{AutoCommit} = 1; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
54 ok( $dbh->{AutoCommit}, "AutoCommit ON: $dbh->{AutoCommit}"); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
55 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
56 is( commitTest( $dbh ), 1,'Commit Test, AutoCommit ON'); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
57 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
58 ok( $dbh->begin_work ,'begin_work'); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
59 ok( $dbh->{BegunWork} ,'BegunWork ON'); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
60 ok(!$dbh->{AutoCommit},'AutoCommit OFF'); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
61 ok( $dbh->rollback ,'rollback'); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
62 ok(!$dbh->{BegunWork} ,'BegunWork OFF'); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
63 ok( $dbh->{AutoCommit},'AutoCommit ON'); |
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 ok( $dbh->do("DROP TABLE $tbl"),"DROP TABLE $tbl"); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
66 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
67 ok( $dbh->disconnect,'Disconnect'); |
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 # ----------------------------------------------------------------------------- |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
70 # Returns true when a row remains inserted after a rollback. |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
71 # This means that AutoCommit is ON. |
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 commitTest { |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
74 my $dbh = shift; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
75 |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
76 $dbh->do("DELETE FROM $tbl WHERE A = 100") or return undef; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
77 { |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
78 local $SIG{__WARN__} = sub {}; # suppress the "commit ineffective" warning |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
79 local $dbh->{RaiseError} = 0; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
80 $dbh->commit; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
81 } |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
82 $dbh->do("INSERT INTO $tbl( A, B ) VALUES( 100,'T100')"); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
83 { |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
84 local $SIG{__WARN__} = sub {}; # suppress the "rollback ineffective" warning |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
85 local $dbh->{RaiseError} = 0; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
86 $dbh->rollback; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
87 } |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
88 my $sth = $dbh->prepare("SELECT A, B FROM $tbl WHERE A = 100"); |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
89 $sth->execute; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
90 my $rc = 0; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
91 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
|
92 print "-- @$row\n"; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
93 $rc = 1; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
94 } |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
95 $rc; |
cedccb7e0143
Copy of clients/perl directory without Tests from MonetDB changeset 4d2d4532228a.
Sjoerd Mullender <sjoerd@acm.org>
parents:
diff
changeset
|
96 } |