view release on metacpan or  search on metacpan

t/01.basic.t  view on Meta::CPAN

#!/usr/bin/perl
use strict;
use warnings;

use Test::More tests => 8646;

BEGIN {
    use_ok('AlignDB::IntSpan');
}

# Basic hash based set for testing

package TestSet;

sub new {
    return bless {}, shift;
}

sub add {
    my $self = shift;
    $self->{$_} = 1 for @_;
}

sub add_range {
    my $self = shift;
    die unless ( @_ % 2 ) == 0;
    while ( my ( $from, $to ) = splice( @_, 0, 2 ) ) {
        die unless $from <= $to;
        $self->add( $from .. $to );
    }
}

sub remove {
    my $self = shift;
    delete $self->{$_} for @_;
}

sub remove_range {
    my $self = shift;
    die unless ( @_ % 2 ) == 0;
    while ( my ( $from, $to ) = splice( @_, 0, 2 ) ) {
        die unless $from <= $to;
        $self->remove( $from .. $to );
    }
}

sub as_array_ref {
    my $self = shift;
    return [ sort { $a <=> $b } map { 1 * $_ } keys %$self ];
}

# Extend AlignDB::IntSpan

package AlignDB::IntSpan;

sub as_array_ref {
    my $self = shift;
    return [ $self->as_array() ];
}

sub is_sane {
    my $self = shift;
    my $last = undef;
    my $urk  = 0;
    my @ranges = $self->ranges();
    while ( @ranges ) {
        my $from = shift @ranges;
        my $to = shift @ranges;
        if ( $from > $to ) {
            warn "elements out of order ($from, $to)";
            $urk++;
        }
        if ( defined($last) && $from <= $last + 1 ) {
            warn "runs overlap ($last, $from)";
            $urk++;
        }