TAP-Parser-SourceHandler-pgTAP-3.37000755001751000166 014772312257 17007 5ustar00runnerdocker000000000000TAP-Parser-SourceHandler-pgTAP-3.37/Build.PL000444001751000166 536314772312257 20447 0ustar00runnerdocker000000000000use 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); } sub ACTION_tarball_name { print shift->dist_dir . ".tar.gz\n" } sub ACTION_latest_changes { my $self = shift; (my $dv = $self->dist_version) =~ s/^v//; open my $in, '<:raw', 'Changes' or die "Cannot open Changes: $!\n"; open my $out, '>:raw', 'latest_changes.md' or die "Cannot open latest_changes.md: $!\n"; while (<$in>) { last if /^\Q$dv\E\b/ } print {$out} "Changes for v$dv\n"; while (<$in>) { last if /^\s*$/; chomp; if (s/^\s+-/- /) { print {$out} "\n"; } else { s/^\s+/ /; } print {$out} $_; } $self->add_to_cleanup('latest_changes.md'); } }, ); $class->new( module_name => 'TAP::Parser::SourceHandler::pgTAP', license => 'perl', configure_requires => { 'Module::Build' => '0.4209', }, test_requires => { 'Module::Build' => '0.4209', 'Test::More' => '0.88', }, requires => { 'TAP::Parser::SourceHandler' => 0, 'perl' => 5.006000, }, meta_merge => { "meta-spec" => { version => 2 }, resources => { homepage => 'https://search.cpan.org/dist/Tap-Parser-Sourcehandler-pgTAP/', bugtracker => 'https://github.com/theory/tap-parser-sourcehandler-pgtap/issues/', repository => 'https://github.com/theory/tap-parser-sourcehandler-pgtap', }, prereqs => { develop => { requires => { 'Test::Pod' => '1.41', 'Test::Pod::Coverage' => '1.06', 'Test::Spelling' => '0.25', }, }, }, }, )->create_build_script; TAP-Parser-SourceHandler-pgTAP-3.37/Changes000444001751000166 1423514772312257 20464 0ustar00runnerdocker000000000000Revision history for Perl extension TAP::Parser::SourceHandler::pgTAP. 3.37 2025-03-30T18:59:40Z - Silenced "Duplicate specification" warnings. Thanks to @tyboro for the PR (#40). - Removed Pod tests from the release distribution. - Updated dependencies to CPAN Meta Spec v2 layout. 3.36 2022-08-21T01:15:35Z - Improved the `functions_are()` tests generated by `pg_tapgen` by eliminating duplicate function names. Thanks to @deathwish for the PR (#34). - Improved the function-body tests generated by `pg_tapgen` by creating separate tests for each instance of a function with different arguments, since the arguments are part of the function signature. Thanks to @deathwish for the PR (#34). - The list of trigger tests generated by `pg_tapgen` will now by sorted, so that they'll no longer appear in random order, which can be annoying when comparing changes. Thanks to Kashif Iqbal Khan for the report (#35). - Fixed documentation error for the scoring of files. It returns 0.9, not 1, for files ending in `.pg`. - Highlighted the dependence on `psql` and its support for environment variables, password file, and connection file in the documentation. 3.35 2019-03-02T19:18:31Z - Fixed Postgres 11 primary key query incompatibility in `pg_tapgen` by checking the `pg_index.indisprimary` column instead of `pg_catalog.relhaspkey`, since the latter has been removed. Thanks to @KiriakosGeorgiou for the report (#19). 3.34 2018-11-28T03:04:53Z - Added function-checksum tests to the output of `pg_tapgen`, thanks to Marc Cousin (PR #17). - Released a Docker image: https://hub.docker.com/r/itheory/pg_prove/. - Converted URLs in documentation to HTTPS. 3.33 2017-03-04T23:40:01Z - Added trigger-testing functions to the output of `pg_tapgen`, thanks to Rodolphe Quiédeville (PR #11). - Added enum- and extension-testing functions to the output of `pg_tapgen`, thanks to Rodolphe Quiédeville (PR #13, PR #14). - Explicitly set the `psql` `pager` variable to `off`, instead of not setting it, to ensure it is always off. Thanks to Keith Fiske for the report (theory/pgtap#135). 3.32 2016-05-11T23:37:30Z - Fixed quoting of default values output by `pg_tapgen`, thanks to a pull request from Rodolphe Quiédeville (#7). - Various fixes and improvements to `pg_tapgen`, including: - Added `--create-extension` and `--no-create-extension` options to include or exclude the `CREATE EXTENSION pgtap` statement in the generated test files. - Fixed a bug that threw an error when no database connection options were specified. - Added support for the `$PGPASSWORD` environment variable. - The emitted test scripts now include an appropriate plan that counts assertions, rather than `no_plan`, thanks to @slaught. - Added a number of additional tests to the emitted tests scripts, again thanks to @slaught, including: * Foreign table tests * Materialized view tests * Object ownership tests - Column tests now explicitly specify the table schema and test descriptions, thanks to @slaught. - The column default tests now work properly with default values that include strings inside function calls, such as `nextval(''artist_id_seq'')`. - Refactored `pg_prove` to better follow the interface provided by App::Prove. This improves option processing, notably single-letter option bundling now works properly. 3.31 2015-06-19T23:41:19Z - The `--ext` option to `pg_prove` now always identifies pgTAP tests. Use `prove` with the `--pgtap-option suffix=.foo` option to mix pgTAP tests with other tests. 3.30 2014-01-31T21:10:54Z - Removed markup from preformatted text in the `pg_prove` documentation. - Updated copyright dates. - Added note to the docs mentioning that `pg_prove`-specific options are not supported in `.proverc`, unfortunately. - Removed `ON_ERROR_ROLLBACK=1`, as it does not work well with scripts, anyway. - Removed the Pod tests from the distribution. 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. - Updated email address in `pg_tapgen`. 3.26 2011-03-30T18:22:25 - Fixed exit code in `pg_prove`. It no longer returns 0 on fail and 1 on pass. Thanks to Rod Taylor for the report! 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. TAP-Parser-SourceHandler-pgTAP-3.37/MANIFEST000444001751000166 26714772312257 20262 0ustar00runnerdocker000000000000bin/pg_prove bin/pg_tapgen Build.PL Changes lib/TAP/Parser/SourceHandler/pgTAP.pm MANIFEST This list of files README.md t/bin/psql t/source.pg t/source_handler.t META.yml META.json TAP-Parser-SourceHandler-pgTAP-3.37/META.json000444001751000166 262714772312257 20574 0ustar00runnerdocker000000000000{ "abstract" : "Stream TAP from pgTAP test scripts", "author" : [ "David E. Wheeler " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4234", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "TAP-Parser-SourceHandler-pgTAP", "prereqs" : { "configure" : { "requires" : { "Module::Build" : "0.4209" } }, "develop" : { "requires" : { "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.06", "Test::Spelling" : "0.25" } }, "runtime" : { "requires" : { "TAP::Parser::SourceHandler" : "0", "perl" : "5.006" } }, "test" : { "requires" : { "Module::Build" : "0.4209", "Test::More" : "0.88" } } }, "provides" : { "TAP::Parser::SourceHandler::pgTAP" : { "file" : "lib/TAP/Parser/SourceHandler/pgTAP.pm", "version" : "3.37" } }, "release_status" : "stable", "resources" : { "homepage" : "https://search.cpan.org/dist/Tap-Parser-Sourcehandler-pgTAP/", "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "3.37", "x_serialization_backend" : "JSON::PP version 4.16" } TAP-Parser-SourceHandler-pgTAP-3.37/META.yml000444001751000166 147614772312257 20425 0ustar00runnerdocker000000000000--- abstract: 'Stream TAP from pgTAP test scripts' author: - 'David E. Wheeler ' build_requires: Module::Build: '0.4209' Test::More: '0.88' configure_requires: Module::Build: '0.4209' dynamic_config: 1 generated_by: 'Module::Build version 0.4234, CPAN::Meta::Converter version 2.150010' 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.37' requires: TAP::Parser::SourceHandler: '0' perl: '5.006' resources: homepage: https://search.cpan.org/dist/Tap-Parser-Sourcehandler-pgTAP/ license: http://dev.perl.org/licenses/ version: '3.37' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' TAP-Parser-SourceHandler-pgTAP-3.37/README.md000444001751000166 460714772312257 20432 0ustar00runnerdocker000000000000TAP/Parser/SourceHandler/pgTAP version 3.37 =========================================== [![CPAN version](https://badge.fury.io/pl/TAP-Parser-SourceHandler-pgTAP.svg)](https://badge.fury.io/pl/TAP-Parser-SourceHandler-pgTAP) [![Docker release](https://img.shields.io/docker/v/itheory/pg_prove?label=🐳%20Docker&sort=semver)](https://hub.docker.com/r/itheory/pg_prove/) [![✅ Test Status](https://github.com/theory/tap-parser-sourcehandler-pgtap/actions/workflows/ci.yml/badge.svg)](https://github.com/theory/tap-parser-sourcehandler-pgtap/actions/workflows/ci.yml) This module adds support for executing [pgTAP](https://pgtap.org/) PostgreSQL tests under Test::Harness and `prove. This is useful for executing your Perl tests and your PostgreSQL tests together, and analyzing their results. Most likely. you'll want to use it with `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 `Build.PL` for your application with pgTAP tests in `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 To run it from a [Docker image](https://hub.docker.com/r/itheory/pg_prove/): docker pull itheory/pg_prove curl -L https://git.io/JUdgg -o pg_prove && chmod +x pg_prove ./pg_prove --help Dependencies ------------ TAP::Parser::SourceHandler::pgTAP requires TAP::Parser::SourceHandler. Copyright and License --------------------- Copyright (c) 2018-2025 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. TAP-Parser-SourceHandler-pgTAP-3.37/bin000755001751000166 014772312257 17557 5ustar00runnerdocker000000000000TAP-Parser-SourceHandler-pgTAP-3.37/bin/pg_prove000555001751000166 5263614772312257 21517 0ustar00runnerdocker000000000000#!/usr/bin/perl -w use strict; use App::Prove; use Getopt::Long; our $VERSION = '3.37'; $|++; # Fire up the app, process args, and run the tests. my $app = App::Prove::pgTAP->new; $app->process_args(@ARGV); exit($app->run ? 0 : 1); ####################################################################################### package App::Prove::pgTAP; use base 'App::Prove'; BEGIN { __PACKAGE__->mk_methods(qw( psql dbname username host port pset set runtests schema match ext )); } sub _initialize { my $self = shift->SUPER::_initialize(@_); # Set up defaults. $self->{sources} = ['pgTAP']; $self->{color} = 1; $self->{comments} = 1; return $self; } sub process_args { my $self = shift; my $opts; # We need to locally define a function to do argument processing. my $get_options = sub(@) { Getopt::Long::Configure(qw(no_ignore_case bundling pass_through)); # Silence "Duplicate specification" warnings, since we replace some of # App::Prove's options. local $SIG{__WARN__} = sub { warn @_ if $_[0] !~ /^Duplicate specification/ }; return 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' => \$self->{runtests}, 'schema|s=s' => \$self->{schema}, 'match|x=s' => \$self->{match}, 'version|V' => \$self->{show_version}, 'help|H|?' => \$self->{show_help}, 'man|m' => \$self->{show_man}, ); }; do { # Replace GetOptions in App::Prove and process the args. Yes, this is # ugly, but it's the only way to inject additional options into the # processing without running GetOptions twice (which has its own # issues; see https://rt.cpan.org/Ticket/Display.html?id=114335). no warnings 'redefine'; local *App::Prove::GetOptions = $get_options; $self->SUPER::process_args(@_); }; # Set argv to pass stuff through to pgTAP. push @{ $self->{argv} } => ( (map { ('--pgtap-option' => "suffix=$_") } @{ $self->{extensions} || [] }), (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} }) ); # Set defaults. $self->{extensions} ||= ['.pg']; return; } sub _get_tests { my $self = shift; # --schema and --match assume --runtests. return $self->SUPER::_get_tests(@_) unless $self->{runtests} || $self->{schema} || $self->{match}; # We're just going to call `runtests()`. my @args; for my $key (qw(schema match)) { next unless $self->{$key}; (my $arg = $self->{$key}) =~ s/'/\\'/g; # Gotta cast the arguments. push @args, "'$arg'::" . ($key eq 'schema' ? 'name' : 'text'); } my $runtests_call = 'runtests(' . join( ', ', @args ) . ');'; return [ "pgsql: SELECT * FROM $runtests_call", $runtests_call, ]; } sub print_version { my $self = shift; print 'pg_prove ', main->VERSION, $/; } sub _help { my ( $self, $verbosity ) = @_; require Pod::Usage; Pod::Usage::pod2usage( '-sections' => $verbosity > 1 ? '.+' : '(?i:(Usage|Options))', '-verbose' => 99, '-exitval' => 0, ) } __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 is a command-line application to run one or more L tests in a PostgreSQL database. The output of the tests is harvested and processed by L in order to summarize the results of the test. C relies on L|https://www.postgresql.org/docs/current/app-psql.html> to run the tests, and therefor supports all of the L, as well as the L and L read by C. 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. Here's what it looks like when the pgTAP tests are run with C % 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 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 with "test," run the tests like so: pg_prove --dbname mydb --schema test --match 'test$' =head1 Options -b --psql-bin PSQL Location of the 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 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 .pg) -r, --recurse Recursively descend into directories. --ignore-exit Ignore exit status from test scripts. --trap Trap 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 .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' STDERR and STDOUT. -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. --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 program, which will be used to actually run the tests. Defaults to F, 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 program. See L 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 program. See L 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 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 tells C 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 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 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 execute the C 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, though all must be pgTAP tests: pg_prove --ext .sql --ext .pg --ext .pgt If you want to mix pgTAP tests with other TAP-emitting tests, like Perl tests, use C instead, where C<--ext> identifies any test file, and C<--pgtap-option suffix=> lets you specify one or more extensions for pgTAP tests. prove --source Perl \ --ext .t --ext .pg \ --source pgTAP --pgtap-option suffix=.pg =item C<-r> =item C<--recurse> pg_prove --recurse tests/ pg_prove --recurse sql/ Recursively descend into directories when searching for tests. Be sure to specify C<--ext> if your tests do not end in C<.pg>. 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 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 and print a summary on interrupt. =item C<--harness> pg_prove --harness TAP::Harness::Color Specify a subclass of L to use for the test harness. Defaults to TAP::Harness (unless C<--archive> is specified, in which case it uses L). =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 the 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. Due to how options are loaded you cannot use F<.proverc> for C-specific options, only C options. However, does support all of the usual libpq L. =item C<--norc> Do not process F<./.proverc> or F<~/.proverc>. =item C<--state> You can ask C 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 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 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 option newly passing tests will be excluded from subsequent runs. # Repeat until no more failures pg_prove --state failed,save =item C Run only the passed tests from last time. Useful to make sure that no new problems have been introduced. =item C 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 Run the tests that most recently failed first. The last failure time of each test is stored. The C 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 Run any tests with todos. =item C 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 Run test tests in fastest to slowest order. =item C Run the tests in newest to oldest order based on the modification times of the test scripts. =item C Run the tests in oldest to newest order. =item C Run those test scripts that have been modified since the last test run. =item C 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. 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 with their C. Not really relevant to pgTAP tests, which only print to C 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<-c> =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 on Unix-like platforms and L 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 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>. =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, or L 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. =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 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 =head1 Copyright Copyright (c) 2008-2025 David E. Wheeler. Some Rights Reserved. =cut TAP-Parser-SourceHandler-pgTAP-3.37/bin/pg_tapgen000555001751000166 4773214772312257 21643 0ustar00runnerdocker000000000000#!/usr/bin/perl -w use strict; use warnings; use DBI; use DBD::Pg; use Getopt::Long; use File::Spec; our $VERSION = '3.37'; Getopt::Long::Configure (qw(bundling)); my $opts = { psql => 'psql', directory => '.', create_extension => 1 }; my $total_tests = 0; 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}, 'directory|dir=s' => \$opts->{directory}, 'create-extension|c!' => \$opts->{create_extension}, '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, "\n"; exit; } # Function to write a test script. sub script(&;$) { my ($code, $fn) = @_; my $file = File::Spec->catfile($opts->{directory}, $fn); my $orig_fh = select; my $output; open my $str_fh, '>:encoding(UTF-8)', \$output; select $str_fh; my $saved_total_tests = $total_tests; $total_tests = 0; $code->(); close $str_fh; open my $fh, '>:encoding(UTF-8)', $file or die "Cannot open $file: $!\n"; select $fh; print "SET client_encoding = 'UTF-8';\n"; if ($opts->{create_extension}) { print "SET client_min_messages = warning;\n", "CREATE EXTENSION IF NOT EXISTS pgtap;\n", "RESET client_min_messages;\n\n"; } print "BEGIN;\n", "SELECT plan($total_tests);\n\n", $output, "SELECT * FROM finish();\nROLLBACK;\n", ; close $fh or die "Error closing $file: $!\n"; select $orig_fh; $total_tests = $saved_total_tests; } 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}, $ENV{PGPASSWORD}, { RaiseError => 1, PrintError => 0, AutoCommit => 1, pg_enable_utf8 => 1, }); $dbh->do(q{SET client_encoding = 'UTF-8'}); ############################################################################## script { if (my @schemas = get_schemas($opts->{exclude_schema})) { schemas_are(\@schemas); for my $schema (@schemas) { tables_are($schema); foreign_tables_are($schema); views_are($schema); materialized_views_are($schema); sequences_are($schema); functions_are($schema); enums_are($schema); extensions_are($schema); } } } 'schema.sql'; ############################################################################## 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; return unless @$schemas; my @schemas = @$schemas; no if $] >= 5.017011, warnings => 'experimental::smartmatch'; unless ('public' ~~ @schemas ) { push @schemas, 'public'; } print "SELECT schemas_are(ARRAY[\n '", join("',\n '", @schemas), "'\n]);\n\n"; $total_tests++; schema_owners($schemas); } sub schema_owners { my $schemas = shift; return unless @$schemas; foreach my $schema ( @$schemas ) { my $owner = $dbh->selectcol_arrayref(q{ SELECT pg_catalog.pg_get_userbyid(nspowner) FROM pg_catalog.pg_namespace WHERE nspname = ?; }, undef, $schema)->[0]; print "SELECT schema_owner_is('$schema','$owner');\n"; $total_tests++; } } 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"; $total_tests++; for my $table (@{ $tables }) { my $owner = relation_owner($schema, $table); print "SELECT table_owner_is('$schema','$table','$owner','$schema.$table owner is $owner');\n"; $total_tests++; } 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 '", join("',\n '", @$tables), "'\n]);\n\n"; $total_tests++; for my $table (@{ $tables }) { my $owner = relation_owner($schema, $table); print "SELECT view_owner_is('$schema','$table','$owner', '$schema.$table owner is $owner');\n"; $total_tests++; } } sub foreign_tables_are { my $schema = shift; my $tables = get_rels(f => $schema); return unless $tables && @{ $tables }; print "SELECT foreign_tables_are('$schema', ARRAY[\n '", join("',\n '", @$tables), "'\n]);\n\n"; $total_tests++; for my $table (@{ $tables }) { my $owner = relation_owner($schema, $table); print "SELECT foreign_table_owner_is('$schema','$table','$owner', '$schema.$table owner is $owner');\n"; $total_tests++; } for my $table (@{ $tables }) { script { has_foreign_table($schema, $table) } "foreign_table_$schema.$table.sql"; } } sub materialized_views_are { my $schema = shift; my $tables = get_rels(m => $schema); return unless $tables && @$tables; print "SELECT materialized_views_are('$schema', ARRAY[\n '", join("',\n '", @$tables), "'\n]);\n\n"; $total_tests++; for my $table (@{ $tables }) { my $owner = relation_owner($schema, $table); print "SELECT materialized_view_owner_is('$schema','$table','$owner','$schema.$table owner is $owner');\n"; $total_tests++; } } 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"; $total_tests++; for my $table (@{ $tables }) { my $owner = relation_owner($schema, $table); print "SELECT sequence_owner_is('$schema','$table','$owner','$schema.$table owner is $owner');\n"; $total_tests++; } } sub functions_are { my $schema = shift; my $sth = $dbh->prepare(q{ SELECT p.proname, md5(p.prosrc) as md5, oidvectortypes(proargtypes) as proargs FROM pg_catalog.pg_proc p JOIN pg_catalog.pg_namespace n ON p.pronamespace = n.oid WHERE n.nspname = ? ORDER BY p.proname, proargs }); my $allfuncs = $dbh->selectall_arrayref($sth, undef, $schema); return unless $allfuncs && @$allfuncs; my @funcs = do { my %seen; grep { !$seen{$_}++ } map { $_->[0] } @$allfuncs; }; print "SELECT functions_are('$schema', ARRAY[\n '", join("',\n '", @funcs), "'\n]);\n\n"; $total_tests++; for my $row (@$allfuncs) { my ($proname, $md5, $proargs) = @$row; print "SELECT is(\n", " md5(p.prosrc), '$md5',\n", " 'Function $schema.$proname($proargs) body should match checksum'\n", ")\n", " FROM pg_catalog.pg_namespace n\n", " LEFT JOIN pg_catalog.pg_proc p\n", " ON p.pronamespace = n.oid\n", " AND proname = '$proname'\n", " AND oidvectortypes(proargtypes) = '$proargs'\n", " WHERE n.nspname = '$schema';\n\n" ; $total_tests++; } # # debating whether to check full function existance and thus full ownership ornot # for my $func (@{ $funcs }) { # my $owner = function_owner($schema, $func); # print "SELECT function_owner_is('$schema','$func','$owner','$schema.$func owner is $owner');\n"; # $total_tests++; # } } sub enums_are { my $schema = shift; my $enums = $dbh->selectall_arrayref(q{ SELECT e.oid, e.typname FROM pg_catalog.pg_type e JOIN pg_catalog.pg_namespace n ON n.oid = e.typnamespace WHERE e.typtype = 'e' AND n.nspname = ? }, undef, $schema); return unless $enums && @{ $enums }; print "SELECT enums_are('$schema', ARRAY[\n '", join("',\n '", map { $_->[1] } @{ $enums }), "'\n]);\n\n"; $total_tests++; for my $enum (@{ $enums }) { my $labels = enum_labels($enum->[0]); print "SELECT enum_has_labels('$schema','$enum->[1]', ARRAY['", join("','", map { $_->[0] } @{ $labels }), "']);\n"; $total_tests++; } print "\n"; } sub extensions_are { my $schema = shift; my $extensions = $dbh->selectall_arrayref(q{ SELECT e.oid, e.extname, e.extversion FROM pg_catalog.pg_extension e JOIN pg_catalog.pg_namespace n ON n.oid = e.extnamespace WHERE n.nspname = ? }, undef, $schema); return unless $extensions && @{ $extensions }; print "SELECT extensions_are('$schema', ARRAY[\n '", join("',\n '", map { $_->[1] } @{ $extensions }), "'\n]);\n"; $total_tests++; print "\n"; } sub has_foreign_table { my ($schema, $table) = @_; print "SELECT has_foreign_table( '$schema', '$table', 'Should have foreign table $schema.$table' );\n\n"; $total_tests++; has_pk($schema, $table); columns_are($schema, $table); } sub has_table { my ($schema, $table) = @_; print "SELECT has_table( '$schema', '$table', 'Should have table $schema.$table' );\n\n"; $total_tests++; has_pk($schema, $table); columns_are($schema, $table); triggers_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"; $total_tests++; } 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 , CASE WHEN pg_catalog.pg_get_expr(d.adbin, d.adrelid) LIKE '''%' THEN pg_catalog.pg_get_expr(d.adbin, d.adrelid) ELSE quote_literal(pg_catalog.pg_get_expr(d.adbin, d.adrelid)) END 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'::name, '$table'::name, ARRAY[\n '", join("'::name,\n '", map { $_->[0] } @{ $cols }), "'::name\n]);\n\n"; $total_tests++; for my $col (@{ $cols }) { my $desc = 'Column ' . join('.', @{ $dbh->selectcol_arrayref( 'SELECT quote_ident(i) FROM unnest(?::text[]) i', undef, [$schema, $table, $col->[0]], ) }); my ($null_fn, $null_desc) = $col->[2] ? ('col_not_null(', 'be NOT NULL') : ('col_is_null( ', 'allow NULL'); my ($def_fn, $def_desc) = $col->[3] ? ('col_has_default( ', '') : ('col_hasnt_default(', ' not'); print "SELECT has_column( '$schema', '$table', '$col->[0]', '$desc should exist');\n", "SELECT col_type_is( '$schema', '$table', '$col->[0]', '$col->[1]', '$desc should be type $col->[1]');\n", "SELECT $null_fn '$schema', '$table', '$col->[0]', '$desc should $null_desc');\n", "SELECT $def_fn'$schema', '$table', '$col->[0]', '$desc should${def_desc} have a default');\n"; $total_tests = $total_tests + 4; if ($col->[3]) { print "SELECT col_default_is( '$schema', '$table', '$col->[0]', $col->[4], '$desc default is');\n"; $total_tests++ ; } print "\n"; } } sub triggers_are { my ($schema, $table) = @_; my $triggers = $dbh->selectall_arrayref(q{ SELECT t.tgname, ni.nspname, p.proname FROM pg_catalog.pg_trigger t JOIN pg_catalog.pg_class ct ON ct.oid = t.tgrelid JOIN pg_catalog.pg_namespace nt ON nt.oid = ct.relnamespace JOIN pg_catalog.pg_proc p ON p.oid = t.tgfoid JOIN pg_catalog.pg_namespace ni ON ni.oid = p.pronamespace WHERE nt.nspname = ? AND ct.relname = ? AND NOT t.tgisinternal ORDER BY t.tgname, ni.nspname, p.proname }, undef, $schema, $table); return unless $triggers && @{ $triggers }; print "SELECT triggers_are('$schema', '$table', ARRAY[\n '", join("',\n '", map { $_->[0] } @{ $triggers }), "'\n]);\n\n"; $total_tests++; for my $trigger (@{ $triggers }) { print "SELECT has_trigger( '$schema', '$table', '$trigger->[0]'::name);\n", "SELECT trigger_is( '$schema', '$table', '$trigger->[0]', '$trigger->[1]', '$trigger->[2]');\n"; $total_tests = $total_tests + 2; } print "\n"; } 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 JOIN pg_catalog.pg_index i ON c.oid = i.indrelid WHERE i.indisprimary = true AND n.nspname = ? AND c.relname = ? AND x.contype = ? ) }); return $dbh->selectcol_arrayref($sth, undef, @_)->[0]; } sub relation_owner { my $sth = $dbh->prepare_cached(q{ SELECT pg_catalog.pg_get_userbyid(c.relowner) FROM pg_catalog.pg_class c JOIN pg_catalog.pg_namespace n ON n.oid = c.relnamespace WHERE n.nspname = ? AND c.relname = ? }); return $dbh->selectcol_arrayref($sth, undef, @_)->[0]; } sub function_owner { my $sth = $dbh->prepare_cached(q{ SELECT pg_catalog.pg_get_userbyid(p.proowner) FROM pg_catalog.pg_proc p JOIN pg_catalog.pg_namespace n ON p.pronamespace = n.oid WHERE n.nspname = ? and p.proname = ? }); return $dbh->selectcol_arrayref($sth, undef, @_)->[0]; } sub enum_labels { my $sth = $dbh->prepare_cached(q{ SELECT enumlabel FROM pg_catalog.pg_enum WHERE enumtypid = ? ORDER BY enumsortorder }); return $dbh->selectall_arrayref($sth, undef, @_); } __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 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 and L from CPAN or via a package distribution. B These prerequisites are not validated by the pgTAP C, 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. -c --create-extension Include CREATE EXTENSION pgtap statement. --no-create-extension Excluce CREATE EXTENSION pgtap statement. --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. =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. Password can be specified with C<$PGPASSWORD>. =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<--dir> =item C<--directory> Directory to which to write test files. Defaults to the current directory. =item C<-c> =item C<--create-extension> =item C<--no-create-extension> pg_tapgen --create-exension pg_tapgen -c pg_tapgen --no-create-exension Enable or disable the inclusion of C statements in the generated test files. Enabled by default. =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 always ignores C, 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 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 =head1 Copyright Copyright (c) 2009-2025 David E. Wheeler. Some Rights Reserved. =cut TAP-Parser-SourceHandler-pgTAP-3.37/lib000755001751000166 014772312257 17555 5ustar00runnerdocker000000000000TAP-Parser-SourceHandler-pgTAP-3.37/lib/TAP000755001751000166 014772312257 20201 5ustar00runnerdocker000000000000TAP-Parser-SourceHandler-pgTAP-3.37/lib/TAP/Parser000755001751000166 014772312257 21435 5ustar00runnerdocker000000000000TAP-Parser-SourceHandler-pgTAP-3.37/lib/TAP/Parser/SourceHandler000755001751000166 014772312257 24173 5ustar00runnerdocker000000000000TAP-Parser-SourceHandler-pgTAP-3.37/lib/TAP/Parser/SourceHandler/pgTAP.pm000444001751000166 2541714772312257 25672 0ustar00runnerdocker000000000000package TAP::Parser::SourceHandler::pgTAP; use strict; use vars qw($VERSION @ISA); use TAP::Parser::IteratorFactory (); use TAP::Parser::Iterator::Process (); @ISA = qw(TAP::Parser::SourceHandler); TAP::Parser::IteratorFactory->register_handler(__PACKAGE__); our $VERSION = '3.37'; =head1 Name TAP::Parser::SourceHandler::pgTAP - Stream TAP from pgTAP test scripts =head1 Synopsis In F for your application with pgTAP tests in F: 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|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 --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 passed to it to determine whether or not the source in question is in fact a pgTAP test (L). =item 2. Creates an iterator that will call C to run the pgTAP tests (L). =back Unless you're writing a plugin or subclassing L, you probably won't need to use this module directly. =head2 Testing with pgTAP If you just want to write tests with L, 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 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 has been set so that the pgTAP functions can be found in the "tap" schema. Consult the extensive L for a comprehensive list of test functions. =item * Run your tests with C 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 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 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 parameter is optional, since it's implicitly set by the use of the C parameter. All the other parameters are required as you see here. See the documentation for C for a complete list of options to the C key under C. And that's it. Now get testing! =back =head1 METHODS =head2 Class Methods =head3 C 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 a "suffix" config 0.9 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 ( my $suffix = $config->{suffix} ) { if (ref $suffix) { return (grep { $suf eq $_ } @{ $suffix }) ? 1 : 0; } 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 my $iterator = $class->make_iterator( $source ); Returns a new L 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, 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 The path to the C command. Defaults to simply "psql", which should work well enough if it's in your path. =item C 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 The PostgreSQL username to use to connect to PostgreSQL. If not specified, no username will be used, in which case C will fall back on either the C<$PGUSER> environment variable or, if not set, the system username. =item C 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 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 was compiled, usually 5432. =item C Specifies a hash of printing options in the style of C<\pset> in the C program. See the L for details on the supported options. =begin comment =item C 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=off --pset tuples_only=true --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 =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =back =head1 Support This module is managed in an open L. Feel free to fork and contribute, or to clone C and send patches! Found a bug? Please L or L a report! =head1 Author David E. Wheeler =head1 Copyright and License Copyright (c) 2010-2025 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 TAP-Parser-SourceHandler-pgTAP-3.37/t000755001751000166 014772312257 17252 5ustar00runnerdocker000000000000TAP-Parser-SourceHandler-pgTAP-3.37/t/source.pg000444001751000166 10514772312257 21213 0ustar00runnerdocker000000000000#!/usr/bin/perl print <<'END_TESTS'; 1..1 ok 1 - source.t END_TESTS TAP-Parser-SourceHandler-pgTAP-3.37/t/source_handler.t000444001751000166 1425114772312257 22614 0ustar00runnerdocker000000000000#!/usr/bin/perl -w use strict; use Test::More tests => 47; 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$ext" ); my @command = qw( --no-psqlrc --no-align --quiet --pset pager=off --pset tuples_only=true --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 => 'config_suffixes', meta => { is_file => 1, file => { lc_ext => '.foo' } }, config => { pgTAP => { suffix => [qw(.foo .bar)] } }, 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'; } } } } TAP-Parser-SourceHandler-pgTAP-3.37/t/bin000755001751000166 014772312257 20022 5ustar00runnerdocker000000000000TAP-Parser-SourceHandler-pgTAP-3.37/t/bin/psql000555001751000166 5114772312257 21020 0ustar00runnerdocker000000000000#!/usr/bin/perl print $_, $/ for @ARGV;