File Coverage

blib/lib/Test/C2FIT/ScientificDouble.pm

Criterion	Covered	Total	%
statement	25	29	86.2
branch	5	10	50.0
condition			n/a
subroutine	5	6	83.3
pod	0	6	0.0
total	35	51	68.6

# Copyright (c) 2002 Cunningham & Cunningham, Inc.
# Released under the terms of the GNU General Public License version 2 or later.
#
# Warning: not (yet) a general number usable in all calculations.
#
# Perl port by Martin Busik
#
package Test::C2FIT::ScientificDouble;

sub new {
    my $pkg       = shift;
    my $value     = shift;
    my $precision = precision($value);
    $pkg = ref($pkg) if ref($pkg);
    my $self = bless { value => $value, precision => $precision }, $pkg;
    return $self;
}

sub equals {
    my ( $self, $b ) = @_;
    return $self->compareTo($b) == 0;
}

sub toString {
    my $self = shift;
    return $self->{value};
}

sub precision {
    my $value = shift;
    $value =~ s/^\s+//;
    $value =~ s/\s+$//;

    my $bound = tweak($value);
    return abs( $bound - $value );
}

sub tweak {
    my $s   = shift;
    my $pos = index( lc($s), "e" );

    if ( $pos >= 0 ) {
        return tweak( substr( $s, 0, $pos ) ) . substr( $s, $pos );
    }
    if ( index( $s, "." ) >= 0 ) {
        return $s . "5";
    }
    return $s . ".5";
}

sub compareTo {
    my ( $self, $otherObj ) = @_;
    my $value = $self->{value};
    my $other = $otherObj->{value};

    my $diff = $value - $other;

    # warn "COMPARE TO: $value $other $self->{precision}\n";
    return -1 if $diff < -$self->{precision};
    return 1  if $diff > $self->{precision};

    # java code without perl equivalent:
    #   if (Double.isNaN(value) && Double.isNaN(other)) return 0;
    #   if (Double.isNaN(value)) return 1;
    #   if (Double.isNaN(other)) return -1;

    return 0;
}

1;