Committed by Greg Sabino Mullane <[email protected]>
Subject: [DBD::Pg 1/4] Minor test tweaks and Perl::Critic inspired changes.
---
Pg.pm | 8 ++++----
t/02attribs.t | 2 +-
t/03dbmethod.t | 15 ++++++++-------
t/12placeholders.t | 12 ++++++------
t/30unicode.t | 24 ++++++++++++------------
t/99_spellcheck.t | 2 +-
t/99cleanup.t | 2 +-
7 files changed, 33 insertions(+), 32 deletions(-)
diff --git a/Pg.pm b/Pg.pm
index d6e0f39..bfe9dbd 100644
--- a/Pg.pm
+++ b/Pg.pm
@@ -626,7 +626,7 @@ use 5.008001;
i.indisunique desc, a.amname, c.relname
};
- my $indexdef_sql = qq{
+ my $indexdef_sql = q{
SELECT
pg_get_indexdef(indexrelid,x,true)
FROM
@@ -961,7 +961,7 @@ use 5.008001;
JOIN pg_catalog.pg_class idx ON (
idx.oid = dep.refobjid AND
idx.relkind='i'
)
- LEFT JOIN pg_catalog.pg_depend dep2 ON (
+ LEFT JOIN pg_catalog.pg_depend dep2 ON (
dep2.classid =
'pg_catalog.pg_class'::regclass
AND dep2.objid = idx.oid
AND dep2.objsubid = 0
@@ -1139,7 +1139,7 @@ use 5.008001;
my $type_restrict = join ', ' =>
map { /^'/ ? $_ : $dbh->quote($_) }
grep {length}
- split(',', $type);
+ split(',', $type); ## no critic
$tbl_sql = qq{SELECT * FROM ($tbl_sql) ti WHERE "TABLE_TYPE"
IN ($type_restrict)};
}
}
@@ -1330,7 +1330,7 @@ use 5.008001;
10021 => ['SQL_ASYNC_MODE', 2
], ## SQL_AM_STATEMENT
120 => ['SQL_BATCH_ROW_COUNT', 2
], ## SQL_BRC_EXPLICIT
121 => ['SQL_BATCH_SUPPORT', 3
], ## 12 SELECT_PROC + ROW_COUNT_PROC
- 2 => ['SQL_DATA_SOURCE_NAME', sub { sprintf "dbi:Pg:%",
shift->{Name} } ],
+ 2 => ['SQL_DATA_SOURCE_NAME', sub { sprintf 'dbi:Pg:%',
shift->{Name} } ],
3 => ['SQL_DRIVER_HDBC', 0
], ## not applicable
135 => ['SQL_DRIVER_HDESC', 0
], ## not applicable
4 => ['SQL_DRIVER_HENV', 0
], ## not applicable
diff --git a/t/02attribs.t b/t/02attribs.t
index 9c90b15..0ac694d 100644
--- a/t/02attribs.t
+++ b/t/02attribs.t
@@ -1108,7 +1108,7 @@ is_deeply ($attrib, [], $t);
$t='Statement handle attribute "ChildHandles" is an empty list on creation';
{
- my $sth4 = $dbh4->prepare('SELECT 1');
+ $sth4 = $dbh4->prepare('SELECT 1');
$attrib = $sth4->{ChildHandles};
is_deeply ($attrib, [], $t);
diff --git a/t/03dbmethod.t b/t/03dbmethod.t
index 9351869..6103d98 100644
--- a/t/03dbmethod.t
+++ b/t/03dbmethod.t
@@ -503,7 +503,7 @@ $number = $sth->rows();
ok ($number, $t);
$t=q{DB handle method "table_info" works when called with a 'TABLE' last
argument};
-$sth = $dbh->table_info( '', '', '', "'TABLE'");
+$sth = $dbh->table_info( '', '', '', q{'TABLE'});
# Check required minimum fields
$t='DB handle method "table_info" returns fields required by DBI';
@@ -607,7 +607,7 @@ my %surprises = map { $_->[0] => 1 }
@{ $sth->fetchall_arrayref([3]) };
is_deeply([keys %surprises], [], $t)
- or diag("Objects of unexpected type(s) found: "
+ or diag('Objects of unexpected type(s) found: '
. join(', ', sort keys %surprises));
} # END test listing table types
@@ -1946,7 +1946,7 @@ for my $type (qw/ ping pg_ping /) {
$val = $type eq 'ping' ? 0 : -3;
$t=qq{DB handle method "$type" returns $val after a lost network
connection (inside transaction)};
$dbh = connect_database({nosetup => 1});
- $dbh->do("SELECT 'DBD::Pg testing'");
+ $dbh->do(q{SELECT 'DBD::Pg testing'});
socket_fail($dbh);
is ($dbh->$type(), $val, $t);
@@ -1956,10 +1956,11 @@ for my $type (qw/ ping pg_ping /) {
exit;
sub socket_fail {
- my $dbh = shift;
- $dbh->{InactiveDestroy} = 1;
- my $fd = $dbh->{pg_socket} or die "Could not determine socket";
- open(DBH_PG_FH, "<&=".$fd) or die "Could not open socket: $!";
+ my $ldbh = shift;
+ $ldbh->{InactiveDestroy} = 1;
+ my $fd = $ldbh->{pg_socket} or die 'Could not determine socket';
+ open(DBH_PG_FH, '<&='.$fd) or die "Could not open socket: $!"; ## no
critic
close DBH_PG_FH or die "Could not close socket: $!";
+ return;
}
diff --git a/t/12placeholders.t b/t/12placeholders.t
index 254903d..ea4d9a6 100644
--- a/t/12placeholders.t
+++ b/t/12placeholders.t
@@ -408,7 +408,7 @@ for my $line (split /\n\n+/ => $testdata) {
$dbh->do('DELETE FROM dbd_pg_test_geom');
eval { $qresult = $dbh->quote($input, {pg_type => $typemap{$type}}); };
if ($@) {
- if ($quoted !~ /ERROR: (.+)/) {
+ if ($quoted !~ /ERROR: .+/) {
fail ("$t error: $@");
}
else {
@@ -422,7 +422,7 @@ for my $line (split /\n\n+/ => $testdata) {
eval { $dbh->do("EXECUTE geotest('$input')"); };
if ($@) {
- if ($rows !~ /ERROR: (.+)/) {
+ if ($rows !~ /ERROR: .+/) {
fail ("$t error: $@");
}
else {
@@ -434,7 +434,7 @@ for my $line (split /\n\n+/ => $testdata) {
eval { $sth->execute($input); };
if ($@) {
- if ($rows !~ /ERROR: (.+)/) {
+ if ($rows !~ /ERROR: .+/) {
fail ($t);
}
else {
@@ -850,7 +850,7 @@ $dbh->commit();
$dbh->do('create operator ?? (leftarg=text,rightarg=text,procedure=texteq)');
$dbh->commit();
-$SQL = qq{SELECT count(*) FROM dbd_pg_test WHERE id \\? ?};
+$SQL = qq{SELECT count(*) FROM dbd_pg_test WHERE id \\? ?}; ## no critic
$sth = $dbh->prepare($SQL);
eval {
$count = $sth->execute(123);
@@ -859,7 +859,7 @@ is($@, '', $t);
$sth->finish();
$t = q{Basic placeholder escaping works via backslash-question mark for \?\?};
-$SQL = qq{SELECT count(*) FROM dbd_pg_test WHERE pname \\?\\? ?};
+$SQL = qq{SELECT count(*) FROM dbd_pg_test WHERE pname \\?\\? ?}; ## no critic
$sth = $dbh->prepare($SQL);
eval {
$count = $sth->execute('foobar');
@@ -870,7 +870,7 @@ $sth->finish();
## This is an emergency hatch only. Hopefully will never be used in the wild!
$dbh->{pg_placeholder_escaped} = 0;
$t = q{Basic placeholder escaping fails when pg_placeholder_escaped is set to
false};
-$SQL = qq{SELECT count(*) FROM dbd_pg_test WHERE pname \\?\\? ?};
+$SQL = qq{SELECT count(*) FROM dbd_pg_test WHERE pname \\?\\? ?}; ## no critic
$sth = $dbh->prepare($SQL);
eval {
$count = $sth->execute('foobar');
diff --git a/t/30unicode.t b/t/30unicode.t
index e7ed168..aa993b6 100644
--- a/t/30unicode.t
+++ b/t/30unicode.t
@@ -89,13 +89,13 @@ foreach (@tests) {
):()),
) {
skip "Can't do $range tests with server_encoding='$server_encoding'", 1
- unless $range =~ ($ranges{$server_encoding} || qr/\A(?:ascii)\z/);
+ if $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} || []};
my $want = exists $test->{want} ? $test->{want} : $value;
if (!$enable_utf8) {
- $want = ref $want ? [ map encode_utf8($_), @{$want} ]
+ $want = ref $want ? [ map encode_utf8($_), @{$want} ] ## no
critic
: encode_utf8($want);
}
@@ -113,7 +113,7 @@ foreach (@tests) {
my $result = $sth->fetchall_arrayref->[0][0];
is_deeply ($result, $want,
"$desc returns proper value");
- unless ($test->{qtype} =~ /length$/) {
+ if ($test->{qtype} !~ /length$/) {
# Whilst XS code can set SVf_UTF8 on an IV, the core's SV
# copying code doesn't copy it. So we can't assume that numeric
# values we see "out here" still have it set. Hence skip this
@@ -131,18 +131,18 @@ my %ord_max = (
);
# 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",
- "CURRENCY SIGN",
+for my $name ('LATIN CAPITAL LETTER N',
+ 'LATIN SMALL LETTER E WITH ACUTE',
+ 'CURRENCY SIGN',
# Has a different code point in Unicode, Windows 1252 and
ISO-8859-15
- "EURO SIGN",
- "POUND SIGN",
- "YEN SIGN",
+ 'EURO SIGN',
+ 'POUND SIGN',
+ 'YEN SIGN',
# Has a different code point in Unicode and Windows 1252
- "LATIN CAPITAL LETTER S WITH CARON",
- "SNOWMAN",
+ 'LATIN CAPITAL LETTER S WITH CARON',
+ 'SNOWMAN',
# U+1D196 should be 1 character, not a surrogate pair
- "MUSICAL SYMBOL TR",
+ 'MUSICAL SYMBOL TR',
) {
my $ord = charnames::vianame($name);
SKIP:
diff --git a/t/99_spellcheck.t b/t/99_spellcheck.t
index e1b86cb..35a3250 100644
--- a/t/99_spellcheck.t
+++ b/t/99_spellcheck.t
@@ -68,7 +68,7 @@ for my $file (qw/README Changes TODO README.dev
README.win32/) {
close $fh or warn qq{Could not close "$file": $!\n};
if ($file eq 'Changes') {
s{\b(?:from|by) [A-Z][\w \.]+[<\[\n]}{}gs;
- s{\b[Tt]hanks to ([A-Z]\w+\W){1,3}}{}gs;
+ s{\b[Tt]hanks to (?:[A-Z]\w+\W){1,3}}{}gs;
s{Abhijit Menon-Sen}{}gs;
s{eg/lotest.pl}{};
s{\[.+?\]}{}gs;
diff --git a/t/99cleanup.t b/t/99cleanup.t
index 549c42e..61dac20 100644
--- a/t/99cleanup.t
+++ b/t/99cleanup.t
@@ -11,7 +11,7 @@ use Test::More tests => 1;
use lib 't','.';
if ($ENV{DBDPG_NOCLEANUP}) {
- ok (q{No cleaning up because ENV 'DBDPG_NOCLEANUP' is set});
+ pass (q{No cleaning up because ENV 'DBDPG_NOCLEANUP' is set});
exit;
}
--
1.8.4
