1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
#!/usr/bin/perl -w -I./t
# $Id: rt_62033.t 15090 2012-01-20 19:26:23Z mjevans $
#
# rt62033 - not really this rt but a bug discovered when looking in to it
#
# Check active is enabled on a statement after SQLMoreResults indicates
# there is another result-set.
#
use Test::More;
use strict;
use DBI qw(:sql_types);
use_ok('ODBCTEST');
my $dbh;
BEGIN {
if (!defined $ENV{DBI_DSN}) {
plan skip_all => "DBI_DSN is undefined";
}
}
END {
if ($dbh) {
eval {
local $dbh->{PrintWarn} = 0;
local $dbh->{PrintError} = 0;
$dbh->do(q/drop table PERL_DBD_RT_62033/);
};
}
}
$dbh = DBI->connect();
unless($dbh) {
BAIL_OUT("Unable to connect to the database $DBI::errstr\nTests skipped.\n");
exit 0;
}
$dbh->{RaiseError} = 1;
$dbh->{ChopBlanks} = 1;
$dbh->{PrintError} = 0;
my $dbms_name = $dbh->get_info(17);
ok($dbms_name, "got DBMS name: $dbms_name"); # 2
my $dbms_version = $dbh->get_info(18);
ok($dbms_version, "got DBMS version: $dbms_version"); # 3
my $driver_name = $dbh->get_info(6);
ok($driver_name, "got DRIVER name: $driver_name"); # 4
my $driver_version = $dbh->get_info(7);
ok($driver_version, "got DRIVER version $driver_version"); # 5
my ($ev, $sth);
# this needs to be MS SQL Server
if ($dbms_name !~ /Microsoft SQL Server/) {
note('Not Microsoft SQL Server');
done_testing();
exit 0;
}
eval {
local $dbh->{PrintWarn} = 0;
local $dbh->{PrintError} = 0;
$dbh->do('drop table PERL_DBD_RT_62033');
};
# try and create a table to test with
eval {
$dbh->do(
'create table PERL_DBD_RT_62033 (a int identity, b char(10) not null)');
};
$ev = $@;
if ($@) {
BAIL_OUT("Failed to create test table - aborting test ($ev)");
exit 0;
}
pass('created test table');
sub doit
{
my $dbh = shift;
my $expect = shift;
my $s = $dbh->prepare_cached(
q/insert into PERL_DBD_RT_62033 (b) values(?);select @@identity/);
eval {$s->execute(@_)};
if (!$expect) {
ok($@, 'Error for constraint - just inserted undef into not null column and it appeared to work');
note("For some drivers (freeTDS/MS SQL Server for Linux) there is no way out of this so expect further errors");
} else {
ok(!$@, 'Execute ok') or diag($@);
}
# Some drivers won't like us calling SQLMoreResults/SQLDescribe etc
# after the above if it errors. When we call odbc_more_results it actually
# ends up doing a SQLDescribe. For most drivers I've tested they
# are ok with this but a few (freeTDS) are not. The problem with freeTDS
# is that if you then omit the SQLMoreResults and continue with this test
# you'll get an SQL_ERROR from the next execute without an error msg
# so it would seem there is no way to make this work in freeTDS as it
# stands.
#
# Some drivers (basically all those I've tested except freeTDS) need you
# to call SQLMoreResults even if the above fails or you'll get invalid
# cursor state on the next statement (MS SQL Server and MS native client
# driver).
if ($s->{NUM_OF_FIELDS} == 0) {
my $x = $s->{odbc_more_results};
}
if ($expect) {
# for the error case where we attempt to insert a NULL into column b
# we'd expect odbc_more_results to return 0/false - there are no more
# results
my $identity;
($identity) = $s->fetchrow_array;
#diag("identity = ", DBI::neat($identity), "\n");
is($identity, $expect, "Identity");
($identity) = $s->fetchrow_array;
} else {
$s->finish;
}
}
doit($dbh, undef, undef);
doit($dbh, 2, 'fred');
eval {
local $dbh->{PrintWarn} = 0;
local $dbh->{PrintError} = 0;
$dbh->do('drop table PERL_DBD_RT_62033');
};
done_testing();
|
