[DBD::Pg 1/4] Minor test tweaks and Perl::Critic inspired changes.
[email protected] Tue, 6 Jan 2015 16:56:19 +0000
| Newsgroups | perl.dbd.pg.changes |
|---|---|
| Message-ID | <[email protected]> |
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