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 <m...@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 <dwhee...@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 <dwhee...@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 <dwhee...@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 <dwhee...@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 _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits