This file is indexed.

/usr/share/perl5/Test/Future.pm is in libfuture-perl 0.33-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2014-2015 -- leonerd@leonerd.org.uk

package Test::Future;

use strict;
use warnings;
use base qw( Test::Builder::Module );

our $VERSION = '0.33';

our @EXPORT = qw(
   no_pending_futures
);

use Scalar::Util qw( refaddr );

use constant HAVE_DEVEL_MAT_DUMPER => defined eval { require Devel::MAT::Dumper };

=head1 NAME

C<Test::Future> - unit test assertions for L<Future> instances

=head1 SYNOPSIS

 use Test::More tests => 2;
 use Test::Future;

 no_pending_futures {
    my $f = some_function();

    is( $f->get, "result", 'Result of the some_function()' );
 } 'some_function() leaves no pending Futures';

=head1 DESCRIPTION

This module provides unit testing assertions that may be useful when testing
code based on, or using L<Future> instances or subclasses.

=cut

=head1 FUNCTIONS

=cut

=head2 no_pending_futures

   no_pending_futures( \&code, $name )

I<Since version 0.29.>

Runs the given block of code, while keeping track of every C<Future> instance
constructed while doing so. After the code has returned, each of these
instances are inspected to check that they are not still pending. If they are
all either ready (by success or failure) or cancelled, the test will pass. If
any are still pending then the test fails.

If L<Devel::MAT> is installed, it will be used to write a memory state dump
after a failure. It will create a F<.pmat> file named the same as the unit
test, but with the trailing F<.t> suffix replaced with F<-TEST.pmat> where
C<TEST> is the number of the test that failed (in case there was more than
one). A list of addresses of C<Future> instances that are still pending is
also printed to assist in debugging the issue.

It is not an error if the code does not construct any C<Future> instances at
all. The block of code may contain other testing assertions; they will be run
before the assertion by C<no_pending_futures> itself.

=cut

sub no_pending_futures(&@)
{
   my ( $code, $name ) = @_;

   my @futures;

   no warnings 'redefine';

   my $new = Future->can( "new" );
   local *Future::new = sub {
      my $f = $new->(@_);
      push @futures, $f;
      $f->on_ready( sub {
         my $f = shift;
         for ( 0 .. $#futures ) {
            refaddr( $futures[$_] ) == refaddr( $f ) or next;

            splice @futures, $_, 1, ();
            return;
         }
      });
      return $f;
   };

   my $done = Future->can( "done" );
   local *Future::done = sub {
      my $f = $done->(@_);
      pop @futures if !ref $_[0]; # class method
      return $f;
   };

   my $fail = Future->can( "fail" );
   local *Future::fail = sub {
      my $f = $fail->(@_);
      pop @futures if !ref $_[0]; # class method
      return $f;
   };

   my $tb = __PACKAGE__->builder;

   $code->();

   my @pending = grep { !$_->is_ready } @futures;

   return $tb->ok( 1, $name ) if !@pending;

   my $ok = $tb->ok( 0, $name );

   $tb->diag( "The following Futures are still pending:" );
   $tb->diag( join ", ", map { sprintf "0x%x", refaddr $_ } @pending );

   if( HAVE_DEVEL_MAT_DUMPER ) {
      my $file = $0;
      my $num = $tb->current_test;

      # Trim the .t off first then append -$num.pmat, in case $0 wasn't a .t file
      $file =~ s/\.(?:t|pm|pl)$//;
      $file .= "-$num.pmat";

      $tb->diag( "Writing heap dump to $file" );
      Devel::MAT::Dumper::dump( $file );
   }

   return $ok;
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;