This file is indexed.

/usr/share/perl5/Test2/Tools/Ref.pm is in libtest2-suite-perl 0.000102-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
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
package Test2::Tools::Ref;
use strict;
use warnings;

our $VERSION = '0.000102';

use Scalar::Util qw/reftype refaddr/;
use Test2::API qw/context/;
use Test2::Util::Ref qw/render_ref/;

our @EXPORT = qw/ref_ok ref_is ref_is_not/;
use base 'Exporter';

sub ref_ok($;$$) {
    my ($thing, $wanttype, $name) = @_;
    my $ctx = context();

    my $gotname = render_ref($thing);
    my $gottype = reftype($thing);

    if (!$gottype) {
        $ctx->ok(0, $name, ["'$gotname' is not a reference"]);
        $ctx->release;
        return 0;
    }

    if ($wanttype && $gottype ne $wanttype) {
        $ctx->ok(0, $name, ["'$gotname' is not a '$wanttype' reference"]);
        $ctx->release;
        return 0;
    }

    $ctx->ok(1, $name);
    $ctx->release;
    return 1;
}

sub ref_is($$;$@) {
    my ($got, $exp, $name, @diag) = @_;
    my $ctx = context();

    $got = '<undef>' unless defined $got;
    $exp = '<undef>' unless defined $exp;

    my $bool = 0;
    if (!ref($got)) {
        $ctx->ok(0, $name, ["First argument '$got' is not a reference", @diag]);
    }
    elsif(!ref($exp)) {
        $ctx->ok(0, $name, ["Second argument '$exp' is not a reference", @diag]);
    }
    else {
        # Don't let overloading mess with us.
        $bool = refaddr($got) == refaddr($exp);
        $ctx->ok($bool, $name, ["'$got' is not the same reference as '$exp'", @diag]);
    }

    $ctx->release;
    return $bool ? 1 : 0;
}

sub ref_is_not($$;$) {
    my ($got, $exp, $name, @diag) = @_;
    my $ctx = context();

    $got = '<undef>' unless defined $got;
    $exp = '<undef>' unless defined $exp;

    my $bool = 0;
    if (!ref($got)) {
        $ctx->ok(0, $name, ["First argument '$got' is not a reference", @diag]);
    }
    elsif(!ref($exp)) {
        $ctx->ok(0, $name, ["Second argument '$exp' is not a reference", @diag]);
    }
    else {
        # Don't let overloading mess with us.
        $bool = refaddr($got) != refaddr($exp);
        $ctx->ok($bool, $name, ["'$got' is the same reference as '$exp'", @diag]);
    }

    $ctx->release;
    return $bool ? 1 : 0;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test2::Tools::Ref - Tools for validating references.

=head1 DESCRIPTION

This module contains tools that allow you to verify that something is a ref. It
also has tools to check if two refs are the same exact ref, or different. None of
the functions in this module do deep comparisons.

=head1 SYNOPSIS

    use Test2::Tools::Ref;

    # Ensure something is a ref.
    ref_ok($ref);

    # Check that $ref is a HASH reference
    ref_ok($ref, 'HASH', 'Must be a hash')

    ref_is($refa, $refb, "Same exact reference");

    ref_is_not($refa, $refb, "Not the same exact reference");

=head1 EXPORTS

All subs are exported by default.

=over 4

=item ref_ok($thing)

=item ref_ok($thing, $type)

=item ref_ok($thing, $type, $name)

This checks that C<$thing> is a reference. If C<$type> is specified then it
will check that C<$thing> is that type of reference.

=item ref_is($ref1, $ref2, $name)

Verify that two references are the exact same reference.

=item ref_is_not($ref1, $ref2, $name)

Verify that two references are not the exact same reference.

=back

=head1 SOURCE

The source code repository for Test2-Suite can be found at
F<https://github.com/Test-More/Test2-Suite/>.

=head1 MAINTAINERS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 AUTHORS

=over 4

=item Chad Granum E<lt>exodist@cpan.orgE<gt>

=back

=head1 COPYRIGHT

Copyright 2017 Chad Granum E<lt>exodist@cpan.orgE<gt>.

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See F<http://dev.perl.org/licenses/>

=cut