Mercurial > hg > monetdb-perl

comparison DBD/t/31txn.t @ 0:cedccb7e0143

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 => 19;
20 } else {
21 plan skip_all => 'Cannot test without DB info';
22 }
23
24 my $tbl = $DBD_TEST::table_name;
25
26 pass('Transaction / AutoCommit tests');
27
28 my $dbh = DBI->connect or die "Connect failed: $DBI::errstr\n";
29 $dbh->{RaiseError} = 1;
30 $dbh->{PrintError} = 0;
31 pass('Database connection created');
32
33 for ('rollback','commit')
34 {
35 my $Warning;
36 local $SIG{__WARN__} = sub { $Warning = $_[0]; chomp $Warning; };
37 local $dbh->{Warn} = 1;
38 $dbh->$_;
39 like( $Warning, qr/ineffective/, "Warning expected: $Warning");
40 }
41 ok( DBD_TEST::tab_create( $dbh ),"CREATE TABLE $tbl");
42
43 $dbh->{AutoCommit} = 1;
44 ok( $dbh->{AutoCommit}, "AutoCommit ON: $dbh->{AutoCommit}");
45
46 is( commitTest( $dbh ), 1,'Commit Test, AutoCommit ON');
47
48 $dbh->{AutoCommit} = 0;
49 ok( !$dbh->{AutoCommit}, "AutoCommit OFF: $dbh->{AutoCommit}");
50
51 is( commitTest( $dbh ), 0,'Commit Test, AutoCommit OFF');
52
53 $dbh->{AutoCommit} = 1;
54 ok( $dbh->{AutoCommit}, "AutoCommit ON: $dbh->{AutoCommit}");
55
56 is( commitTest( $dbh ), 1,'Commit Test, AutoCommit ON');
57
58 ok( $dbh->begin_work ,'begin_work');
59 ok( $dbh->{BegunWork} ,'BegunWork ON');
60 ok(!$dbh->{AutoCommit},'AutoCommit OFF');
61 ok( $dbh->rollback ,'rollback');
62 ok(!$dbh->{BegunWork} ,'BegunWork OFF');
63 ok( $dbh->{AutoCommit},'AutoCommit ON');
64
65 ok( $dbh->do("DROP TABLE $tbl"),"DROP TABLE $tbl");
66
67 ok( $dbh->disconnect,'Disconnect');
68
69 # -----------------------------------------------------------------------------
70 # Returns true when a row remains inserted after a rollback.
71 # This means that AutoCommit is ON.
72 # -----------------------------------------------------------------------------
73 sub commitTest {
74 my $dbh = shift;
75
76 $dbh->do("DELETE FROM $tbl WHERE A = 100") or return undef;
77 {
78 local $SIG{__WARN__} = sub {}; # suppress the "commit ineffective" warning
79 local $dbh->{RaiseError} = 0;
80 $dbh->commit;
81 }
82 $dbh->do("INSERT INTO $tbl( A, B ) VALUES( 100,'T100')");
83 {
84 local $SIG{__WARN__} = sub {}; # suppress the "rollback ineffective" warning
85 local $dbh->{RaiseError} = 0;
86 $dbh->rollback;
87 }
88 my $sth = $dbh->prepare("SELECT A, B FROM $tbl WHERE A = 100");
89 $sth->execute;
90 my $rc = 0;
91 while ( my $row = $sth->fetch ) {
92 print "-- @$row\n";
93 $rc = 1;
94 }
95 $rc;
96 }