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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
|
#!/usr/bin/perl
#
#
# 2011-01-29 stefan(s.bv.)
# Using string comparison with Test::More's 'is'
#
# 2011-01-29 stefan(s.bv.)
# New version based on t/testlib.pl and Firebird.dbtest
use strict;
use warnings;
use Test::More;
use DBI;
use lib 't','.';
use TestFirebird;
my $T = TestFirebird->new;
my ( $dbh, $error_str ) = $T->connect_to_database( { ChopBlanks => 1 } );
if ($error_str) {
BAIL_OUT("Unknown: $error_str!");
}
unless ( $dbh->isa('DBI::db') ) {
plan skip_all => 'Connection to database failed, cannot continue testing';
}
else {
plan tests => 29;
}
ok($dbh, 'Connected to the database');
# DBI->trace(4, "trace.txt");
# ------- TESTS ------------------------------------------------------------- #
#
# Find a possible new table name
#
my $table = find_new_table($dbh);
ok($table, "TABLE is '$table'");
# Expected fetched values
# Need to store the decimal precision for 'sprintf'
# Prec must also be the same in CREATE TABLE, of course
my $expected = {
NUMERIC_2_DIGITS => {
prec => 2,
test => {
0 => 123456.79,
1 => -123456.79,
2 => 123456.01,
3 => -123456.09,
4 => 10.9,
},
},
NUMERIC_3_DIGITS => {
prec => 3,
test => {
0 => 86753090000.868,
1 => -86753090000.868,
2 => 80.080,
3 => -80.080,
4 => 10.9,
},
},
NUMERIC_NO_DIGITS => {
prec => 0,
test => {
0 => 11,
1 => -11,
2 => 10,
3 => 0,
4 => 11,
},
},
};
#
# Create a new table
#
my $def =<<"DEF";
CREATE TABLE $table (
NUMERIC_2_DIGITS NUMERIC( 9, 2),
NUMERIC_3_DIGITS NUMERIC(18, 3),
NUMERIC_NO_DIGITS NUMERIC(10, 0)
)
DEF
ok( $dbh->do($def), qq{CREATE TABLE '$table'} );
#
# Insert some values
#
my $stmt =<<"END_OF_QUERY";
INSERT INTO $table (
NUMERIC_2_DIGITS,
NUMERIC_3_DIGITS,
NUMERIC_NO_DIGITS
) VALUES (?, ?, ?)
END_OF_QUERY
ok(my $insert = $dbh->prepare($stmt), 'PREPARE INSERT');
# Insert positive numbers
ok($insert->execute(
123456.7895,
86753090000.8675309,
10.9),
'INSERT POSITIVE NUMBERS'
);
# Insert negative numbers
ok($insert->execute(
-123456.7895,
-86753090000.8675309,
-10.9),
'INSERT NEGATIVE NUMBERS'
);
# Insert with some variations in the precision part
ok($insert->execute(
123456.01,
80.080,
10.0),
'INSERT NUMBERS WITH VARIOUS PREC 1'
);
ok($insert->execute(
-123456.09,
-80.080,
0.0),
'INSERT NUMBERS WITH VARIOUS PREC 2'
);
ok($insert->execute(
10.9,
10.9,
10.9),
'INSERT NUMBERS WITH VARIOUS PREC 3'
);
#
# Select the values
#
ok( my $cursor = $dbh->prepare( qq{SELECT * FROM $table}, ), 'PREPARE SELECT' );
ok($cursor->execute, 'EXECUTE SELECT');
ok((my $res = $cursor->fetchall_arrayref), 'FETCHALL arrayref');
my ($types, $names, $fields) = @{$cursor}{qw(TYPE NAME NUM_OF_FIELDS)};
for (my $i = 0; $i < @$res; $i++) {
for (my $j = 0; $j < $fields; $j++) {
my $prec = $expected->{ $names->[$j] }{prec};
my $result = sprintf("%.${prec}f", $res->[$i][$j]);
my $corect = sprintf("%.${prec}f", $expected->{$names->[$j]}{test}{$i});
is($result, $corect, "Field: $names->[$j]");
}
}
#
# Drop the test table
#
$dbh->{AutoCommit} = 1;
ok( $dbh->do("DROP TABLE $table"), "DROP TABLE '$table'" );
#
# Finally disconnect.
#
ok($dbh->disconnect, 'DISCONNECT');
|
