[libtap-parser-sourcehandler-pgtap-perl] 01/09: Imported Upstream version 3.25
myon at debian.org
myon at debian.org
Tue Dec 22 22:18:32 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 ec5efb31db2acc6b8de887af31fc3c5f1ad4352a
Author: Christoph Berg <myon at debian.org>
Date: Tue Dec 22 22:56:41 2015 +0100
Imported Upstream version 3.25
---
Build.PL | 54 +++
Changes | 28 ++
MANIFEST | 13 +
META.yml | 31 ++
README | 60 +++
bin/pg_prove | 760 ++++++++++++++++++++++++++++++++++
bin/pg_tapgen | 292 +++++++++++++
lib/TAP/Parser/SourceHandler/pgTAP.pm | 402 ++++++++++++++++++
t/bin/psql | 3 +
t/pod-coverage.t | 10 +
t/pod.t | 7 +
t/source.pg | 6 +
t/source_handler.t | 190 +++++++++
13 files changed, 1856 insertions(+)
diff --git a/Build.PL b/Build.PL
new file mode 100644
index 0000000..3d0a0f1
--- /dev/null
+++ b/Build.PL
@@ -0,0 +1,54 @@
+use strict;
+use warnings;
+use Module::Build;
+
+my $class = Module::Build->subclass(
+ class => 'My::Builder',
+ code => q{
+ sub ACTION_code {
+ use File::Spec::Functions;
+ my $self = shift;
+ $self->SUPER::ACTION_code(@_);
+ # Copy the test scripts and then set the shebang line and make
+ # sure that they're executable.
+ my $to_dir = $self->localize_file_path("t/scripts");
+ my $from = $self->localize_file_path("t/bin/psql");
+ my $to = $self->localize_file_path("$to_dir/psql");
+ $self->copy_if_modified(
+ from => $from,
+ to_dir => $to_dir,
+ flatten => 1,
+ );
+ $self->fix_shebang_line($to);
+ $self->make_executable($to);
+ $self->add_to_cleanup($to_dir);
+ }
+ },
+);
+
+$class->new(
+ module_name => 'TAP::Parser::SourceHandler::pgTAP',
+ license => 'perl',
+ configure_requires => {
+ 'Module::Build' => '0.30',
+ },
+ build_requires => {
+ 'Module::Build' => '0.30',
+ 'Test::More' => '0.88',
+ },
+ requires => {
+ 'TAP::Parser::SourceHandler' => 0,
+ 'perl' => 5.006000,
+ },
+ recommends => {
+ 'Test::Pod' => '1.41',
+ 'Test::Pod::Coverage' => '1.06',
+ },
+ meta_merge => {
+ resources => {
+ homepage => 'http://search.cpan.org/dist/Tap-Parser-Sourcehandler-pgTAP/',
+ bugtracker => 'http://github.com/theory/tap-parser-sourcehandler-pgtap/issues/',
+ repository => 'http://github.com/theory/tap-parser-sourcehandler-pgtap/tree/',
+ }
+ },
+)->create_build_script;
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..64884a5
--- /dev/null
+++ b/Changes
@@ -0,0 +1,28 @@
+Revision history for Perl extension TAP::Parser::SourceHandler::pgTAP.
+
+3.25 2011-02-08T17:42:21
+ - Fixed shebang line in `pg_prove` so that it will be properly rewritten
+ upon installation.
+ - The `-S/--set` option added in 3.24 is now properly passed to `psql`.
+ Norman Yamada.
+
+3.24 2011-01-13T22:26:47
+ - Added -S/--set option to pg_prove to allow the setting of psql
+ variables. Patch by Norman Yamada.
+
+3.23 2010-09-08T22:32:05
+ - Disable --failures by default.
+ - Enable --comments by default. This is so that failure diagnostics will
+ appear even when not in verbose mode. This is how the `pg_prove`
+ distributed with pgTAP works. Use --no-comments or --quiet to disable
+ them.
+
+3.22 2010-08-15T01:06:08
+ - Moved from the Test::Harness distribution to its own distribution.
+ - No assume that a test string starting with "pgtap:" and is not a file
+ name is SQL to be executed.
+ - Moved `pg_prove` from the pgTAP distribution and rewrote it to use
+ App::Prove and pgTAP.
+ - Rewrote `pg_prove` to use App::Prove, thus gaining most of its
+ features.
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..880685d
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,13 @@
+bin/pg_prove
+bin/pg_tapgen
+Build.PL
+Changes
+lib/TAP/Parser/SourceHandler/pgTAP.pm
+MANIFEST This list of files
+README
+t/bin/psql
+t/pod-coverage.t
+t/pod.t
+t/source.pg
+t/source_handler.t
+META.yml
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..1296a61
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,31 @@
+---
+abstract: 'Stream TAP from pgTAP test scripts'
+author:
+ - 'David E. Wheeler <dwheeler at cpan.org>'
+build_requires:
+ Module::Build: 0.30
+ Test::More: 0.88
+configure_requires:
+ Module::Build: 0.30
+generated_by: 'Module::Build version 0.3624'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: TAP-Parser-SourceHandler-pgTAP
+provides:
+ TAP::Parser::SourceHandler::pgTAP:
+ file: lib/TAP/Parser/SourceHandler/pgTAP.pm
+ version: 3.25
+recommends:
+ Test::Pod: 1.41
+ Test::Pod::Coverage: 1.06
+requires:
+ TAP::Parser::SourceHandler: 0
+ perl: 5.006
+resources:
+ bugtracker: http://github.com/theory/tap-parser-sourcehandler-pgtap/issues/
+ 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.25
diff --git a/README b/README
new file mode 100644
index 0000000..9efeaaf
--- /dev/null
+++ b/README
@@ -0,0 +1,60 @@
+TAP/Parser/SourceHandler/pgTAP version 3.25
+===========================================
+
+This module adds support for executing [pgTAP](http://pgtap.org/) PostgreSQL
+tests under Test::Harness and C<prove>. This is useful for executing your Perl
+tests and your PostgreSQL tests together, and analysing their results.
+
+Most likely. you'll want to use it with C<prove> to execute your Perl and
+pgTAP tests:
+
+ prove --source Perl \
+ --ext .t --ext .pg \
+ --source pgTAP --pgtap-option dbname=try \
+ --pgtap-option username=postgres \
+ --pgtap-option suffix=.pg
+
+Or in F<Build.PL> for your application with pgTAP tests in F<t/*.pg>:
+
+ Module::Build->new(
+ module_name => 'MyApp',
+ test_file_exts => [qw(.t .pg)],
+ use_tap_harness => 1,
+ tap_harness_args => {
+ sources => {
+ Perl => undef,
+ pgTAP => {
+ dbname => 'try',
+ username => 'root',
+ suffix => '.pg',
+ },
+ }
+ },
+ build_requires => {
+ 'Module::Build' => '0.30',
+ 'TAP::Parser::SourceHandler::pgTAP' => '3.18',
+ },
+ )->create_build_script;
+
+Installation
+------------
+
+To install this module, type the following:
+
+ perl Build.PL
+ ./Build
+ ./Build test
+ ./Build install
+
+Dependencies
+------------
+
+TAP::Parser::SourceHandler::pgTAP requires TAP::Parser::SourceHandler.
+
+Copyright and Licence
+---------------------
+
+Copyright (c) 2010 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
new file mode 100755
index 0000000..59b4896
--- /dev/null
+++ b/bin/pg_prove
@@ -0,0 +1,760 @@
+#!/usr/bin/perl -w
+
+use strict;
+use App::Prove;
+use Getopt::Long;
+
+our $VERSION = '3.25';
+$|++;
+
+Getopt::Long::Configure(qw(no_ignore_case bundling pass_through));
+
+my $opts = { color => 1, comments => 1 };
+
+Getopt::Long::GetOptions(
+ 'psql-bin|b=s' => \$opts->{psql},
+ 'dbname|d=s' => \$opts->{dbname},
+ 'username|U=s' => \$opts->{username},
+ 'host|h=s' => \$opts->{host},
+ 'port|p=s' => \$opts->{port},
+ 'pset|P=s%' => \$opts->{pset},
+ 'set|S=s%' => \$opts->{set},
+ 'runtests|R' => \$opts->{runtests},
+ 'schema|s=s' => \$opts->{schema},
+ 'match|x=s' => \$opts->{match},
+ 'version|V' => \$opts->{version},
+ 'ext=s@' => \$opts->{ext},
+ 'comments|o!' => \$opts->{comments},
+ 'help|H|?' => \$opts->{help},
+ 'man|m' => \$opts->{man},
+) or require Pod::Usage && Pod::Usage::pod2usage(2);
+
+if ($opts->{version}) {
+ print 'pg_prove ', main->VERSION, $/;
+ exit;
+}
+
+if ( $opts->{help} or $opts->{man} ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage(
+ '-sections' => $opts->{man} ? '.+' : '(?i:(Usage|Options))',
+ '-verbose' => 99,
+ '-exitval' => 0,
+ )
+}
+
+if ($opts->{version}) {
+ print 'pg_prove ', main->VERSION, $/;
+ exit;
+}
+
+my $prove_class = 'App::Prove';
+
+# --schema and --match assume --runtests.
+if ($opts->{runtests} || $opts->{schema} || $opts->{match}) {
+ # We're just going to call `runtests()`.
+ $prove_class .= '::pgTAP';
+ my @args;
+ for my $key qw(schema match) {
+ next unless $opts->{$key};
+ (my $arg = $opts->{$key}) =~ s/'/\\'/g;
+ # Gotta cast the arguments.
+ push @args, "'$arg'::" . ($key eq 'schema' ? 'name' : 'text');
+ }
+
+ push @ARGV, 'runtests(' . join( ', ', @args ) . ');'
+}
+
+my $app = $prove_class->new;
+$app->process_args(
+ @ARGV,
+ (map { ('--ext' => $_) } @{ $opts->{ext} || ['.pg'] }),
+ qw(--source pgTAP),
+ ($opts->{comments} ? ('--comments') : ()),
+ (map {
+ ('--pgtap-option' => "$_=$opts->{$_}")
+ } grep {
+ $opts->{$_}
+ } qw(psql dbname username host port)),
+ (map {
+ ('--pgtap-option' => "pset=$_=$opts->{pset}{$_}")
+ } keys %{ $opts->{pset} }),
+ (map {
+ ('--pgtap-option' => "set=$_=$opts->{set}{$_}")
+ } keys %{ $opts->{set} })
+);
+
+exit $app->run ? 0 : 1;
+
+
+PGPROVE: {
+ package # Hide from indexer.
+ App::Prove::pgTAP;
+ use base 'App::Prove';
+ sub _get_tests {
+ my $name = shift->argv->[-1];
+ return [
+ "pgsql: SELECT * FROM $name",
+ $name,
+ ]
+ }
+}
+
+__END__
+
+=encoding utf8
+
+=head1 Name
+
+pg_prove - A command-line tool for running and harnessing pgTAP tests
+
+=head1 Usage
+
+ pg_prove tests/
+ pg_prove --dbname template1 test*.sql
+ pg_prove -d testdb --runtests
+
+=head1 Description
+
+C<pg_prove> is a command-line application to run one or more
+L<pgTAP|http://pgtap.org/> tests in a PostgreSQL database. The output of the
+tests is harvested and processed by L<TAP::Harness|TAP::Harness> in order to
+summarize the results of the test.
+
+Tests can be written and run in one of two ways, as SQL scripts or as
+xUnit-style database functions.
+
+=head2 Test Scripts
+
+pgTAP test scripts should consist of a series of SQL statements that output
+TAP. Here’s a simple example that assumes that the pgTAP functions have been
+installed in the database:
+
+ -- Start transaction and plan the tests.
+ BEGIN;
+ SELECT plan(1);
+
+ -- Run the tests.
+ SELECT pass( 'My test passed, w00t!' );
+
+ -- Finish the tests and clean up.
+ SELECT * FROM finish();
+ ROLLBACK;
+
+Now run the tests by passing the list of SQL script names or the name of a
+test directory to C<pg_prove>. Here’s what it looks like when the pgTAP tests
+are run with C<pg_prove>
+
+ % pg_prove -U postgres tests/
+ tests/coltap.....ok
+ tests/hastap.....ok
+ tests/moretap....ok
+ tests/pg73.......ok
+ tests/pktap......ok
+ All tests successful.
+ Files=5, Tests=216, 1 wallclock secs ( 0.06 usr 0.02 sys + 0.08 cusr 0.07 csys = 0.23 CPU)
+ Result: PASS
+
+=head2 xUnit Test Functions
+
+pgTAP test functions should return a set of text, and then simply return the
+values returned by pgTAP functions, like so:
+
+ CREATE OR REPLACE FUNCTION setup_insert(
+ ) RETURNS SETOF TEXT AS $$
+ RETURN NEXT is( MAX(nick), NULL, 'Should have no users') FROM users;
+ INSERT INTO users (nick) VALUES ('theory');
+ $$ LANGUAGE plpgsql;
+
+ Create OR REPLACE FUNCTION test_user(
+ ) RETURNS SETOF TEXT AS $$
+ SELECT is( nick, 'theory', 'Should have nick') FROM users;
+ END;
+ $$ LANGUAGE sql;
+
+Once you have these functions defined in your database, you can run them with
+C<pg_prove> by using the C<--runtests> option.
+
+ % pg_prove --dbname mydb --runtests
+ runtests()....ok
+ All tests successful.
+ Files=1, Tests=32, 0 wallclock secs ( 0.02 usr 0.01 sys + 0.01 cusr 0.00 csys = 0.04 CPU)
+ Result: PASS
+
+Be sure to pass the C<--schema> option if your test functions are all in one
+schema, and the C<--match> option if they have names that don’t start with
+“test”. For example, if you have all of your test functions in the “test”
+schema and I<ending> with “test,” run the tests like so:
+
+ pg_prove --dbname mydb --schema test --match 'test$'
+
+=head1 Options
+
+ -b --psql-bin PSQL Location of the C<psql> client.
+ -d, --dbname DBNAME Database to which to connect.
+ -U, --username USERNAME User with which to connect.
+ -h, --host HOST Host to which to connect.
+ -p, --port PORT Port to which to connect.
+ -P, --pset OPTION=VALUE Set psql key/value printing option.
+ -S, --set VAR=VALUE Set variables for psql session.
+ -R --runtests Run xUnit test using C<runtests()>.
+ -s, --schema SCHEMA Schema in which to find xUnit tests.
+ -x, --match REGEX Regular expression to find xUnit tests.
+
+ --ext Set the extension for tests (default F<.pg>)
+ -r, --recurse Recursively descend into directories.
+ --ignore-exit Ignore exit status from test scripts.
+ --trap Trap C<Ctrl-C> and print summary on interrupt.
+ --harness Define test harness to use.
+ -j, --jobs N Run N test jobs in parallel (try 9.)
+ --rc RCFILE Process options from rcfile
+ --norc Don't process default F<.proverc>
+ --state OPTION=VALUE Set persistent state options.
+
+ -v, --verbose Print all test lines.
+ -f, --failures Show failed tests.
+ -o, --comments Show comments and diagnostics.
+ --directives Only show results with TODO or SKIP directives.
+ -q, --quiet Suppress some test output while running tests.
+ -Q, --QUIET Only print summary results.
+ --parse Show full list of TAP parse errors, if any.
+ --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.
+ -c, --color Colored test output (default).
+ --nocolor Do not color test output.
+ --shuffle Run the tests in random order.
+ --reverse Run the tests in reverse order.
+ -a, --archive FILENAME Store the resulting TAP in an archive file.
+ --formatter Result formatter to use.
+ --count Show X/Y test count when not verbose (default)
+ --nocount Disable the X/Y test count.
+
+ -H, --help Print a usage statement and exit.
+ -?, Print a usage statement and exit.
+ -m, --man Print the complete documentation and exit.
+ -V, --version Print the version number and exit.
+
+=head1 Options Details
+
+=head2 Database Options
+
+=over
+
+=item C<-b>
+
+=item C<--psql-bin>
+
+ pg_prove --psql-bin /usr/local/pgsql/bin/psql
+ pg_prove -b /usr/local/bin/psql
+
+Path to the C<psql> program, which will be used to actually run the tests.
+Defaults to F<psql>, which should work well, when it is in your path.
+
+=item C<-d>
+
+=item C<--dbname>
+
+ pg_prove --dbname try
+ pg_prove -d postgres
+
+The name of database to which to connect. Defaults to the value of the
+C<$PGDATABASE> environment variable or to the system username.
+
+=item C<-U>
+
+=item C<--username>
+
+ pg_prove --username foo
+ pg_prove -U postgres
+
+PostgreSQL user name to connect as. Defaults to the value of the C<$PGUSER>
+environment variable or to the operating system name of the user running the
+application.
+
+=item C<-h>
+
+=item C<--host>
+
+ pg_prove --host pg.example.com
+ pg_prove -h dev.local
+
+Specifies the host name of the machine on which the server is running. If the
+value begins with a slash, it is used as the directory for the Unix-domain
+socket. Defaults to the value of the C<$PGHOST> environment variable or
+localhost.
+
+=item C<-p>
+
+=item C<--port>
+
+ pg_prove --port 1234
+ pg_prove -p 666
+
+Specifies the TCP port or the local Unix-domain socket file extension on which
+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<-P>
+
+=item C<--pset>
+
+ pg_prove --pset tuples_only=0
+ pg_prove -P null=[NULL]
+
+Specifies printing options in the style of C<\pset> in the C<psql> program.
+See L<http://www.postgresql.org/docs/current/static/app-psql.html> for details
+on the supported options.
+
+=item C<-S>
+
+=item C<--set>
+
+ pg_prove --set MY_CONTRACT=321
+ pg_prove -S TEST_SEARCH_PATH=test,public
+
+Sets local variables for psql in the style of C<\set> in the C<psql> program.
+See L<http://www.postgresql.org/docs/current/static/app-psql.html> for details
+on the supported options.
+
+=item C<--runtests>
+
+ pg_prove --runtests
+ pg_prove -r
+
+Don’t run any test scripts, but just use the C<runtests()> pgTAP function to
+run xUnit tests. This ends up looking like a single test script has been run,
+when in fact no test scripts have been run. Instead, C<pg_prove> tells C<psql>
+to run something like:
+
+ psql --command 'SELECT * FROM runtests()'
+
+You should use this option when you've written your tests in xUnit style,
+where they’re all defined in test functions already loaded in the database.
+
+=item C<-s>
+
+=item C<--schema>
+
+ pg_prove --schema test
+ pg_prove -s mytest
+
+Used with C<--runtests>, and, in fact, implicitly forces C<--runtests> to be
+true. This option can be used to specify the name of a schema in which to find
+xUnit functions to run. Basically, it tells C<psql> to run something like:
+
+ psql --command "SELECT * FROM runtests('test'::name)"
+
+=item C<-x>
+
+=item C<--match>
+
+ pg_prove --match 'test$'
+ pg_prove -x _test_
+
+Used with C<--runtests>, and, in fact, implicitly forces C<--runtests> to be
+true. This option can be used to specify a POSIX regular expression that will
+be used to search for xUnit functions to run. Basically, it tells C<psql> to
+run something like:
+
+ psql --command "SELECT * FROM runtests('_test_'::text)"
+
+This will run any visible functions with the string “_test_” in their names.
+This can be especially useful if you just want to run a single test in a
+given schema. For example, this:
+
+ pg_prove --schema testing --match '^test_widgets$'
+
+Will have C<psql> execute the C<runtests()> function like so:
+
+ SELECT * FROM runtests('testing'::name, '^test_widgets$'::text);
+
+=back
+
+=head2 Behavioral Options
+
+=over
+
+=item C<--ext>
+
+ pg_prove --ext .sql tests/
+
+Set the extension for test files (default F<.pg>). May be specified multiple
+times if you have test scripts with multiple extensions:
+
+ pg_prove --ext .sql --ext .pg --ext .pgt
+
+=item C<-r>
+
+=item C<--recurse>
+
+ pg_prove --recurse tests/
+ pg_prove --recurse sql/
+
+Recursively descend into directories when searching for tests. Not relevant
+with C<--runtests>.
+
+=item C<--ignore-exit>
+
+ pg_prove --ignore-exit
+
+Ignore exit status from test scripts. Normally if a script triggers a database
+exception, C<psql> will exit with an error code and, even if all tests passed,
+the test will be considered a failure. Use C<--ignore-exit> to ignore such
+situations (at your own peril).
+
+=item C<--trap>
+
+ pg_prove --trap
+
+Trap C<Ctrl-C> and print a summary on interrupt.
+
+=item C<--harness>
+
+ pg_prove --harness TAP::Harness::Color
+
+Specify a subclass of L<TAP::Harness> to use for the test harness. Defaults to
+TAP::Harness (unless C<--archive> is specified, in which case it uses
+L<TAP::Harness::Archive>).
+
+=item C<-j>
+
+=item C<-jobs>
+
+Run N test jobs in parallel (try 9.)
+
+=item C<--rc>
+
+ pg_prove --rc pg_prove.rc
+
+Process options from the specified configuration file.
+
+If C<--rc> is not specified and F<./.proverc> or F<~/.proverc> exist, they
+will be read and any options they contain processed before the command line
+options. Options in configuration files are specified in the same way as
+command line options:
+
+ # .proverc
+ --state=hot,fast,save
+ -j9
+
+Under Windows and VMS the option file is named F<_proverc> rather than
+F<.proverc> and is sought only in the current directory.
+
+=item C<--norc>
+
+Do not process F<./.proverc> or F<~/.proverc>.
+
+=item C<--state>
+
+You can ask C<pg_prove> to remember the state of previous test runs and select
+and/or order the tests to be run based on that saved state.
+
+The C<--state> switch requires an argument which must be a comma separated
+list of one or more of the following options.
+
+=over
+
+=item C<last>
+
+Run the same tests as the last time the state was saved. This makes it
+possible, for example, to recreate the ordering of a shuffled test.
+
+ # Run all tests in random order
+ pg_prove --state save --shuffle
+
+ # Run them again in the same order
+ pg_prove --state last
+
+=item C<failed>
+
+Run only the tests that failed on the last run.
+
+ # Run all tests
+ pg_prove --state save
+
+ # Run failures
+ pg_prove --state failed
+
+If you also specify the C<save> option newly passing tests will be
+excluded from subsequent runs.
+
+ # Repeat until no more failures
+ pg_prove --state failed,save
+
+=item C<passed>
+
+Run only the passed tests from last time. Useful to make sure that no new
+problems have been introduced.
+
+=item C<all>
+
+Run all tests in normal order. Multiple options may be specified, so to run
+all tests with the failures from last time first:
+
+ pg_prove --state failed,all,save
+
+=item C<hot>
+
+Run the tests that most recently failed first. The last failure time of each
+test is stored. The C<hot> option causes tests to be run in most-recent-
+failure order.
+
+ pg_prove --state hot,save
+
+Tests that have never failed will not be selected. To run all tests with the
+most recently failed first use
+
+ pg_prove --state hot,all,save
+
+This combination of options may also be specified thus
+
+ pg_prove --state adrian
+
+=item C<todo>
+
+Run any tests with todos.
+
+=item C<slow>
+
+Run the tests in slowest to fastest order. This is useful in conjunction with
+the C<-j> parallel testing switch to ensure that your slowest tests start
+running first.
+
+ pg_prove --state slow -j9
+
+=item C<fast>
+
+Run test tests in fastest to slowest order.
+
+=item C<new>
+
+Run the tests in newest to oldest order based on the modification times of the
+test scripts.
+
+=item C<old>
+
+Run the tests in oldest to newest order.
+
+=item C<fresh>
+
+Run those test scripts that have been modified since the last test run.
+
+=item C<save>
+
+Save the state on exit. The state is stored in a file called F<.pg_prove>
+(F<_pg_prove> on Windows and VMS) in the current directory.
+
+=back
+
+The C<--state> switch may be used more than once.
+
+ pg_prove --state hot --state all,save
+
+=back
+
+=head2 Display Options
+
+=over
+
+=item C<-v>
+
+=item C<--verbose>
+
+ pg_prove --verbose
+ pg_prove -v
+
+Display standard output of test scripts while running them. This behavior can
+also be triggered by setting the C<$TEST_VERBOSE> environment variable to a
+true value.
+
+=item C<-f>
+
+=item C<--failures>
+
+ pg_prove --failures
+ pg_prove -f
+
+Show failed tests.
+
+=item C<-o>
+
+=item C<--comments>
+
+Show comments, such as diagnostics output by C<diag()>. Enabled by default.
+use C<--no-comments> to disable.
+
+=item C<--directives>
+
+ pg_prove --directives
+
+Only show results with TODO or SKIP directives.
+
+=item C<-q>
+
+=item C<--quiet>
+
+ pg_prove --quiet
+ pg_prove -q
+
+Suppress some test output while running tests.
+
+=item C<-Q>
+
+=item C<--QUIET>
+
+ pg_prove --QUIET
+ pg_prove -Q
+
+Only print summary results.
+
+=item C<--parse>
+
+ pg_prove --parse
+
+Enables the display of any TAP parsing errors as tests run. Useful for
+debugging new TAP emitters.
+
+=item C<--normalize>
+
+ pg_prove --normalize
+
+Normalize TAP output in verbose output. Errors in the harnessed TAP corrected
+by the parser will be corrected.
+
+=item C<--dry>
+
+=item C<-D>
+
+ pg_prove --dry tests/
+ pg_prove -D
+
+Dry run. Just outputs a list of the tests that would have been run.
+
+=item C<--merge>
+
+Merge test scripts' C<STDERR> with their C<STDOUT>. Not really relevant to
+pgTAP tests, which only print to C<STDERR> when an exception is thrown.
+
+=item C<-t>
+
+=item C<--timer>
+
+ pg_prove --timer
+ pg_prove -t
+
+Print elapsed time after each test file.
+
+=item C<-t>
+
+=item C<--color>
+
+ pg_prove --color
+ pg_prove -c
+
+Display test results in color. Colored test output is the default, but if
+output is not to a terminal, color is disabled.
+
+Requires L<Term::ANSIColor|Term::ANSIColor> on Unix-like platforms and
+L<Win32::Console|Win32::Console> on Windows. If the necessary module is not
+installed colored output will not be available.
+
+=item C<--nocolor>
+
+Do not display test results in color.
+
+=item C<--shuffle>
+
+ pg_prove --shuffle tests/
+
+Test scripts are normally run in alphabetical order. Use C<--reverse> to run
+them in in random order. Not relevant when used with C<--runtests>.
+
+=item C<--reverse>
+
+ pg_prove --reverse tests/
+
+Test scripts are normally run in alphabetical order. Use C<--reverse> to run
+them in reverse order. Not relevant when used with C<--runtests>.
+
+=item C<-a>
+
+=item C<--archive>
+
+ pg_prove --archive tap.tar.gz
+ pg_prove -a test_output.tar
+
+=item C<-f>
+
+=item C<--formatter>
+
+ pg_prove --formatter TAP::Formatter::File
+ pg_prove -f TAP::Formatter::Console
+
+The name of the class to use to format output. The default is
+L<TAP::Formatter::Console|TAP::Formatter::Console>, or
+L<TAP::Formatter::File|TAP::Formatter::File> if the output isn't a TTY.
+
+=item C<--count>
+
+ pg_prove --count
+
+Show the X/Y test count as tests run when not verbose (default).
+
+=item C<--nocount>
+
+ pg_prove --nocount
+
+Disable the display of the X/Y test count as tests run.
+
+Send the TAP output to a TAP archive file as well as to the normal output
+destination. The archive formats supported are F<.tar> and F<.tar.gz>.
+
+=back
+
+=head2 Metadata Options
+
+=over
+
+=item C<-H>
+
+=item C<-?>
+
+=item C<--help>
+
+ pg_prove --help
+ pg_prove -H
+
+Outputs a brief description of the options supported by C<pg_prove> and exits.
+
+=item C<-m>
+
+=item C<--man>
+
+ pg_prove --man
+ pg_prove -m
+
+Outputs this documentation and exits.
+
+=item C<-V>
+
+=item C<--version>
+
+ pg_prove --version
+ pg_prove -V
+
+Outputs the program name and version and exits.
+
+=back
+
+=head1 Author
+
+David E. Wheeler <dwheeler at cpan.org>
+
+=head1 Copyright
+
+Copyright (c) 2008-2010 David E. Wheeler. Some Rights Reserved.
+
+=cut
diff --git a/bin/pg_tapgen b/bin/pg_tapgen
new file mode 100755
index 0000000..b72a008
--- /dev/null
+++ b/bin/pg_tapgen
@@ -0,0 +1,292 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+use DBI;
+use DBD::Pg;
+use Getopt::Long;
+our $VERSION = '3.25';
+
+Getopt::Long::Configure (qw(bundling));
+
+my $opts = { psql => 'psql', color => 1 };
+
+Getopt::Long::GetOptions(
+ 'dbname|d=s' => \$opts->{dbname},
+ 'username|U=s' => \$opts->{username},
+ 'host|h=s' => \$opts->{host},
+ 'port|p=s' => \$opts->{port},
+ 'exclude-schema|N=s@' => \$opts->{exclude_schema},
+ 'verbose|v+' => \$opts->{verbose},
+ 'help|H' => \$opts->{help},
+ 'man|m' => \$opts->{man},
+ 'version|V' => \$opts->{version},
+) or require Pod::Usage && Pod::Usage::pod2usage(2);
+
+if ( $opts->{help} or $opts->{man} ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage(
+ '-sections' => $opts->{man} ? '.+' : '(?i:(Usage|Options))',
+ '-verbose' => 99,
+ '-exitval' => 0,
+ )
+}
+
+if ($opts->{version}) {
+ print 'pg_prove ', main->VERSION, $/;
+ exit;
+}
+
+my @conn;
+for (qw(host port dbname)) {
+ push @conn, "$_=$opts->{$_}" if defined $opts->{$_};
+}
+my $dsn = 'dbi:Pg';
+$dsn .= ':' . join ';', @conn if @conn;
+
+my $dbh = DBI->connect($dsn, $opts->{username}, undef, {
+ RaiseError => 1,
+ PrintError => 0,
+ AutoCommit => 1,
+});
+
+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";
+
+##############################################################################
+
+sub get_schemas {
+ my @exclude = ('information_schema');
+ push @exclude, @{ $_[0] } if $_[0] && @{ $_[0] };
+
+ my $sth = $dbh->prepare_cached(q{
+ SELECT nspname
+ FROM pg_catalog.pg_namespace
+ WHERE nspname NOT LIKE 'pg_%'
+ AND nspname <> ALL(?)
+ ORDER BY nspname
+ });
+
+ my $schemas = $dbh->selectcol_arrayref($sth, undef, \@exclude) or return;
+ return @$schemas;
+}
+
+sub schemas_are {
+ my $schemas = shift;
+ print "SELECT schemas_are( ARRAY[\n '",
+ join("',\n '", @$schemas),
+ "'\n] );\n\n" if @$schemas;
+}
+
+sub get_rels {
+ my $sth = $dbh->prepare_cached(q{
+ SELECT c.relname
+ FROM pg_catalog.pg_namespace n
+ JOIN pg_catalog.pg_class c ON n.oid = c.relnamespace
+ WHERE c.relkind = ?
+ AND n.nspname = ?
+ ORDER BY c.relname
+ });
+ return $dbh->selectcol_arrayref($sth, undef, @_);
+}
+
+sub tables_are {
+ my $schema = shift;
+ my $tables = get_rels(r => $schema);
+ return unless $tables && @$tables;
+ print "SELECT tables_are( '$schema', ARRAY[\n '",
+ join("',\n '", @$tables),
+ "'\n] );\n\n";
+}
+
+sub views_are {
+ my $schema = shift;
+ my $tables = get_rels(v => $schema);
+ return unless $tables && @$tables;
+ print "SELECT views_are( '$schema', ARRAY[\n '",
+ join("',\n '", @$tables),
+ "'\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 '",
+ join("',\n '", @$tables),
+ "'\n] );\n\n";
+}
+
+sub functions_are {
+ my $schema = shift;
+ my $sth = $dbh->prepare(q{
+ SELECT p.proname
+ FROM pg_catalog.pg_proc p
+ JOIN pg_catalog.pg_namespace n ON p.pronamespace = n.oid
+ WHERE n.nspname = ?
+ });
+ my $funcs = $dbh->selectcol_arrayref($sth, undef, $schema);
+ return unless $funcs && @$funcs;
+ print "SELECT functions_are( '$schema', ARRAY[\n '",
+ join("',\n '", @$funcs),
+ "'\n] );\n\n";
+}
+
+__END__
+
+=encoding utf8
+
+=head1 Name
+
+pg_tapgen - Generate schema TAP tests from an existing database
+
+=head1 Usage
+
+ pg_tapgen -d template1 > schema_test.sql
+
+=head1 Description
+
+C<pg_tapgen> is a command-line utility to generate pgTAP tests to validate a
+database schema by reading an existing database and generating the tests to
+match. Its use requires the installation of the L<DBI> and L<DBD::Pg> from
+CPAN or via a package distribution.
+
+B<Warning:> These prerequisites are not validated by the pgTAP C<Makefile>, so
+you'll need to install them yourself. As a result, inclusion of this script in
+the pgTAP distribution is experimental. It may be moved to its own
+distribution in the future.
+
+=head1 Options
+
+ -d --dbname DBNAME Database to which to connect.
+ -U --username USERNAME Username with which to connect.
+ -h --host HOST Host to which to connect.
+ -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.
+ -H --help Print a usage statement and exit.
+ -m --man Print the complete documentation and exit.
+ -V --version Print the version number and exit.
+
+=head1 Options Details
+
+=over
+
+=item C<-d>
+
+=item C<--dbname>
+
+ pg_tapgen --dbname try
+ pg_tapgen -d postgres
+
+The name of database to which to connect. Defaults to the value of the
+C<$PGDATABASE> environment variable or to the system username.
+
+=item C<-U>
+
+=item C<--username>
+
+ pg_tapgen --username foo
+ pg_tapgen -U postgres
+
+PostgreSQL user name to connect as. Defaults to the value of the C<$PGUSER>
+environment variable or to the operating system name of the user running the
+application.
+
+=item C<-h>
+
+=item C<--host>
+
+ pg_tapgen --host pg.example.com
+ pg_tapgen -h dev.local
+
+Specifies the host name of the machine on which the server is running. If the
+value begins with a slash, it is used as the directory for the Unix-domain
+socket. Defaults to the value of the C<$PGHOST> environment variable or
+localhost.
+
+=item C<-p>
+
+=item C<--port>
+
+ pg_tapgen --port 1234
+ pg_tapgen -p 666
+
+Specifies the TCP port or the local Unix-domain socket file extension on which
+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<-v>
+
+=item C<--verbose>
+
+ pg_tapgen --verbose
+ pg_tapgen -v
+
+Display standard output of test scripts while running them. This behavior can
+also be triggered by setting the C<$TEST_VERBOSE> environment variable to a
+true value.
+
+=item C<-N>
+
+=item C<--exclude-schema>
+
+ pg_tapgen --exclude-schema contrib
+ pg_tapgen -N testing -N temporary
+
+Exclude a schema from the test generation. C<pg_tapgen> always ignores
+C<information_schema>, as it is also ignored by pgTAP. But if there are other
+schemas in the database that you don't need or want to test for in the
+database (because you run the tests on another database without those schemas,
+for example), use C<--exclude-schema> to omit them. May be used more than once
+to exclude more than one schema.
+
+=item C<-H>
+
+=item C<--help>
+
+ pg_tapgen --help
+ pg_tapgen -H
+
+Outputs a brief description of the options supported by C<pg_tapgen> and exits.
+
+=item C<-m>
+
+=item C<--man>
+
+ pg_tapgen --man
+ pg_tapgen -m
+
+Outputs this documentation and exits.
+
+=item C<-V>
+
+=item C<--version>
+
+ pg_tapgen --version
+ pg_tapgen -V
+
+Outputs the program name and version and exits.
+
+=back
+
+=head1 Author
+
+David E. Wheeler <david at kineticode.com>
+
+=head1 Copyright
+
+Copyright (c) 2009-2010 Kineticode, Inc. Some Rights Reserved.
+
+=cut
diff --git a/lib/TAP/Parser/SourceHandler/pgTAP.pm b/lib/TAP/Parser/SourceHandler/pgTAP.pm
new file mode 100644
index 0000000..050adf2
--- /dev/null
+++ b/lib/TAP/Parser/SourceHandler/pgTAP.pm
@@ -0,0 +1,402 @@
+package TAP::Parser::SourceHandler::pgTAP;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::Iterator::Process ();
+
+ at ISA = qw(TAP::Parser::SourceHandler);
+TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
+
+our $VERSION = '3.25';
+
+=head1 Name
+
+TAP::Parser::SourceHandler::pgTAP - Stream TAP from pgTAP test scripts
+
+=head1 Synopsis
+
+In F<Build.PL> for your application with pgTAP tests in F<t/*.pg>:
+
+ Module::Build->new(
+ module_name => 'MyApp',
+ test_file_exts => [qw(.t .pg)],
+ use_tap_harness => 1,
+ tap_harness_args => {
+ sources => {
+ Perl => undef,
+ pgTAP => {
+ dbname => 'try',
+ username => 'postgres',
+ suffix => '.pg',
+ },
+ }
+ },
+ build_requires => {
+ 'Module::Build' => '0.30',
+ 'TAP::Parser::SourceHandler::pgTAP' => '3.19',
+ },
+ )->create_build_script;
+
+If you're using L<C<prove>|prove>:
+
+ prove --source Perl \
+ --ext .t --ext .pg \
+ --source pgTAP --pgtap-option dbname=try \
+ --pgtap-option username=postgres \
+ --pgtap-option suffix=.pg
+
+If you have only pgTAP tests, just use C<pg_prove>:
+
+ pg_prove --dbname try --username postgres
+
+Direct use:
+
+ use TAP::Parser::Source;
+ use TAP::Parser::SourceHandler::pgTAP;
+
+ my $source = TAP::Parser::Source->new->raw(\'mytest.pg');
+ $source->config({ pgTAP => {
+ dbname => 'testing',
+ username => 'postgres',
+ suffix => '.pg',
+ }});
+ $source->assemble_meta;
+
+ my $class = 'TAP::Parser::SourceHandler::pgTAP';
+ my $vote = $class->can_handle( $source );
+ my $iter = $class->make_iterator( $source );
+
+=head1 Description
+
+This source handler executes pgTAP tests. It does two things:
+
+=over
+
+=item 1.
+
+Looks at the L<TAP::Parser::Source> passed to it to determine whether or not
+the source in question is in fact a pgTAP test (L</can_handle>).
+
+=item 2.
+
+Creates an iterator that will call C<psql> to run the pgTAP tests
+(L</make_iterator>).
+
+=back
+
+Unless you're writing a plugin or subclassing L<TAP::Parser>, you probably
+won't need to use this module directly.
+
+=head2 Testing with pgTAP
+
+If you just want to write tests with L<pgTAP|http://pgtap.org/>, here's how:
+
+=over
+
+=item *
+
+Build your test database, including pgTAP. It's best to install it in its own
+schema. To build it and install it in the schema "tap", do this (assuming your
+database is named "try"):
+
+ make TAPSCHEMA=tap
+ make install
+ psql -U postgres -d try -f pgtap.sql
+
+=item *
+
+Write your tests in files ending in F<.pg> in the F<t> directory, right
+alongside your normal Perl F<.t> tests. Here's a simple pgTAP test to get you
+started:
+
+ BEGIN;
+
+ SET search_path = public,tap,pg_catalog;
+
+ SELECT plan(1);
+
+ SELECT pass('This should pass!');
+
+ SELECT * FROM finish();
+ ROLLBACK;
+
+Note how C<search_path> has been set so that the pgTAP functions can be found
+in the "tap" schema. Consult the extensive L<pgTAP
+documentation|http://pgtap.org/documentation.html> for a comprehensive list of
+test functions.
+
+=item *
+
+Run your tests with C<prove> like so:
+
+ prove --source Perl \
+ --ext .t --ext .pg \
+ --source pgTAP --pgtap-option dbname=try \
+ --pgtap-option username=postgres \
+ --pgtap-option suffix=.pg
+
+This will run both your Perl F<.t> tests and your pgTAP F<.pg> tests all
+together. You can also use L<pg_prove> to run just the pgTAP tests like so:
+
+ pg_prove -d try -U postgres t/
+
+=item *
+
+Once you're sure that you've got the pgTAP tests working, modify your
+F<Build.PL> script to allow F<./Build test> to run both the Perl and the pgTAP
+tests, like so:
+
+ Module::Build->new(
+ module_name => 'MyApp',
+ test_file_exts => [qw(.t .pg)],
+ use_tap_harness => 1,
+ configure_requires => { 'Module::Build' => '0.30', },
+ tap_harness_args => {
+ sources => {
+ Perl => undef,
+ pgTAP => {
+ dbname => 'try',
+ username => 'postgres',
+ suffix => '.pg',
+ },
+ }
+ },
+ build_requires => {
+ 'Module::Build' => '0.30',
+ 'TAP::Parser::SourceHandler::pgTAP' => '3.19',
+ },
+ )->create_build_script;
+
+The C<use_tap_harness> parameter is optional, since it's implicitly set by the
+use of the C<tap_harness_args> parameter. All the other parameters are
+required as you see here. See the documentation for C<make_iterator()> for a
+complete list of options to the C<pgTAP> key under C<sources>.
+
+And that's it. Now get testing!
+
+=back
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+ my $vote = $class->can_handle( $source );
+
+Looks at the source to determine whether or not it's a pgTAP test and returns
+a score for how likely it is in fact a pgTAP test file. The scores are as
+follows:
+
+ 1 if it's not a file and starts with "pgsql:".
+ 1 if it has a suffix equal to that in the "suffix" config
+ 1 if its suffix is ".pg"
+ 0.8 if its suffix is ".sql"
+ 0.75 if its suffix is ".s"
+
+The latter two scores are subject to change, so try to name your pgTAP tests
+ending in ".pg" or specify a suffix in the configuration to be sure.
+
+=cut
+
+sub can_handle {
+ my ( $class, $source ) = @_;
+ my $meta = $source->meta;
+
+ unless ($meta->{is_file}) {
+ my $test = ref $source->raw ? ${ $source->raw } : $source->raw;
+ return 1 if $test =~ /^pgsql:/;
+ return 0;
+ }
+
+ my $suf = $meta->{file}{lc_ext};
+
+ # If the config specifies a suffix, it's required.
+ if ( my $config = $source->config_for('pgTAP') ) {
+ if ( defined $config->{suffix} ) {
+ return $suf eq $config->{suffix} ? 1 : 0;
+ }
+ }
+
+ # Otherwise, return a score for our supported suffixes.
+ my %score_for = (
+ '.pg' => 0.9,
+ '.sql' => 0.8,
+ '.s' => 0.75,
+ );
+ return $score_for{$suf} || 0;
+}
+
+=head3 C<make_iterator>
+
+ my $iterator = $class->make_iterator( $source );
+
+Returns a new L<TAP::Parser::Iterator::Process> for the source.
+C<< $source->raw >> must be either a file name or a scalar reference to the
+file name -- or a string starting with "pgsql:", in which case the remainder
+of the string is assumed to be SQL to be executed inside the database.
+
+The pgTAP tests are run by executing C<psql>, the PostgreSQL command-line
+utility. A number of arguments are passed to it, many of which you can affect
+by setting up the source source configuration. The configuration must be a
+hash reference, and supports the following keys:
+
+=over
+
+=item C<psql>
+
+The path to the C<psql> command. Defaults to simply "psql", which should work
+well enough if it's in your path.
+
+=item C<dbname>
+
+The database to which to connect to run the tests. Defaults to the value of
+the C<$PGDATABASE> environment variable or, if not set, to the system
+username.
+
+=item C<username>
+
+The PostgreSQL username to use to connect to PostgreSQL. If not specified, no
+username will be used, in which case C<psql> will fall back on either the
+C<$PGUSER> environment variable or, if not set, the system username.
+
+=item C<host>
+
+Specifies the host name of the machine to which to connect to the PostgreSQL
+server. If the value begins with a slash, it is used as the directory for the
+Unix-domain socket. Defaults to the value of the C<$PGDATABASE> environment
+variable or, if not set, the local host.
+
+=item C<port>
+
+Specifies the TCP port or the local Unix-domain socket file extension on which
+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 the
+time C<psql> was compiled, usually 5432.
+
+=item C<pset>
+
+Specifies a hash of printing options in the style of C<\pset> in the C<psql>
+program. See the L<psql
+documentation|http://www.postgresql.org/docs/current/static/app-psql.html> for
+details on the supported options.
+
+=begin comment
+
+=item C<search_path>
+
+The schema search path to use during the execution of the tests. Useful for
+overriding the default search path and you have pgTAP installed in a schema
+not included in that search path.
+
+=end comment
+
+=back
+
+=cut
+
+sub make_iterator {
+ my ( $class, $source ) = @_;
+ my $config = $source->config_for('pgTAP');
+
+ my @command = ( $config->{psql} || 'psql' );
+ push @command, qw(
+ --no-psqlrc
+ --no-align
+ --quiet
+ --pset pager=
+ --pset tuples_only=true
+ --set ON_ERROR_ROLLBACK=1
+ --set ON_ERROR_STOP=1
+ );
+
+ for (qw(username host port dbname)) {
+ push @command, "--$_" => $config->{$_} if defined $config->{$_};
+ }
+
+ if (my $pset = $config->{pset}) {
+ while (my ($k, $v) = each %{ $pset }) {
+ push @command, '--pset', "$k=$v";
+ }
+ }
+
+ if (my $set = $config->{set}) {
+ while (my ($k, $v) = each %{ $set }) {
+ push @command, '--set', "$k=$v";
+ }
+ }
+
+ my $fn = ref $source->raw ? ${ $source->raw } : $source->raw;
+
+ if ($fn && $fn =~ s/^pgsql:\s*//) {
+ push @command, '--command', $fn;
+ } else {
+ $class->_croak(
+ 'No such file or directory: ' . ( defined $fn ? $fn : '' ) )
+ unless $fn && -e $fn;
+ push @command, '--file', $fn;
+ }
+
+ # XXX I'd like a way to be able to specify environment variables to set when
+ # the iterator executes the command...
+ # local $ENV{PGOPTIONS} = "--search_path=$config->{search_path}"
+ # if $config->{search_path};
+
+ return TAP::Parser::Iterator::Process->new({
+ command => \@command,
+ merge => $source->merge
+ });
+}
+
+=head1 See Also
+
+=over
+
+=item * L<TAP::Object>
+
+=item * L<TAP::Parser>
+
+=item * L<TAP::Parser::IteratorFactory>
+
+=item * L<TAP::Parser::SourceHandler>
+
+=item * L<TAP::Parser::SourceHandler::Executable>
+
+=item * L<TAP::Parser::SourceHandler::Perl>
+
+=item * L<TAP::Parser::SourceHandler::File>
+
+=item * L<TAP::Parser::SourceHandler::Handle>
+
+=item * L<TAP::Parser::SourceHandler::RawTAP>
+
+=item * L<pgTAP|http://pgtap.org/>
+
+=back
+
+=head1 Support
+
+This module is managed in an open L<GitHub
+repository|http://github.com/theory/tap-parser-sourcehandler-pgtap/>. Feel
+free to fork and contribute, or to clone
+C<git://github.com/theory/tap-parser-sourcehandler-pgtap.git> and send
+patches!
+
+Found a bug? Please
+L<post|http://github.com/theory/tap-parser-sourcehandler-pgtap/issues> or
+L<email|mailto:bug-tap-parser-sourcehandler-pgtap at rt.cpan.org> a report!
+
+=head1 Author
+
+David E. Wheeler <dwheeler at cpan.org>
+
+=head1 Copyright and License
+
+Copyright (c) 2010 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.
+
+=cut
diff --git a/t/bin/psql b/t/bin/psql
new file mode 100755
index 0000000..f32e6a7
--- /dev/null
+++ b/t/bin/psql
@@ -0,0 +1,3 @@
+#!/usr/bin/perl
+
+print $_, $/ for @ARGV;
diff --git a/t/pod-coverage.t b/t/pod-coverage.t
new file mode 100644
index 0000000..f673cf5
--- /dev/null
+++ b/t/pod-coverage.t
@@ -0,0 +1,10 @@
+#!/usr/bin/env perl -w
+
+use strict;
+use warnings;
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.06";
+plan skip_all => 'Test::Pod::Coverage 1.06 required' if $@;
+
+all_pod_coverage_ok();
diff --git a/t/pod.t b/t/pod.t
new file mode 100644
index 0000000..08172a1
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,7 @@
+#!/usr/bin/env perl -w
+
+use strict;
+use Test::More;
+eval "use Test::Pod 1.41";
+plan skip_all => "Test::Pod 1.41 required for testing POD" if $@;
+all_pod_files_ok(qw(lib bin));
diff --git a/t/source.pg b/t/source.pg
new file mode 100644
index 0000000..8520887
--- /dev/null
+++ b/t/source.pg
@@ -0,0 +1,6 @@
+#!/usr/bin/perl
+
+print <<'END_TESTS';
+1..1
+ok 1 - source.t
+END_TESTS
diff --git a/t/source_handler.t b/t/source_handler.t
new file mode 100644
index 0000000..6e8277c
--- /dev/null
+++ b/t/source_handler.t
@@ -0,0 +1,190 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 50;
+
+use IO::File;
+use IO::Handle;
+use File::Spec::Functions;
+
+use TAP::Parser::Source;
+use TAP::Parser::SourceHandler;
+
+my $ext = $^O eq 'MSWin32' ? '.bat' : '';
+
+my $dir = catdir curdir, 't', 'scripts';
+$dir = catdir curdir, 't', 'bin' unless -d $dir;
+
+# pgTAP source tests
+{
+ my $class = 'TAP::Parser::SourceHandler::pgTAP';
+ my $test = File::Spec->catfile( 't', 'source.pg' );
+ my $psql = File::Spec->catfile( $dir, 'psql' );
+ my @command = qw(
+ --no-psqlrc
+ --no-align
+ --quiet
+ --pset pager=
+ --pset tuples_only=true
+ --set ON_ERROR_ROLLBACK=1
+ --set ON_ERROR_STOP=1
+ );
+ my $tests = {
+ default_vote => 0,
+ can_handle => [
+ { name => '.pg',
+ meta => {
+ is_file => 1,
+ file => { lc_ext => '.pg' }
+ },
+ config => {},
+ vote => 0.9,
+ },
+ { name => '.sql',
+ meta => {
+ is_file => 1,
+ file => { lc_ext => '.sql' }
+ },
+ config => {},
+ vote => 0.8,
+ },
+ { name => '.s',
+ meta => {
+ is_file => 1,
+ file => { lc_ext => '.s' }
+ },
+ config => {},
+ vote => 0.75,
+ },
+ { name => 'config_suffix',
+ meta => {
+ is_file => 1,
+ file => { lc_ext => '.foo' }
+ },
+ config => { pgTAP => { suffix => '.foo' } },
+ vote => 1,
+ },
+ { name => 'not_file',
+ meta => {
+ is_file => 0,
+ },
+ vote => 0,
+ },
+ ],
+ make_iterator => [
+ { name => 'psql',
+ raw => \$test,
+ config => { pgTAP => { psql => $psql } },
+ iclass => 'TAP::Parser::Iterator::Process',
+ output => [ @command, '--file', $test ],
+ },
+ { name => 'config',
+ raw => $test,
+ config => {
+ pgTAP => {
+ psql => $psql,
+ username => 'who',
+ host => 'f',
+ port => 2,
+ dbname => 'fred',
+ set => { whatever => 'foo' },
+ }
+ },
+ iclass => 'TAP::Parser::Iterator::Process',
+ output => [
+ @command,
+ qw(--username who --host f --port 2 --dbname fred --set whatever=foo --file),
+ $test
+ ],
+ },
+ { name => 'error',
+ raw => 'blah.pg',
+ iclass => 'TAP::Parser::Iterator::Process',
+ error => qr/^No such file or directory: blah[.]pg/,
+ },
+ { name => 'undef error',
+ raw => undef,
+ iclass => 'TAP::Parser::Iterator::Process',
+ error => qr/^No such file or directory: /,
+ },
+ ],
+ };
+
+ test_handler( $class, $tests );
+}
+
+exit;
+
+###############################################################################
+# helper sub
+
+sub test_handler {
+ my ( $class, $tests ) = @_;
+ my ($short_class) = ( $class =~ /\:\:(\w+)$/ );
+
+ use_ok $class;
+ can_ok $class, 'can_handle', 'make_iterator';
+
+ {
+ my $default_vote = $tests->{default_vote} || 0;
+ my $source = TAP::Parser::Source->new->raw(\'');
+ is( $class->can_handle($source), $default_vote,
+ '... can_handle default vote'
+ );
+ }
+
+ for my $test ( @{ $tests->{can_handle} } ) {
+ my $source = TAP::Parser::Source->new->raw(\'');
+ $source->raw( $test->{raw} ) if $test->{raw};
+ $source->meta( $test->{meta} ) if $test->{meta};
+ $source->config( $test->{config} ) if $test->{config};
+ $source->assemble_meta if $test->{assemble_meta};
+ my $vote = $test->{vote} || 0;
+ my $name = $test->{name} || 'unnamed test';
+ $name = "$short_class->can_handle( $name )";
+ is( $class->can_handle($source), $vote, $name );
+ }
+
+ for my $test ( @{ $tests->{make_iterator} } ) {
+ my $name = $test->{name} || 'unnamed test';
+ $name = "$short_class->make_iterator( $name )";
+
+ SKIP:
+ {
+ my $planned = 1;
+ $planned += 1 + scalar @{ $test->{output} } if $test->{output};
+ skip $test->{skip_reason}, $planned if $test->{skip};
+
+ my $source = TAP::Parser::Source->new;
+ $source->raw( $test->{raw} ) if $test->{raw};
+ $source->test_args( $test->{test_args} ) if $test->{test_args};
+ $source->meta( $test->{meta} ) if $test->{meta};
+ $source->config( $test->{config} ) if $test->{config};
+ $source->assemble_meta if $test->{assemble_meta};
+
+ my $iterator = eval { $class->make_iterator($source) };
+ my $e = $@;
+ if ( my $error = $test->{error} ) {
+ $e = '' unless defined $e;
+ like $e, $error, "$name threw expected error";
+ next;
+ }
+ elsif ($e) {
+ fail("$name threw an unexpected error");
+ diag($e);
+ next;
+ }
+
+ isa_ok $iterator, $test->{iclass}, $name;
+ if ( $test->{output} ) {
+ my $i = 1;
+ for my $line ( @{ $test->{output} } ) {
+ is $iterator->next, $line, "... line $i";
+ $i++;
+ }
+ ok !$iterator->next, '... and we should have no more results';
+ }
+ }
+ }
+}
--
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