[DBD::Pg 3/3] Skip tests for characters not supported by the server_encoding

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