Committed by =?UTF-8?q?Dagfinn=20Ilmari=20Manns=C3=A5ker?= <[email protected]>
Subject: [DBD::Pg 3/3] Skip tests for characters not supported by the
server_encoding
---
t/12placeholders.t | 20 +++++++++++++-------
t/30unicode.t | 17 +++++++++++++++++
2 files changed, 30 insertions(+), 7 deletions(-)
diff --git a/t/12placeholders.t b/t/12placeholders.t
index 912e449..eb4f3d2 100644
--- a/t/12placeholders.t
+++ b/t/12placeholders.t
@@ -655,13 +655,19 @@ for my $char (qw{0 9 A Z a z}) { ## six letters
is ($@, q{}, $t);
}
-for my $ident (qq{\x{5317}}, qq{abc\x{5317}}, qq{_cde\x{5317}}) { ## hi-bit
chars
- eval {
- $sth = $dbh->prepare(qq{SELECT \$$ident\$ 123 \$$ident\$});
- $sth->execute();
- $sth->finish();
- };
- is ($@, q{}, $t);
+SKIP: {
+ my $server_encoding = $dbh->selectrow_array('SHOW server_encoding');
+ skip "Cannot test non-ascii dollar quotes with
server_encoding='$server_encoding' (need UTF8 or SQL_ASCII)", 3,
+ unless $server_encoding =~ /\A(?:UTF8|SQL_ASCII)\z/;
+
+ for my $ident (qq{\x{5317}}, qq{abc\x{5317}}, qq{_cde\x{5317}}) { ##
hi-bit chars
+ eval {
+ $sth = $dbh->prepare(qq{SELECT \$$ident\$ 123
\$$ident\$});
+ $sth->execute();
+ $sth->finish();
+ };
+ is ($@, q{}, $t);
+ }
}
}
diff --git a/t/30unicode.t b/t/30unicode.t
index ac9229f..e7ed168 100644
--- a/t/30unicode.t
+++ b/t/30unicode.t
@@ -26,6 +26,8 @@ isnt ($dbh, undef, 'Connect to database for unicode testing');
my @tests;
+my $server_encoding = $dbh->selectrow_array('SHOW server_encoding');
+
# Beware, characters used for testing need to be known to Unicode version
4.0.0,
# which is what perl 5.8.1 shipped with.
foreach (
@@ -53,8 +55,14 @@ foreach (
}
}
+my %ranges = (
+ UTF8 => qr/.*/,
+ LATIN1 => qr/\A(?:ascii|latin 1 range)\z/,
+);
+
foreach (@tests) {
my ($state, $range, $type, $value) = @$_;
+ SKIP:
foreach my $test (
{
qtype => 'placeholder',
@@ -80,6 +88,8 @@ foreach (@tests) {
},
):()),
) {
+ skip "Can't do $range tests with server_encoding='$server_encoding'", 1
+ unless $range =~ ($ranges{$server_encoding} || qr/\A(?:ascii)\z/);
foreach my $enable_utf8 (1, 0, -1) {
my $desc = "$state $range UTF-8 $test->{qtype} $type
(pg_enable_utf8=$enable_utf8)";
my @args = @{$test->{args} || []};
@@ -115,6 +125,11 @@ foreach (@tests) {
}
}
+my %ord_max = (
+ LATIN1 => 255,
+ UTF8 => 2**31,
+);
+
# Test that what we get is the same as the database's idea of characters:
for my $name ("LATIN CAPITAL LETTER N",
"LATIN SMALL LETTER E WITH ACUTE",
@@ -135,6 +150,8 @@ for my $name ("LATIN CAPITAL LETTER N",
my $desc = sprintf "chr(?) for U+%04X $name,
\$enable_utf8=$enable_utf8", $ord;
skip "Pg < 8.3 has broken $desc", 1
if $ord > 127 && $dbh->{pg_server_version} < 80300;
+ skip "Cannot do $desc with server_encoding='$server_encoding'", 1
+ if $ord > ($ord_max{$server_encoding} || 127);
$dbh->{pg_enable_utf8} = $enable_utf8;
my $sth = $dbh->prepare('SELECT chr(?)');
$sth->execute($ord);
--
1.8.4
