/usr/share/perl5/Test2/Compare/Number.pm is in libtest2-suite-perl 0.000063-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 | package Test2::Compare::Number;
use strict;
use warnings;
use Carp qw/confess/;
use base 'Test2::Compare::Base';
our $VERSION = '0.000063';
use Test2::Util::HashBase qw/input/;
# Overloads '!' for us.
use Test2::Compare::Negatable;
sub init {
my $self = shift;
my $input = $self->{+INPUT};
confess "input must be defined for 'Number' check"
unless defined $input;
# Check for ''
confess "input must be a number for 'Number' check"
unless length($input) && $input =~ m/\S/;
$self->SUPER::init(@_);
}
sub name {
my $self = shift;
my $in = $self->{+INPUT};
return $in;
}
sub operator {
my $self = shift;
return '' unless @_;
my ($got) = @_;
return '' unless defined($got);
return '' unless length($got) && $got =~ m/\S/;
return '!=' if $self->{+NEGATE};
return '==';
}
sub verify {
my $self = shift;
my %params = @_;
my ($got, $exists) = @params{qw/got exists/};
return 0 unless $exists;
return 0 unless defined $got;
return 0 if ref $got;
return 0 unless length($got) && $got =~ m/\S/;
my $input = $self->{+INPUT};
my $negate = $self->{+NEGATE};
my @warnings;
my $out;
{
local $SIG{__WARN__} = sub { push @warnings => @_ };
$out = $negate ? ($input != $got) : ($input == $got);
}
for my $warn (@warnings) {
if ($warn =~ m/numeric/) {
$out = 0;
next; # This warning won't help anyone.
}
warn $warn;
}
return $out;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Test2::Compare::Number - Compare two values as numbers
=head1 DESCRIPTION
This is used to compare two numbers. You can also check that two numbers are not
the same.
B<Note>: This will fail if the received value is undefined. It must be a number.
B<Note>: This will fail if the comparison generates a non-numeric value warning
(which will not be shown). This is because it must get a number. The warning is
not shown as it will report to a useless line and filename. However, the test
diagnostics show both values.
=head1 SOURCE
The source code repository for Test2-Suite can be found at
F<http://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 2016 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
|