[libtap-parser-sourcehandler-pgtap-perl] 05/09: Imported Upstream version 3.29
myon at debian.org
myon at debian.org
Tue Dec 22 22:18:33 UTC 2015
This is an automated email from the git hooks/post-receive script.
myon pushed a commit to branch master
in repository libtap-parser-sourcehandler-pgtap-perl.
commit e95a133a38160487f1f0e16f1d2675e09ecbea31
Author: Christoph Berg <myon at debian.org>
Date: Tue Dec 22 22:56:42 2015 +0100
Imported Upstream version 3.29
---
Changes | 12 +++
META.json | 8 +-
META.yml | 6 +-
README | 4 +-
bin/pg_prove | 18 ++--
bin/pg_tapgen | 165 ++++++++++++++++++++++++++++------
lib/TAP/Parser/SourceHandler/pgTAP.pm | 4 +-
7 files changed, 170 insertions(+), 47 deletions(-)
diff --git a/Changes b/Changes
index 3c73c7c..b53a5f9 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,17 @@
Revision history for Perl extension TAP::Parser::SourceHandler::pgTAP.
+3.29 2013-01-09T00:15:34Z
+ - Restored the `-t` alias for the the `--timer` option, thanks to Norman
+ Yamada.
+ - Fixed the documentation for the alias of `--color`, which is `-c`, not
+ `-t`.
+
+3.28 2012-05-07T22:01:02Z
+ - Simplified handling of `--runtests` in `pg_prove` to be a bit less
+ fragile. Based on a report from Giorgio Valoti.
+ - Added a bunch of table-testing functionality to `pg_tapgen`. It now
+ writes files for each table to a specified `--directory`.
+
3.27 2011-08-03T18:41:29
- Eliminated "Use of qw(...) as parentheses is deprecated" on Perl 5.14.
- Updated copyright dates.
diff --git a/META.json b/META.json
index 790a206..a5d4224 100644
--- a/META.json
+++ b/META.json
@@ -4,7 +4,7 @@
"David E. Wheeler <dwheeler at cpan.org>"
],
"dynamic_config" : 1,
- "generated_by" : "Module::Build version 0.38, CPAN::Meta::Converter version 2.110930001",
+ "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921",
"license" : [
"perl_5"
],
@@ -31,7 +31,7 @@
"Test::Pod::Coverage" : "1.06"
},
"requires" : {
- "TAP::Parser::SourceHandler" : 0,
+ "TAP::Parser::SourceHandler" : "0",
"perl" : "5.006"
}
}
@@ -39,7 +39,7 @@
"provides" : {
"TAP::Parser::SourceHandler::pgTAP" : {
"file" : "lib/TAP/Parser/SourceHandler/pgTAP.pm",
- "version" : "3.27"
+ "version" : "3.29"
}
},
"release_status" : "stable",
@@ -55,5 +55,5 @@
"url" : "http://github.com/theory/tap-parser-sourcehandler-pgtap/tree/"
}
},
- "version" : "3.27"
+ "version" : "3.29"
}
diff --git a/META.yml b/META.yml
index b507048..09a9537 100644
--- a/META.yml
+++ b/META.yml
@@ -8,7 +8,7 @@ build_requires:
configure_requires:
Module::Build: 0.30
dynamic_config: 1
-generated_by: 'Module::Build version 0.38, CPAN::Meta::Converter version 2.110930001'
+generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -17,7 +17,7 @@ name: TAP-Parser-SourceHandler-pgTAP
provides:
TAP::Parser::SourceHandler::pgTAP:
file: lib/TAP/Parser/SourceHandler/pgTAP.pm
- version: 3.27
+ version: 3.29
recommends:
Test::Pod: 1.41
Test::Pod::Coverage: 1.06
@@ -29,4 +29,4 @@ resources:
homepage: http://search.cpan.org/dist/Tap-Parser-Sourcehandler-pgTAP/
license: http://dev.perl.org/licenses/
repository: http://github.com/theory/tap-parser-sourcehandler-pgtap/tree/
-version: 3.27
+version: 3.29
diff --git a/README b/README
index cbbd8b2..50ae96f 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-TAP/Parser/SourceHandler/pgTAP version 3.27
+TAP/Parser/SourceHandler/pgTAP version 3.29
===========================================
This module adds support for executing [pgTAP](http://pgtap.org/) PostgreSQL
@@ -54,7 +54,7 @@ TAP::Parser::SourceHandler::pgTAP requires TAP::Parser::SourceHandler.
Copyright and Licence
---------------------
-Copyright (c) 2010-2011 David E. Wheeler. Some Rights Reserved.
+Copyright (c) 2010-2012 David E. Wheeler. Some Rights Reserved.
This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
diff --git a/bin/pg_prove b/bin/pg_prove
index 18e176d..e22c334 100755
--- a/bin/pg_prove
+++ b/bin/pg_prove
@@ -4,7 +4,7 @@ use strict;
use App::Prove;
use Getopt::Long;
-our $VERSION = '3.27';
+our $VERSION = '3.29';
$|++;
Getopt::Long::Configure(qw(no_ignore_case bundling pass_through));
@@ -22,6 +22,7 @@ Getopt::Long::GetOptions(
'runtests|R' => \$opts->{runtests},
'schema|s=s' => \$opts->{schema},
'match|x=s' => \$opts->{match},
+ 'timer|t!' => \$opts->{timer},
'version|V' => \$opts->{version},
'ext=s@' => \$opts->{ext},
'comments|o!' => \$opts->{comments},
@@ -49,6 +50,7 @@ if ($opts->{version}) {
}
my $prove_class = 'App::Prove';
+my $runtests_call;
# --schema and --match assume --runtests.
if ($opts->{runtests} || $opts->{schema} || $opts->{match}) {
@@ -62,7 +64,7 @@ if ($opts->{runtests} || $opts->{schema} || $opts->{match}) {
push @args, "'$arg'::" . ($key eq 'schema' ? 'name' : 'text');
}
- push @ARGV, 'runtests(' . join( ', ', @args ) . ');'
+ $runtests_call = 'runtests(' . join( ', ', @args ) . ');'
}
my $app = $prove_class->new;
@@ -71,6 +73,7 @@ $app->process_args(
(map { ('--ext' => $_) } @{ $opts->{ext} || ['.pg'] }),
qw(--source pgTAP),
($opts->{comments} ? ('--comments') : ()),
+ ($opts->{timer} ? ('--timer') : ()),
(map {
('--pgtap-option' => "$_=$opts->{$_}")
} grep {
@@ -91,10 +94,9 @@ PGPROVE: {
App::Prove::pgTAP;
use base 'App::Prove';
sub _get_tests {
- my $name = shift->argv->[-1];
return [
- "pgsql: SELECT * FROM $name",
- $name,
+ "pgsql: SELECT * FROM $runtests_call",
+ $runtests_call,
]
}
}
@@ -220,7 +222,7 @@ schema and I<ending> with “test,” run the tests like so:
--normalize Normalize TAP output in verbose output
-D --dry Dry run. Show test that would have run.
--merge Merge test scripts' C<STDERR> and C<STDOUT>.
- --timer Print elapsed time after each test.
+ -t --timer Print elapsed time after each test.
-c, --color Colored test output (default).
--nocolor Do not color test output.
--shuffle Run the tests in random order.
@@ -646,7 +648,7 @@ pgTAP tests, which only print to C<STDERR> when an exception is thrown.
Print elapsed time after each test file.
-=item C<-t>
+=item C<-c>
=item C<--color>
@@ -754,6 +756,6 @@ David E. Wheeler <dwheeler at cpan.org>
=head1 Copyright
-Copyright (c) 2008-2011 David E. Wheeler. Some Rights Reserved.
+Copyright (c) 2008-2012 David E. Wheeler. Some Rights Reserved.
=cut
diff --git a/bin/pg_tapgen b/bin/pg_tapgen
index 5823890..2a038f5 100755
--- a/bin/pg_tapgen
+++ b/bin/pg_tapgen
@@ -5,11 +5,12 @@ use warnings;
use DBI;
use DBD::Pg;
use Getopt::Long;
-our $VERSION = '3.27';
+use File::Spec;
+our $VERSION = '3.29';
Getopt::Long::Configure (qw(bundling));
-my $opts = { psql => 'psql', color => 1 };
+my $opts = { psql => 'psql', directory => '.' };
Getopt::Long::GetOptions(
'dbname|d=s' => \$opts->{dbname},
@@ -17,6 +18,7 @@ Getopt::Long::GetOptions(
'host|h=s' => \$opts->{host},
'port|p=s' => \$opts->{port},
'exclude-schema|N=s@' => \$opts->{exclude_schema},
+ 'directory|dir=s' => \$opts->{directory},
'verbose|v+' => \$opts->{verbose},
'help|H' => \$opts->{help},
'man|m' => \$opts->{man},
@@ -37,6 +39,25 @@ if ($opts->{version}) {
exit;
}
+# Function to write a test script.
+sub script(&;$) {
+ my ($code, $fn) = @_;
+ my $file = File::Spec->catfile($opts->{directory}, $fn);
+ open my $fh, '>:encoding(UTF-8)', $file or die "Cannot open $file: $!\n";
+ my $orig = select;
+ select $fh;
+ print "SET client_encoding = 'UTF-8';\n",
+ "SET client_min_messages = warning;\n",
+ "CREATE EXTENSION IF NOT EXISTS pgtap;\n",
+ "RESET client_min_messages;\n\n",
+ "BEGIN;\n",
+ "SELECT * FROM no_plan();\n\n";
+ $code->();
+ print "SELECT * FROM finish();\nROLLBACK;\n";
+ close $fh or die "Error closing $file: $!\n";
+ select $orig;
+}
+
my @conn;
for (qw(host port dbname)) {
push @conn, "$_=$opts->{$_}" if defined $opts->{$_};
@@ -45,23 +66,26 @@ my $dsn = 'dbi:Pg';
$dsn .= ':' . join ';', @conn if @conn;
my $dbh = DBI->connect($dsn, $opts->{username}, undef, {
- RaiseError => 1,
- PrintError => 0,
- AutoCommit => 1,
+ RaiseError => 1,
+ PrintError => 0,
+ AutoCommit => 1,
+ pg_enable_utf8 => 1,
});
+$dbh->do(q{SET client_encoding = 'UTF-8'});
-print "SELECT * FROM no_plan();\n\n";
-if (my @schemas = get_schemas($opts->{exclude_schema})) {
- schemas_are(\@schemas);
- for my $schema (@schemas) {
- tables_are($schema);
- views_are($schema);
- sequences_are($schema);
- functions_are($schema);
- }
-}
+##############################################################################
-print "SELECT * FROM finish();\n";
+script {
+ if (my @schemas = get_schemas($opts->{exclude_schema})) {
+ schemas_are(\@schemas);
+ for my $schema (@schemas) {
+ tables_are($schema);
+ views_are($schema);
+ sequences_are($schema);
+ functions_are($schema);
+ }
+ }
+} 'schema.sql';
##############################################################################
@@ -83,9 +107,9 @@ sub get_schemas {
sub schemas_are {
my $schemas = shift;
- print "SELECT schemas_are( ARRAY[\n '",
+ print "SELECT schemas_are(ARRAY[\n '",
join("',\n '", @$schemas),
- "'\n] );\n\n" if @$schemas;
+ "'\n]);\n\n" if @$schemas;
}
sub get_rels {
@@ -103,28 +127,32 @@ sub get_rels {
sub tables_are {
my $schema = shift;
my $tables = get_rels(r => $schema);
- return unless $tables && @$tables;
- print "SELECT tables_are( '$schema', ARRAY[\n '",
+ return unless $tables && @{ $tables };
+ print "SELECT tables_are('$schema', ARRAY[\n '",
join("',\n '", @$tables),
- "'\n] );\n\n";
+ "'\n]);\n\n";
+
+ for my $table (@{ $tables }) {
+ script { has_table($schema, $table) } "table_$schema.$table.sql";
+ }
}
sub views_are {
my $schema = shift;
my $tables = get_rels(v => $schema);
return unless $tables && @$tables;
- print "SELECT views_are( '$schema', ARRAY[\n '",
+ print "SELECT views_are('$schema', ARRAY[\n '",
join("',\n '", @$tables),
- "'\n] );\n\n";
+ "'\n]);\n\n";
}
sub sequences_are {
my $schema = shift;
my $tables = get_rels(S => $schema);
return unless $tables && @$tables;
- print "SELECT sequences_are( '$schema', ARRAY[\n '",
+ print "SELECT sequences_are('$schema', ARRAY[\n '",
join("',\n '", @$tables),
- "'\n] );\n\n";
+ "'\n]);\n\n";
}
sub functions_are {
@@ -137,9 +165,83 @@ sub functions_are {
});
my $funcs = $dbh->selectcol_arrayref($sth, undef, $schema);
return unless $funcs && @$funcs;
- print "SELECT functions_are( '$schema', ARRAY[\n '",
+ print "SELECT functions_are('$schema', ARRAY[\n '",
join("',\n '", @$funcs),
- "'\n] );\n\n";
+ "'\n]);\n\n";
+}
+
+sub has_table {
+ my ($schema, $table) = @_;
+ print "SELECT has_table(
+ '$schema', '$table',
+ 'Should have table $schema.$table'
+);\n\n";
+ has_pk($schema, $table);
+ columns_are($schema, $table);
+}
+
+sub has_pk {
+ my ($schema, $table) = @_;
+ my $fn = _hasc($schema, $table, 'p') ? 'has_pk' : 'hasnt_pk';
+ print "select $fn(
+ '$schema', '$table',
+ 'Table $schema.$table should have a primary key'
+);\n\n";
+}
+
+sub columns_are {
+ my ($schema, $table) = @_;
+ print "SET search_path = '$schema';\n";
+ my $cols = $dbh->selectall_arrayref(q{
+ SELECT a.attname AS name
+ , pg_catalog.format_type(a.atttypid, a.atttypmod) AS type
+ , a.attnotnull AS not_null
+ , a.atthasdef AS has_default
+ , pg_catalog.pg_get_expr(d.adbin, d.adrelid)
+ FROM pg_catalog.pg_namespace n
+ JOIN pg_catalog.pg_class c ON n.oid = c.relnamespace
+ JOIN pg_catalog.pg_attribute a ON c.oid = a.attrelid
+ LEFT JOIN pg_catalog.pg_attrdef d ON a.attrelid = d.adrelid AND a.attnum = d.adnum
+ WHERE n.nspname = ?
+ AND c.relname = ?
+ AND a.attnum > 0
+ AND NOT a.attisdropped
+ ORDER BY a.attnum
+ }, undef, $schema, $table);
+
+ return unless $cols && @{ $cols };
+ print "SELECT columns_are('$schema', '$table', ARRAY[\n '",
+ join("',\n '", map { $_->[0] } @{ $cols }),
+ "'\n]);\n\n";
+
+ for my $col (@{ $cols }) {
+ my $null_fn = $col->[2] ? 'col_not_null(' : 'col_is_null( ';
+ my $def_fn = $col->[3] ? 'col_has_default( ' : 'col_hasnt_default(';
+ print "SELECT has_column( '$table', '$col->[0]');\n",
+ "SELECT col_type_is( '$table', '$col->[0]', '$col->[1]');\n",
+ "SELECT $null_fn '$table', '$col->[0]');\n",
+ "SELECT $def_fn'$table', '$col->[0]');\n";
+ print "SELECT col_default_is( '$table', '$col->[0]', '$col->[4]');\n"
+ if $col->[3];
+ print $/;
+ }
+
+}
+
+sub _hasc {
+ my $sth = $dbh->prepare_cached(q{
+ SELECT EXISTS(
+ SELECT true
+ FROM pg_catalog.pg_namespace n
+ JOIN pg_catalog.pg_class c ON c.relnamespace = n.oid
+ JOIN pg_catalog.pg_constraint x ON c.oid = x.conrelid
+ WHERE c.relhaspkey = true
+ AND n.nspname = ?
+ AND c.relname = ?
+ AND x.contype = ?
+ )
+ });
+ return $dbh->selectcol_arrayref($sth, undef, @_)->[0];
}
__END__
@@ -174,6 +276,7 @@ distribution in the future.
-p --port PORT Port to which to connect.
-v --verbose Display output of test scripts while running them.
-N --exclude-schema Exclude a schema from the generated tests.
+ --directory DIRECTORY Directory to which to write the test files.
-H --help Print a usage statement and exit.
-m --man Print the complete documentation and exit.
-V --version Print the version number and exit.
@@ -227,6 +330,12 @@ the server is listening for connections. Defaults to the value of the
C<$PGPORT> environment variable or, if not set, to the port specified at
compile time, usually 5432.
+=item C<--dir>
+
+=item C<--directory>
+
+Directory to which to write test files. Defaults to the current directory.
+
=item C<-v>
=item C<--verbose>
@@ -287,6 +396,6 @@ David E. Wheeler <dwheeler at cpan.org>
=head1 Copyright
-Copyright (c) 2009-2011 David E. Wheeler. Some Rights Reserved.
+Copyright (c) 2009-2012 David E. Wheeler. Some Rights Reserved.
=cut
diff --git a/lib/TAP/Parser/SourceHandler/pgTAP.pm b/lib/TAP/Parser/SourceHandler/pgTAP.pm
index c59b864..a28005f 100644
--- a/lib/TAP/Parser/SourceHandler/pgTAP.pm
+++ b/lib/TAP/Parser/SourceHandler/pgTAP.pm
@@ -9,7 +9,7 @@ use TAP::Parser::Iterator::Process ();
@ISA = qw(TAP::Parser::SourceHandler);
TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
-our $VERSION = '3.27';
+our $VERSION = '3.29';
=head1 Name
@@ -394,7 +394,7 @@ David E. Wheeler <dwheeler at cpan.org>
=head1 Copyright and License
-Copyright (c) 2010-2011 David E. Wheeler. Some Rights Reserved.
+Copyright (c) 2010-2012 David E. Wheeler. Some Rights Reserved.
This module is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libtap-parser-sourcehandler-pgtap-perl.git
More information about the Pkg-perl-cvs-commits
mailing list