File Coverage

lib/Test/UniqueTestNames/Test.pm

Criterion	Covered	Total	%
statement	47	47	100.0
branch	18	18	100.0
condition	2	2	100.0
subroutine	11	11	100.0
pod	0	9	0.0
total	78	87	89.6

package Test::UniqueTestNames::Test;

use strict;
use warnings;

my $unnamed_ok = 0;

sub new {
    my ( $class, $name, $line_number ) = @_;

    die 'tests must have a line number' unless defined $line_number;

    my $self = {
        name         => $name || '',
        line_numbers => [ $line_number ],
    };

    return bless( $self, $class );
}

sub name {
    my ( $self ) = @_;

    return $self->{ name };
}

sub short_name {
    my ( $self ) = @_;

    my $name = $self->{ name };
    return $name if length $name < 40;

    substr($name, 40) = '...';
    return $name;
}

sub line_numbers {
    my ( $self ) = @_;

    my %line_frequency;
    for( @{ $self->{ line_numbers } } ) {
        $line_frequency{ $_ }++;
    }

    return \%line_frequency;
}

sub lowest_line_number {
    my ( $self ) = @_;

    my @sorted_line_numbers = sort @{ $self->{ line_numbers } };

    return $sorted_line_numbers[0];
}

sub add_line_number {
    my ( $self, $line_number ) = @_;

    die "add_line_number must be called on an instance" unless ref $self;

    push @{ $self->{ line_numbers } }, $line_number;
}

sub fails {
    my ( $self ) = @_;

    die "fails must be called on an instance" unless ref $self;

    return 0 if $self->name =~ /^The object isa/;

    if( $self->name eq '' ) {
        return $unnamed_ok
            ? 0
            : 1;
    }

    return 1 if @{ $self->{ line_numbers } } > 1;

    return 0;
}

sub unnamed_ok {
    my ( $self, $value ) = @_;

    $unnamed_ok = $value if defined $value;

    return $unnamed_ok;
}

sub occurrences {
    my ( $self ) = @_;

    my $occurrences = 0;

    $occurrences += $_ for values %{ $self->line_numbers };

    return $occurrences;
}

1;