tlperl 5.24.1 from siep

git-svn-id: svn://tug.org/texlive/trunk@43914 c570f23f-e606-0410-a88d-b1316a301751

2 files changed, 495 insertions, 0 deletions

diff --git a/Master/tlpkg/tlperl/site/lib/Test/Fatal.pm b/Master/tlpkg/tlperl/site/lib/Test/Fatal.pm
new file mode 100644
index 00000000000..29aa6629fb3
--- /dev/null
+++ b/Master/tlpkg/tlperl/site/lib/Test/Fatal.pm
@@ -0,0 +1,364 @@
+use strict;
+use warnings;
+package Test::Fatal;
+# ABSTRACT: incredibly simple helpers for testing code with exceptions
+$Test::Fatal::VERSION = '0.014';
+#pod =head1 SYNOPSIS
+#pod
+#pod   use Test::More;
+#pod   use Test::Fatal;
+#pod
+#pod   use System::Under::Test qw(might_die);
+#pod
+#pod   is(
+#pod     exception { might_die; },
+#pod     undef,
+#pod     "the code lived",
+#pod   );
+#pod
+#pod   like(
+#pod     exception { might_die; },
+#pod     qr/turns out it died/,
+#pod     "the code died as expected",
+#pod   );
+#pod
+#pod   isa_ok(
+#pod     exception { might_die; },
+#pod     'Exception::Whatever',
+#pod     'the thrown exception',
+#pod   );
+#pod
+#pod =head1 DESCRIPTION
+#pod
+#pod Test::Fatal is an alternative to the popular L<Test::Exception>.  It does much
+#pod less, but should allow greater flexibility in testing exception-throwing code
+#pod with about the same amount of typing.
+#pod
+#pod It exports one routine by default: C<exception>.
+#pod
+#pod =cut
+
+use Carp ();
+use Try::Tiny 0.07;
+
+use Exporter 5.57 'import';
+
+our @EXPORT    = qw(exception);
+our @EXPORT_OK = qw(exception success dies_ok lives_ok);
+
+#pod =func exception
+#pod
+#pod   my $exception = exception { ... };
+#pod
+#pod C<exception> takes a bare block of code and returns the exception thrown by
+#pod that block.  If no exception was thrown, it returns undef.
+#pod
+#pod B<Achtung!>  If the block results in a I<false> exception, such as 0 or the
+#pod empty string, Test::Fatal itself will die.  Since either of these cases
+#pod indicates a serious problem with the system under testing, this behavior is
+#pod considered a I<feature>.  If you must test for these conditions, you should use
+#pod L<Try::Tiny>'s try/catch mechanism.  (Try::Tiny is the underlying exception
+#pod handling system of Test::Fatal.)
+#pod
+#pod Note that there is no TAP assert being performed.  In other words, no "ok" or
+#pod "not ok" line is emitted.  It's up to you to use the rest of C<exception> in an
+#pod existing test like C<ok>, C<isa_ok>, C<is>, et cetera.  Or you may wish to use
+#pod the C<dies_ok> and C<lives_ok> wrappers, which do provide TAP output.
+#pod
+#pod C<exception> does I<not> alter the stack presented to the called block, meaning
+#pod that if the exception returned has a stack trace, it will include some frames
+#pod between the code calling C<exception> and the thing throwing the exception.
+#pod This is considered a I<feature> because it avoids the occasionally twitchy
+#pod C<Sub::Uplevel> mechanism.
+#pod
+#pod B<Achtung!>  This is not a great idea:
+#pod
+#pod   sub exception_like(&$;$) {
+#pod       my ($code, $pattern, $name) = @_;
+#pod       like( &exception($code), $pattern, $name );
+#pod   }
+#pod
+#pod   exception_like(sub { }, qr/foo/, 'foo appears in the exception');
+#pod
+#pod If the code in the C<...> is going to throw a stack trace with the arguments to
+#pod each subroutine in its call stack (for example via C<Carp::confess>,
+#pod the test name, "foo appears in the exception" will itself be matched by the
+#pod regex.  Instead, write this:
+#pod
+#pod   like( exception { ... }, qr/foo/, 'foo appears in the exception' );
+#pod
+#pod B<Achtung>: One final bad idea:
+#pod
+#pod   isnt( exception { ... }, undef, "my code died!");
+#pod
+#pod It's true that this tests that your code died, but you should really test that
+#pod it died I<for the right reason>.  For example, if you make an unrelated mistake
+#pod in the block, like using the wrong dereference, your test will pass even though
+#pod the code to be tested isn't really run at all.  If you're expecting an
+#pod inspectable exception with an identifier or class, test that.  If you're
+#pod expecting a string exception, consider using C<like>.
+#pod
+#pod =cut
+
+our ($REAL_TBL, $REAL_CALCULATED_TBL) = (1, 1);
+
+sub exception (&) {
+  my $code = shift;
+
+  return try {
+    my $incremented = $Test::Builder::Level - $REAL_CALCULATED_TBL;
+    local $Test::Builder::Level = $REAL_CALCULATED_TBL;
+    if ($incremented) {
+        # each call to exception adds 5 stack frames
+        $Test::Builder::Level += 5;
+        for my $i (1..$incremented) {
+            # -2 because we want to see it from the perspective of the call to
+            # is() within the call to $code->()
+            my $caller = caller($Test::Builder::Level - 2);
+            if ($caller eq __PACKAGE__) {
+                # each call to exception adds 5 stack frames
+                $Test::Builder::Level = $Test::Builder::Level + 5;
+            }
+            else {
+                $Test::Builder::Level = $Test::Builder::Level + 1;
+            }
+        }
+    }
+
+    local $REAL_CALCULATED_TBL = $Test::Builder::Level;
+    $code->();
+    return undef;
+  } catch {
+    return $_ if $_;
+
+    my $problem = defined $_ ? 'false' : 'undef';
+    Carp::confess("$problem exception caught by Test::Fatal::exception");
+  };
+}
+
+#pod =func success
+#pod
+#pod   try {
+#pod     should_live;
+#pod   } catch {
+#pod     fail("boo, we died");
+#pod   } success {
+#pod     pass("hooray, we lived");
+#pod   };
+#pod
+#pod C<success>, exported only by request, is a L<Try::Tiny> helper with semantics
+#pod identical to L<C<finally>|Try::Tiny/finally>, but the body of the block will
+#pod only be run if the C<try> block ran without error.
+#pod
+#pod Although almost any needed exception tests can be performed with C<exception>,
+#pod success blocks may sometimes help organize complex testing.
+#pod
+#pod =cut
+
+sub success (&;@) {
+  my $code = shift;
+  return finally( sub {
+    return if @_; # <-- only run on success
+    $code->();
+  }, @_ );
+}
+
+#pod =func dies_ok
+#pod
+#pod =func lives_ok
+#pod
+#pod Exported only by request, these two functions run a given block of code, and
+#pod provide TAP output indicating if it did, or did not throw an exception. 
+#pod These provide an easy upgrade path for replacing existing unit tests based on
+#pod C<Test::Exception>.
+#pod
+#pod RJBS does not suggest using this except as a convenience while porting tests to
+#pod use Test::Fatal's C<exception> routine.
+#pod
+#pod   use Test::More tests => 2;
+#pod   use Test::Fatal qw(dies_ok lives_ok);
+#pod
+#pod   dies_ok { die "I failed" } 'code that fails';
+#pod
+#pod   lives_ok { return "I'm still alive" } 'code that does not fail';
+#pod
+#pod =cut
+
+my $Tester;
+
+# Signature should match that of Test::Exception
+sub dies_ok (&;$) {
+  my $code = shift;
+  my $name = shift;
+
+  require Test::Builder;
+  $Tester ||= Test::Builder->new;
+
+  my $ok = $Tester->ok( exception( \&$code ), $name );
+  $ok or $Tester->diag( "expected an exception but none was raised" );
+  return $ok;
+}
+
+sub lives_ok (&;$) {
+  my $code = shift;
+  my $name = shift;
+
+  require Test::Builder;
+  $Tester ||= Test::Builder->new;
+
+  my $ok = $Tester->ok( !exception( \&$code ), $name );
+  $ok or $Tester->diag( "expected return but an exception was raised" );
+  return $ok;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test::Fatal - incredibly simple helpers for testing code with exceptions
+
+=head1 VERSION
+
+version 0.014
+
+=head1 SYNOPSIS
+
+  use Test::More;
+  use Test::Fatal;
+
+  use System::Under::Test qw(might_die);
+
+  is(
+    exception { might_die; },
+    undef,
+    "the code lived",
+  );
+
+  like(
+    exception { might_die; },
+    qr/turns out it died/,
+    "the code died as expected",
+  );
+
+  isa_ok(
+    exception { might_die; },
+    'Exception::Whatever',
+    'the thrown exception',
+  );
+
+=head1 DESCRIPTION
+
+Test::Fatal is an alternative to the popular L<Test::Exception>.  It does much
+less, but should allow greater flexibility in testing exception-throwing code
+with about the same amount of typing.
+
+It exports one routine by default: C<exception>.
+
+=head1 FUNCTIONS
+
+=head2 exception
+
+  my $exception = exception { ... };
+
+C<exception> takes a bare block of code and returns the exception thrown by
+that block.  If no exception was thrown, it returns undef.
+
+B<Achtung!>  If the block results in a I<false> exception, such as 0 or the
+empty string, Test::Fatal itself will die.  Since either of these cases
+indicates a serious problem with the system under testing, this behavior is
+considered a I<feature>.  If you must test for these conditions, you should use
+L<Try::Tiny>'s try/catch mechanism.  (Try::Tiny is the underlying exception
+handling system of Test::Fatal.)
+
+Note that there is no TAP assert being performed.  In other words, no "ok" or
+"not ok" line is emitted.  It's up to you to use the rest of C<exception> in an
+existing test like C<ok>, C<isa_ok>, C<is>, et cetera.  Or you may wish to use
+the C<dies_ok> and C<lives_ok> wrappers, which do provide TAP output.
+
+C<exception> does I<not> alter the stack presented to the called block, meaning
+that if the exception returned has a stack trace, it will include some frames
+between the code calling C<exception> and the thing throwing the exception.
+This is considered a I<feature> because it avoids the occasionally twitchy
+C<Sub::Uplevel> mechanism.
+
+B<Achtung!>  This is not a great idea:
+
+  sub exception_like(&$;$) {
+      my ($code, $pattern, $name) = @_;
+      like( &exception($code), $pattern, $name );
+  }
+
+  exception_like(sub { }, qr/foo/, 'foo appears in the exception');
+
+If the code in the C<...> is going to throw a stack trace with the arguments to
+each subroutine in its call stack (for example via C<Carp::confess>,
+the test name, "foo appears in the exception" will itself be matched by the
+regex.  Instead, write this:
+
+  like( exception { ... }, qr/foo/, 'foo appears in the exception' );
+
+B<Achtung>: One final bad idea:
+
+  isnt( exception { ... }, undef, "my code died!");
+
+It's true that this tests that your code died, but you should really test that
+it died I<for the right reason>.  For example, if you make an unrelated mistake
+in the block, like using the wrong dereference, your test will pass even though
+the code to be tested isn't really run at all.  If you're expecting an
+inspectable exception with an identifier or class, test that.  If you're
+expecting a string exception, consider using C<like>.
+
+=head2 success
+
+  try {
+    should_live;
+  } catch {
+    fail("boo, we died");
+  } success {
+    pass("hooray, we lived");
+  };
+
+C<success>, exported only by request, is a L<Try::Tiny> helper with semantics
+identical to L<C<finally>|Try::Tiny/finally>, but the body of the block will
+only be run if the C<try> block ran without error.
+
+Although almost any needed exception tests can be performed with C<exception>,
+success blocks may sometimes help organize complex testing.
+
+=head2 dies_ok
+
+=head2 lives_ok
+
+Exported only by request, these two functions run a given block of code, and
+provide TAP output indicating if it did, or did not throw an exception. 
+These provide an easy upgrade path for replacing existing unit tests based on
+C<Test::Exception>.
+
+RJBS does not suggest using this except as a convenience while porting tests to
+use Test::Fatal's C<exception> routine.
+
+  use Test::More tests => 2;
+  use Test::Fatal qw(dies_ok lives_ok);
+
+  dies_ok { die "I failed" } 'code that fails';
+
+  lives_ok { return "I'm still alive" } 'code that does not fail';
+
+=head1 AUTHOR
+
+Ricardo Signes <rjbs@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by Ricardo Signes.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
diff --git a/Master/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm b/Master/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm
new file mode 100644
index 00000000000..e78ca0bc6dc
--- /dev/null
+++ b/Master/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm
@@ -0,0 +1,131 @@
+use strict;
+use warnings;
+package Test::RequiresInternet;
+$Test::RequiresInternet::VERSION = '0.05';
+# ABSTRACT: Easily test network connectivity
+
+
+use Socket;
+
+sub import {
+    skip_all("NO_NETWORK_TESTING") if env("NO_NETWORK_TESTING");
+
+    my $namespace = shift;
+
+    my $argc = scalar @_;
+    if ( $argc == 0 ) {
+        push @_, 'www.google.com', 80;
+    }
+    elsif ( $argc % 2 != 0 ) {
+        die "Must supply server and a port pairs. You supplied " . (join ", ", @_) . "\n";
+    }
+
+    while ( @_ ) {
+        my $host = shift;
+        my $port = shift;
+
+        local $@;
+
+        eval {make_socket($host, $port)};
+
+        if ( $@ ) {
+            skip_all("$@");
+        }
+    }
+}
+
+sub make_socket {
+    my ($host, $port) = @_;
+
+    my $portnum;
+    if ($port =~ /\D/) { 
+        $portnum = getservbyname($port, "tcp");
+    }
+    else {
+        $portnum = $port;
+    }
+
+    die "Could not find a port number for $port\n" if not $portnum;
+
+    my $iaddr = inet_aton($host) or die "no host: $host\n";
+
+    my $paddr = sockaddr_in($portnum, $iaddr);
+    my $proto = getprotobyname("tcp");
+
+    socket(my $sock, PF_INET, SOCK_STREAM, $proto) or die "socket: $!\n";
+    connect($sock, $paddr) or die "connect: $!\n";
+    close ($sock) or die "close: $!\n";
+
+    1;
+}
+
+sub env {
+    exists $ENV{$_[0]} && $ENV{$_[0]} eq '1'
+}
+
+sub skip_all {
+    my $reason = shift;
+    print "1..0 # Skipped: $reason";
+    exit 0;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test::RequiresInternet - Easily test network connectivity
+
+=head1 VERSION
+
+version 0.05
+
+=head1 SYNOPSIS
+
+  use Test::More;
+  use Test::RequiresInternet ('www.example.com' => 80, 'foobar.io' => 25);
+
+  # if you reach here, sockets successfully connected to hosts/ports above
+  plan tests => 1;
+
+  ok(do_that_internet_thing());
+
+=head1 OVERVIEW
+
+This module is intended to easily test network connectivity before functional 
+tests begin to non-local Internet resources.  It does not require any modules
+beyond those supplied in core Perl.
+
+If you do not specify a host/port pair, then the module defaults to using
+C<www.google.com> on port C<80>.  
+
+You may optionally specify the port by its name, as in C<http> or C<ldap>.
+If you do this, the test module will attempt to look up the port number
+using C<getservbyname>.
+
+If you do specify a host and port, they must be specified in B<pairs>. It is a
+fatal error to omit one or the other.
+
+If the environment variable C<NO_NETWORK_TESTING> is set, then the tests
+will be skipped without attempting any socket connections.
+
+If the sockets cannot connect to the specified hosts and ports, the exception
+is caught, reported and the tests skipped.
+
+=head1 AUTHOR
+
+Mark Allen <mrallen1@yahoo.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2014 by Mark Allen.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut