File: 40types.t

package info (click to toggle)
libdbd-mysql-perl 4.053-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,128 kB
  • sloc: ansic: 4,780; perl: 836; makefile: 29; sh: 22
file content (114 lines) | stat: -rw-r--r-- 3,519 bytes parent folder | download | duplicates (5)
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
use strict;
use warnings;

use B qw(svref_2object SVf_IOK SVf_NOK SVf_POK SVf_IVisUV);
use Test::More;
use DBI;
use DBI::Const::GetInfoType;
use lib '.', 't';
require 'lib.pl';
$|= 1;

use vars qw($test_dsn $test_user $test_password);

my $dbh;
eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
                      { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
if ($@) {
    plan skip_all =>
        "no database connection";
}
plan tests => 40;

ok(defined $dbh, "Connected to database");

ok($dbh->do(qq{DROP TABLE IF EXISTS t1}), "making slate clean");

ok($dbh->do(qq{CREATE TABLE t1 (num INT)}), "creating table");
ok($dbh->do(qq{INSERT INTO t1 VALUES (100)}), "loading data");

my ($val) = $dbh->selectrow_array("SELECT * FROM t1");
is($val, 100);

my $sv = svref_2object(\$val);
ok($sv->FLAGS & SVf_IOK, "scalar is integer");
ok(!($sv->FLAGS & (SVf_IVisUV|SVf_NOK|SVf_POK)), "scalar is not unsigned intger or double or string");

ok($dbh->do(qq{DROP TABLE t1}), "cleaning up");

ok($dbh->do(qq{CREATE TABLE t1 (num VARCHAR(10))}), "creating table");
ok($dbh->do(qq{INSERT INTO t1 VALUES ('string')}), "loading data");

($val) = $dbh->selectrow_array("SELECT * FROM t1");
is($val, "string");

$sv = svref_2object(\$val);
ok($sv->FLAGS & SVf_POK, "scalar is string");
ok(!($sv->FLAGS & (SVf_IOK|SVf_NOK)), "scalar is not intger or double");

ok($dbh->do(qq{DROP TABLE t1}), "cleaning up");

SKIP: {
skip "New Data types not supported by server", 26
if !MinimumVersion($dbh, '5.0');

ok($dbh->do(qq{CREATE TABLE t1 (d DECIMAL(5,2))}), "creating table");

my $sth= $dbh->prepare("SELECT * FROM t1 WHERE 1 = 0");
ok($sth->execute(), "getting table information");

is_deeply($sth->{TYPE}, [ 3 ], "checking column type");

ok($sth->finish);

ok($dbh->do(qq{DROP TABLE t1}), "cleaning up");

#
# Bug #23936: bind_param() doesn't work with SQL_DOUBLE datatype
# Bug #24256: Another failure in bind_param() with SQL_DOUBLE datatype
#
ok($dbh->do(qq{CREATE TABLE t1 (num DOUBLE)}), "creating table");

$sth= $dbh->prepare("INSERT INTO t1 VALUES (?)");
ok($sth->bind_param(1, 2.1, DBI::SQL_DOUBLE), "binding parameter");
ok($sth->execute(), "inserting data");
ok($sth->finish);
ok($sth->bind_param(1, -1, DBI::SQL_DOUBLE), "binding parameter");
ok($sth->execute(), "inserting data");
ok($sth->finish);

my $ret = $dbh->selectall_arrayref("SELECT * FROM t1");
is_deeply($ret, [ [2.1],  [-1] ]);

$sv = svref_2object(\$ret->[0]->[0]);
ok($sv->FLAGS & SVf_NOK, "scalar is double");
ok(!($sv->FLAGS & (SVf_IOK|SVf_POK)), "scalar is not integer or string");

$sv = svref_2object(\$ret->[1]->[0]);
ok($sv->FLAGS & SVf_NOK, "scalar is double");
ok(!($sv->FLAGS & (SVf_IOK|SVf_POK)), "scalar is not integer or string");

ok($dbh->do(qq{DROP TABLE t1}), "cleaning up");

#
# [rt.cpan.org #19212] Mysql Unsigned Integer Fields
#
ok($dbh->do(qq{CREATE TABLE t1 (num INT UNSIGNED)}), "creating table");
ok($dbh->do(qq{INSERT INTO t1 VALUES (0),(4294967295)}), "loading data");

$ret = $dbh->selectall_arrayref("SELECT * FROM t1");
is_deeply($ret, [ [0],  [4294967295] ]);

$sv = svref_2object(\$ret->[0]->[0]);
ok($sv->FLAGS & (SVf_IOK|SVf_IVisUV), "scalar is unsigned integer");
ok(!($sv->FLAGS & (SVf_NOK|SVf_POK)), "scalar is not double or string");

$sv = svref_2object(\$ret->[1]->[0]);
ok($sv->FLAGS & (SVf_IOK|SVf_IVisUV), "scalar is unsigned integer");
ok(!($sv->FLAGS & (SVf_NOK|SVf_POK)), "scalar is not double or string");

ok($dbh->do(qq{DROP TABLE t1}), "cleaning up");
};

$dbh->disconnect();