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
137
138
139
140
141
142
143
144
145
|
#!perl
use strict;
use warnings;
use lib 't/lib';
use DBDOracleTestLib qw/ oracle_test_dsn db_handle /;
use Test::More;
use DBI;
use Config;
use DBD::Oracle qw(ORA_OCI);
$| = 1;
my $dbh = db_handle( { PrintError => 0 } );
if ($dbh) {
plan tests => 28;
}
else {
plan skip_all => 'Unable to connect to Oracle';
}
my ( $sth, $p1, $p2, $tmp );
SKIP: {
skip 'not unix-like', 2 unless $Config{d_semctl};
my @ora_oci_version = split /\./, ORA_OCI();
skip 'solaris with OCI>9.x', 2
if $^O eq 'solaris' and $ora_oci_version[0] > 9;
# basic check that we can fork subprocesses and wait for the status
# after having connected to Oracle
# at some point, this should become a subtest
my $success = is system('exit 1;'), 1 << 8,
'system exit 1 should return 256';
$success &&= is system('exit 0;'), 0, 'system exit 0 should return 0';
unless ($success) {
diag <<'END_NOTE';
The test might have failed because you are using a
a bequeather to connect to the server.
If you need to continue using a bequeather to connect to a server on the
same host as the client add:
bequeath_detach = yes
to your sqlnet.ora file or you won't be able to safely use fork/system
functions in Perl.
END_NOTE
}
}
$sth = $dbh->prepare(
q{
/* also test preparse doesn't get confused by ? :1 */
/* also test placeholder binding is case insensitive */
select :a, :A from user_tables -- ? :1
}
);
ok( $sth->{ParamValues},
'preparse, case insensitive, placeholders in comments' );
is( keys %{ $sth->{ParamValues} }, 1, 'number of parameters' );
is( $sth->{NUM_OF_PARAMS}, 1, 'expected number of parameters' );
ok( $sth->bind_param( ':a', 'a value' ), 'bind_param for select parameter' );
ok( $sth->execute, 'execute for select parameter' );
ok( $sth->{NUM_OF_FIELDS}, 'NUM_OF_FIELDS' );
eval {
local $SIG{__WARN__} = sub { die @_ }; # since DBI 1.43
$p1 = $sth->{NUM_OFFIELDS_typo};
};
ok( $@ =~ /attribute/, 'unrecognised attribute' );
ok( $sth->{Active}, 'statement is active' );
ok( $sth->finish, 'finish' );
ok( !$sth->{Active}, 'statement is not active' );
$sth = $dbh->prepare("select * from user_tables");
ok( $sth->execute, 'execute for user_tables' );
ok( $sth->{Active}, 'active for user_tables' );
1 while ( $sth->fetch ); # fetch through to end
ok( !$sth->{Active}, 'user_tables not active after fetch' );
# so following test works with other NLS settings/locations
ok( $dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'"),
'set NLS_NUMERIC_CHARACTERS' );
ok(
$tmp = $dbh->selectall_arrayref(
q{
select 1 * power(10,-130) "smallest?",
9.9999999999 * power(10,125) "biggest?"
from dual
}
),
'select all for arithmetic'
);
my @tmp = @{ $tmp->[0] };
#warn "@tmp"; $tmp[0]+=0; $tmp[1]+=0; warn "@tmp";
ok( $tmp[0] <= 1.0000000000000000000000000000000001e-130, "tmp0=$tmp[0]" );
ok( $tmp[1] >= 9.99e+125, "tmp1=$tmp[1]" );
my $warn = '';
eval {
local $SIG{__WARN__} = sub { $warn = $_[0] };
$dbh->{RaiseError} = 1;
$dbh->{PrintError} = 1;
$dbh->do('some invalid sql statement');
};
ok(
$@ =~ m/DBD::Oracle::db do failed:/,
"eval error: ``$@'' expected 'do failed:'"
);
#print "''$warn''";
ok(
$warn =~ m/DBD::Oracle::db do failed:/,
"warn error: ``$warn'' expected 'do failed:'"
);
ok( $DBI::err, 'err defined' );
$dbh->{RaiseError} = 0;
$dbh->{PrintError} = 0;
# ---
ok( $dbh->ping, 'ping - connected' );
my $ora_oci = DBD::Oracle::ORA_OCI(); # dualvar
note sprintf "ORA_OCI = %d (%s)\n", $ora_oci, $ora_oci;
ok( "$ora_oci", 'ora_oci defined' );
ok( $ora_oci >= 8, "ora_oci $ora_oci >= 8" );
my @ora_oci = split( /\./, $ora_oci, -1 );
ok( scalar @ora_oci >= 2, 'version has 2 or more components' );
ok( ( scalar @ora_oci == grep { DBI::looks_like_number($_) } @ora_oci ),
'version looks like numbers' );
is( $ora_oci[0], int($ora_oci), 'first number is int' );
|
