diff options
Diffstat (limited to 'gnu/usr.bin/perl/cpan/podlators/t/lib/Test')
4 files changed, 128 insertions, 85 deletions
diff --git a/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/Podlators.pm b/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/Podlators.pm index 3ae940924e2..9254f26468e 100644 --- a/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/Podlators.pm +++ b/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/Podlators.pm @@ -8,7 +8,7 @@ package Test::Podlators; -use 5.006; +use 5.008; use strict; use warnings; @@ -91,7 +91,6 @@ sub _stderr_restore { # For the format, see t/data/snippets/README. # # $path - Relative path to read test data from -# $encoding - Encoding of snippet (UTF-8 if not specified) # # Returns: Reference to hash of test data with the following keys: # name - Name of the test for status reporting @@ -101,20 +100,18 @@ sub _stderr_restore { # errors - Expected errors # exception - Text of exception (with file and line stripped) sub read_snippet { - my ($path, $encoding) = @_; + my ($path) = @_; $path = File::Spec->catfile('t', 'data', 'snippets', $path); - $encoding ||= 'UTF-8'; my %data; # Read the sections and store them in the %data hash. my ($line, $section); open(my $fh, '<', $path) or BAIL_OUT("cannot open $path: $!"); while (defined($line = <$fh>)) { - $line = decode($encoding, $line); if ($line =~ m{ \A \s* \[ (\S+) \] \s* \z }xms) { $section = $1; + $data{$section} = q{}; } elsif ($section) { - $data{$section} ||= q{}; $data{$section} .= $line; } } @@ -248,11 +245,17 @@ sub slurp { # $class - Class name of the formatter, as a string # $snippet - Path to the snippet file defining the test # $options_ref - Hash of options with the following keys: -# encoding - Set to use a non-standard encoding +# encoding - Expect the output to be in this non-standard encoding sub test_snippet { my ($class, $snippet, $options_ref) = @_; - my $encoding = defined($options_ref) ? $options_ref->{encoding} : undef; - my $data_ref = read_snippet($snippet, $encoding); + my $data_ref = read_snippet($snippet); + + # Determine the encoding to expect for the output portion of the snippet. + my $encoding; + if (defined($options_ref)) { + $encoding = $options_ref->{encoding}; + } + $encoding ||= 'UTF-8'; # Create the formatter object. my $parser = $class->new(%{ $data_ref->{options} }, name => 'TEST'); @@ -277,9 +280,10 @@ sub test_snippet { $got =~ s{ \n\s+ \z }{\n}xms; # Check the output, errors, and any exception. - is($got, $data_ref->{output}, "$data_ref->{name}: output"); - if ($data_ref->{errors}) { - is($stderr, $data_ref->{errors}, "$data_ref->{name}: errors"); + my $expected = decode($encoding, $data_ref->{output}); + is($got, $expected, "$data_ref->{name}: output"); + if ($data_ref->{errors} || $stderr) { + is($stderr, $data_ref->{errors} || q{}, "$data_ref->{name}: errors"); } if ($data_ref->{exception} || $exception) { if ($exception) { @@ -299,11 +303,19 @@ sub test_snippet { # $class - Class name of the formatter, as a string # $snippet - Path to the snippet file defining the test # $options_ref - Hash of options with the following keys: +# encoding - Expect the snippet to be in this non-standard encoding # perlio_utf8 - Set to 1 to set a PerlIO UTF-8 encoding on the output file sub test_snippet_with_io { my ($class, $snippet, $options_ref) = @_; my $data_ref = read_snippet($snippet); + # Determine the encoding to expect for the output portion of the snippet. + my $encoding; + if (defined($options_ref)) { + $encoding = $options_ref->{encoding}; + } + $encoding ||= 'UTF-8'; + # Create the formatter object. my $parser = $class->new(%{ $data_ref->{options} }, name => 'TEST'); isa_ok($parser, $class, 'Parser object'); @@ -317,7 +329,7 @@ sub test_snippet_with_io { my $input_file = File::Spec->catfile('t', 'tmp', "tmp$$.pod"); open(my $input, '>', $input_file) or BAIL_OUT("cannot create $input_file: $!"); - print {$input} encode('UTF-8', $data_ref->{input}) + print {$input} $data_ref->{input} or BAIL_OUT("cannot write to $input_file: $!"); close($input) or BAIL_OUT("cannot flush output to $input_file: $!"); @@ -336,20 +348,23 @@ sub test_snippet_with_io { $parser->parse_from_file($input_file, $output); close($output) or BAIL_OUT("cannot flush output to $output_file: $!"); - # Read back in the results, checking to ensure that we didn't output the - # accent definitions if we wrote UTF-8 output. + # Read back in the results. For Pod::Man, also ensure that we didn't + # output the accent definitions if we wrote UTF-8 output. open(my $results, '<', $output_file) or BAIL_OUT("cannot open $output_file: $!"); my ($line, $saw_accents); - while (defined($line = <$results>)) { - $line = decode('UTF-8', $line); - if ($line =~ m{ Accent [ ] mark [ ] definitions }xms) { - $saw_accents = 1; + if ($class eq 'Pod::Man') { + while (defined($line = <$results>)) { + $line = decode('UTF-8', $line); + if ($line =~ m{ Accent [ ] mark [ ] definitions }xms) { + $saw_accents = 1; + } + last if $line =~ m{ \A [.]nh }xms; } - last if $line =~ m{ \A [.]nh }xms; } my $saw = do { local $/ = undef; <$results> }; $saw = decode('UTF-8', $saw); + $saw =~ s{ \n\s+ \z }{\n}xms; close($results) or BAIL_OUT("cannot close output file: $!"); # Clean up. @@ -357,12 +372,18 @@ sub test_snippet_with_io { # Check the accent definitions and the output. my $perlio = $options_ref->{perlio_utf8} ? ' (PerlIO)' : q{}; + if ($class eq 'Pod::Man') { + is( + $saw_accents, + $data_ref->{options}{utf8} ? undef : 1, + "$data_ref->{name}: accent definitions$perlio" + ); + } is( - $saw_accents, - $data_ref->{options}{utf8} ? undef : 1, - "$data_ref->{name}: accent definitions$perlio" + $saw, + decode($encoding, $data_ref->{output}), + "$data_ref->{name}: output$perlio" ); - is($saw, $data_ref->{output}, "$data_ref->{name}: output$perlio"); return; } @@ -396,15 +417,12 @@ should be explicitly imported. =over 4 -=item read_snippet(PATH[, ENCODING]) +=item read_snippet(PATH) Read one test snippet from the provided relative file name and return it. The path should be relative to F<t/data/snippets>. For the format, see F<t/data/snippets/README>. -ENCODING, if present, specifies the encoding of the snippet. If not given, -the snippet is assumed to be encoded in C<UTF-8>. - The result will be a hash with the following keys: =over 4 @@ -489,7 +507,7 @@ it, and checking the results. Results are reported with Test::More. OPTIONS, if present, is a reference to a hash of options. Currently, only one key is supported: C<encoding>, which, if set, specifies the encoding of -the snippet. +the output portion of the snippet. =item test_snippet_with_io(CLASS, SNIPPET[, OPTIONS]) @@ -509,7 +527,7 @@ Russ Allbery <rra@cpan.org> =head1 COPYRIGHT AND LICENSE -Copyright 2015, 2016, 2018 Russ Allbery <rra@cpan.org> +Copyright 2015-2016, 2018-2020 Russ Allbery <rra@cpan.org> This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. diff --git a/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/RRA.pm b/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/RRA.pm index cbfdc42603c..1d5e4db23d4 100644 --- a/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/RRA.pm +++ b/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/RRA.pm @@ -10,25 +10,41 @@ package Test::RRA; -use 5.006; +use 5.008; +use base qw(Exporter); use strict; use warnings; -use Exporter; +use Carp qw(croak); use File::Temp; -use Test::More; -# For Perl 5.006 compatibility. -## no critic (ClassHierarchies::ProhibitExplicitISA) +# Abort if Test::More was loaded before Test::RRA to be sure that we get the +# benefits of the Test::More probing below. +if ($INC{'Test/More.pm'}) { + croak('Test::More loaded before Test::RRA'); +} + +# Red Hat's base perl package doesn't include Test::More (one has to install +# the perl-core package in addition). Try to detect this and skip any Perl +# tests if Test::More is not present. This relies on Test::RRA being included +# before Test::More. +eval { + require Test::More; + Test::More->import(); +}; +if ($@) { + print "1..0 # SKIP Test::More required for test\n" + or croak('Cannot write to stdout'); + exit 0; +} # Declare variables that should be set in BEGIN for robustness. -our (@EXPORT_OK, @ISA, $VERSION); +our (@EXPORT_OK, $VERSION); # Set $VERSION and everything export-related in a BEGIN block for robustness # against circular module loading (not that we load any modules, but # consistency is good). BEGIN { - @ISA = qw(Exporter); @EXPORT_OK = qw( is_file_contents skip_unless_author skip_unless_automated use_prereq ); @@ -36,7 +52,7 @@ BEGIN { # This version should match the corresponding rra-c-util release, but with # two digits for the minor version, including a leading zero if necessary, # so that it will sort properly. - $VERSION = '7.01'; + $VERSION = '8.01'; } # Compare a string to the contents of a file, similar to the standard is() @@ -61,22 +77,27 @@ sub is_file_contents { return; } - # Otherwise, we show a diff, but only if we have IPC::System::Simple. - eval { require IPC::System::Simple }; + # Otherwise, we show a diff, but only if we have IPC::System::Simple and + # diff succeeds. Otherwise, we fall back on showing the full expected and + # seen output. + eval { + require IPC::System::Simple; + + my $tmp = File::Temp->new(); + my $tmpname = $tmp->filename; + print {$tmp} $got or BAIL_OUT("Cannot write to $tmpname: $!\n"); + my @command = ('diff', '-u', $expected, $tmpname); + my $diff = IPC::System::Simple::capturex([0 .. 1], @command); + diag($diff); + }; if ($@) { - ok(0, $message); - return; + diag('Expected:'); + diag($expected); + diag('Seen:'); + diag($data); } - # They're not equal. Write out what we got so that we can run diff. - my $tmp = File::Temp->new(); - my $tmpname = $tmp->filename; - print {$tmp} $got or BAIL_OUT("Cannot write to $tmpname: $!\n"); - my @command = ('diff', '-u', $expected, $tmpname); - my $diff = IPC::System::Simple::capturex([0 .. 1], @command); - diag($diff); - - # Remove the temporary file and report failure. + # Report failure. ok(0, $message); return; } @@ -91,7 +112,7 @@ sub is_file_contents { sub skip_unless_author { my ($description) = @_; if (!$ENV{AUTHOR_TESTING}) { - plan skip_all => "$description only run for author"; + plan(skip_all => "$description only run for author"); } return; } @@ -110,7 +131,7 @@ sub skip_unless_automated { for my $env (qw(AUTOMATED_TESTING RELEASE_TESTING AUTHOR_TESTING)) { return if $ENV{$env}; } - plan skip_all => "$description normally skipped"; + plan(skip_all => "$description normally skipped"); return; } @@ -152,14 +173,14 @@ sub use_prereq { use $module $version \@imports; 1; }; - $error = $@; + $error = $@; $sigdie = $SIG{__DIE__} || undef; } # If the use failed for any reason, skip the test. if (!$result || $error) { my $name = length($version) > 0 ? "$module $version" : $module; - plan skip_all => "$name required for test"; + plan(skip_all => "$name required for test"); } # If the module set $SIG{__DIE__}, we cleared that via local. Restore it. @@ -202,6 +223,14 @@ This module collects utility functions that are useful for Perl test scripts. It assumes Russ Allbery's Perl module layout and test conventions and will only be useful for other people if they use the same conventions. +This module B<must> be loaded before Test::More or it will abort during +import. It will skip the test (by printing a skip message to standard output +and exiting with status 0, equivalent to C<plan skip_all>) during import if +Test::More is not available. This allows tests written in Perl using this +module to be skipped if run on a system with Perl but not Test::More, such as +Red Hat systems with the C<perl> package but not the C<perl-core> package +installed. + =head1 FUNCTIONS None of these functions are imported by default. The ones used by a script @@ -246,7 +275,9 @@ Russ Allbery <eagle@eyrie.org> =head1 COPYRIGHT AND LICENSE -Copyright 2013, 2014 The Board of Trustees of the Leland Stanford Junior +Copyright 2016, 2018-2019 Russ Allbery <eagle@eyrie.org> + +Copyright 2013-2014 The Board of Trustees of the Leland Stanford Junior University Permission is hereby granted, free of charge, to any person obtaining a copy diff --git a/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/RRA/Config.pm b/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/RRA/Config.pm index b2f94466dd2..80a15739410 100644 --- a/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/RRA/Config.pm +++ b/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/RRA/Config.pm @@ -9,24 +9,20 @@ package Test::RRA::Config; -use 5.006; +use 5.008; +use base qw(Exporter); use strict; use warnings; -# For Perl 5.006 compatibility. -## no critic (ClassHierarchies::ProhibitExplicitISA) - -use Exporter; use Test::More; # Declare variables that should be set in BEGIN for robustness. -our (@EXPORT_OK, @ISA, $VERSION); +our (@EXPORT_OK, $VERSION); # Set $VERSION and everything export-related in a BEGIN block for robustness # against circular module loading (not that we load any modules, but # consistency is good). BEGIN { - @ISA = qw(Exporter); @EXPORT_OK = qw( $COVERAGE_LEVEL @COVERAGE_SKIP_TESTS @CRITIC_IGNORE $LIBRARY_PATH $MINIMUM_VERSION %MINIMUM_VERSION @MODULE_VERSION_IGNORE @@ -36,7 +32,7 @@ BEGIN { # This version should match the corresponding rra-c-util release, but with # two digits for the minor version, including a leading zero if necessary, # so that it will sort properly. - $VERSION = '7.01'; + $VERSION = '8.01'; } # If C_TAP_BUILD or C_TAP_SOURCE are set in the environment, look for @@ -187,9 +183,9 @@ Russ Allbery <eagle@eyrie.org> =head1 COPYRIGHT AND LICENSE -Copyright 2015, 2016 Russ Allbery <eagle@eyrie.org> +Copyright 2015-2016, 2019 Russ Allbery <eagle@eyrie.org> -Copyright 2013, 2014 The Board of Trustees of the Leland Stanford Junior +Copyright 2013-2014 The Board of Trustees of the Leland Stanford Junior University Permission is hereby granted, free of charge, to any person obtaining a copy diff --git a/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/RRA/ModuleVersion.pm b/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/RRA/ModuleVersion.pm index 3b3d6742df9..fc8bfbc8de5 100644 --- a/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/RRA/ModuleVersion.pm +++ b/gnu/usr.bin/perl/cpan/podlators/t/lib/Test/RRA/ModuleVersion.pm @@ -8,32 +8,28 @@ package Test::RRA::ModuleVersion; -use 5.006; +use 5.008; +use base qw(Exporter); use strict; use warnings; -use Exporter; use File::Find qw(find); use Test::More; use Test::RRA::Config qw(@MODULE_VERSION_IGNORE); -# For Perl 5.006 compatibility. -## no critic (ClassHierarchies::ProhibitExplicitISA) - # Declare variables that should be set in BEGIN for robustness. -our (@EXPORT_OK, @ISA, $VERSION); +our (@EXPORT_OK, $VERSION); # Set $VERSION and everything export-related in a BEGIN block for robustness # against circular module loading (not that we load any modules, but # consistency is good). BEGIN { - @ISA = qw(Exporter); @EXPORT_OK = qw(test_module_versions update_module_versions); # This version should match the corresponding rra-c-util release, but with # two digits for the minor version, including a leading zero if necessary, # so that it will sort properly. - $VERSION = '7.01'; + $VERSION = '8.01'; } # A regular expression matching the version string for a module using the @@ -129,21 +125,23 @@ sub _module_version { # Throws: Text exception on I/O failure or inability to find version sub _update_module_version { my ($file, $version) = @_; - open(my $in, q{<}, $file) or die "$0: cannot open $file: $!\n"; - open(my $out, q{>}, "$file.new") - or die "$0: cannot create $file.new: $!\n"; - # If the version starts with v, use it without quotes. Otherwise, quote - # it to prevent removal of trailing zeroes. - if ($version !~ m{ \A v }xms) { - $version = "'$version'"; + # The old-style syntax may require different quoting. If the version + # starts with v, use it without quotes. Otherwise, quote it to prevent + # removal of trailing zeroes. + my $old_version = $version; + if ($old_version !~ m{ \A v }xms) { + $old_version = "'$old_version'"; } # Scan for the version and replace it. + open(my $in, q{<}, $file) or die "$0: cannot open $file: $!\n"; + open(my $out, q{>}, "$file.new") + or die "$0: cannot create $file.new: $!\n"; SCAN: while (defined(my $line = <$in>)) { if ( $line =~ s{ $REGEX_VERSION_PACKAGE }{$1$version$3}xms - || $line =~ s{ $REGEX_VERSION_OLD }{$1$version$3}xms) + || $line =~ s{ $REGEX_VERSION_OLD }{$1$old_version$3}xms) { print {$out} $line or die "$0: cannot write to $file.new: $!\n"; last SCAN; @@ -153,8 +151,8 @@ sub _update_module_version { # Copy the rest of the input file to the output file. print {$out} <$in> or die "$0: cannot write to $file.new: $!\n"; - close($out) or die "$0: cannot flush $file.new: $!\n"; - close($in) or die "$0: error reading from $file: $!\n"; + close($out) or die "$0: cannot flush $file.new: $!\n"; + close($in) or die "$0: error reading from $file: $!\n"; # All done. Rename the new file over top of the old file. rename("$file.new", $file) @@ -267,7 +265,7 @@ Russ Allbery <eagle@eyrie.org> =head1 COPYRIGHT AND LICENSE -Copyright 2016 Russ Allbery <eagle@eyrie.org> +Copyright 2016, 2018-2019 Russ Allbery <eagle@eyrie.org> Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal |