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
|
#!/usr/bin/perl -w -I./t
# based on *Id: 20SqlServer.t 568 2004-11-08 15:12:37Z jurl *
use strict;
use warnings;
use UChelp;
use Test::More;
use DBI qw(:sql_types);
my $has_test_nowarnings;
$|=1;
my $WAIT=0;
my @data;
my $tests;
my $data_tests;
BEGIN {
if ($] < 5.008001) {
plan skip_all => "Old Perl lacking unicode support";
} elsif (!defined $ENV{DBI_DSN}) {
plan skip_all => "DBI_DSN is undefined";
}
@data=(
"hello ASCII: the quick brown fox jumps over the yellow dog",
"Hello Unicode: german umlauts (\x{00C4}\x{00D6}\x{00DC}\x{00E4}\x{00F6}\x{00FC}\x{00DF}) smile (\x{263A}) hebrew shalom (\x{05E9}\x{05DC}\x{05D5}\x{05DD})",
);
push @data,map { "again $_" } @data;
utf8::is_utf8($data[0]) and die "Perl set UTF8 flag on non-unicode string constant";
utf8::is_utf8($data[1]) or die "Perl did not set UTF8 flag on unicode string constant";
utf8::is_utf8($data[2]) and die "Perl set UTF8 flag on non-unicode string constant";
utf8::is_utf8($data[3]) or die "Perl did not set UTF8 flag on unicode string constant";
unshift @data,'';
push @data,42;
my @plaindata=grep { !utf8::is_utf8($_) } @data;
@plaindata or die "OOPS";
$data_tests = 6*@data+6*@plaindata;
$tests=2+$data_tests;
eval "require Test::NoWarnings";
if (!$@) {
$has_test_nowarnings = 1;
}
$tests += 1 if $has_test_nowarnings;
plan tests => $tests;
}
END {
Test::NoWarnings::had_no_warnings()
if ($has_test_nowarnings);
}
my $dbh=DBI->connect();
ok(defined($dbh),"DBI connect");
SKIP: {
skip "Unicode-specific tests disabled - not a unicode build",
$data_tests + 1 if (!$dbh->{odbc_has_unicode});
if (DBI::neat($dbh->get_info(6)) =~ 'SQORA32') {
skip "Oracle ODBC driver does not work with these tests",
$data_tests + 1;
}
my $dbname=$dbh->get_info(17); # DBI::SQL_DBMS_NAME
SKIP: {
my ($len,$fromdual,$skipempty);
if ($dbname=~/Microsoft SQL Server/i) {
($len,$fromdual,$skipempty)=('LEN','',0);
} elsif ($dbname=~/Oracle/i) {
($len,$fromdual,$skipempty)=('LENGTH','FROM DUAL',1);
} elsif ($dbname=~/PostgreSQL/i) {
($len,$fromdual,$skipempty)=('LENGTH','',0);
} elsif ($dbname=~/ACCESS/i) {
($len,$fromdual,$skipempty)=('LEN','',0);
} else {
skip "Tests not supported using $dbname",$tests-1;
}
$dbh->{RaiseError} = 1;
$dbh->{'LongTruncOk'}=1;
$dbh->{'LongReadLen'}=32000;
foreach my $txt (@data) {
SKIP: {
if ($skipempty and ($txt eq '')) {
skip('Database is known to treat empty strings as NULL in this test',12);
}
unless (utf8::is_utf8($txt)) {
my $sth=$dbh->prepare("SELECT ? as roundtrip, $len(?) as roundtriplen $fromdual");
ok(defined($sth),"prepare round-trip select statement plaintext");
# diag(dumpstr($txt));
$sth->bind_param (1,$txt,SQL_VARCHAR);
$sth->bind_param (2,$txt,SQL_VARCHAR);
pass("bind VARCHAR");
$sth->execute();
pass("execute");
my ($t,$tlen)=$sth->fetchrow_array();
pass('fetch');
cmp_ok($tlen,'==',length($txt),'length equal');
utf_eq_ok($t,$txt,'text equal');
}
my $sth=$dbh->prepare("SELECT ? as roundtrip, $len(?) as roundtriplen $fromdual");
ok(defined($sth),"prepare round-trip select statement unicode");
$sth->bind_param (1,$txt,SQL_WVARCHAR);
$sth->bind_param (2,$txt,SQL_WVARCHAR);
pass("bind WVARCHAR");
$sth->execute();
pass("execute");
my ($t,$tlen)=$sth->fetchrow_array();
pass('fetch');
cmp_ok($tlen,'==',length($txt),'length equal');
utf_eq_ok($t,$txt,'text equal');
}
}
$dbh->disconnect;
pass("all done");
}
};
exit 0;
|
