view release on metacpan or  search on metacpan

lib/Benchmark/Dumb.pm  view on Meta::CPAN

        push @row, '--';
        next;
      }

      my $cmp = 100*$rate/$cmp_rate - 100;
      # skip the uncertainty if it's less than one permille
      # absolute or relative
      if ($cmp->raw_error->[0] < 1.e-1
          or ($cmp->raw_error->[0]+1.e-15)/$cmp->raw_number < 1.e-3)
      {
        my $rounded = Number::WithError::round_a_number($cmp->raw_number, -1);
        push @row, sprintf('%.1f', $rounded) . '%';
      }
      else {
        my $cmp_str = $bench->_rate_str($cmp).'%'; # abuse
        $cmp_str =~ s/\s+//g;
        push @row, $cmp_str;
      }
    }

    push @rows, \@row;
  }

  if (lc($style) ne 'none') {
    # find the max column lengths
    # could be done in the above iteration, too
    my $ncols = @{$rows[0]};
    my @col_len = ((0) x $ncols);
    foreach my $row (@rows) {
      foreach my $colno (0..$ncols-1) {
        $col_len[$colno] = length($row->[$colno])
          if length($row->[$colno]) > $col_len[$colno];
      }
    }

    my $format = join( ' ', map { "%${_}s" } @col_len) . "\n";
    substr( $format, 1, 0 ) = '-'; # right-align name

    foreach my $row (@rows) {
      printf($format,  @$row);
    }
  }

  return \@rows;
}


#####################################
# the fake-OO stuff
use Class::XSAccessor {
  getters => {
    _result => 'result',
    name    => 'name',
  },
};
# No. Users aren't meant to create new objects at this point.
sub _new {
  my $class = shift;
  $class = ref($class) if ref($class);
  my %args = @_;
  my $self = bless {} => $class;
  if (defined $args{instance}) {
    my $inst = $args{instance};
    $self->{name} = $inst->name;
    $self->{result} = $inst->result->new;
  }
  else {
    %$self = %args;
  }
  return $self;
}

sub iters {
  my $self = shift;
  return $self->_result->nsamples;
}

sub timesum {
  my $self = shift;
  my $other = shift;
  my $result = $self->_result + $other->_result;
  return $self->_new(result => $result, name => '');
}


sub timediff {
  my $self = shift;
  my $other = shift;
  my $result = $self->_result - $other->_result;
  return $self->_new(result => $result, name => '');
}

sub timestr {
  my $self = shift;
  my $style = shift || '';
  my $format = shift || '5.2f';

  $style = lc($style);
  return("") if $style eq 'none'; # what's the point?

  my $res = $self->_result;
  my $time = $res->number;
  my $err = $res->error->[0];
  my $rel = ($time > 0 ? $err/$time : 1) * 100;
  my $digits;
  if ($rel =~ /^([0\.]*)/) { # quick'n'dirty significant digits
    $digits = length($1) + 1;
  }
  $rel = sprintf("\%.${digits}f", $rel);

  my $rate = $self->_rate_str;
  my $str = "$time +- $err wallclock secs ($rel%) @ ($rate)/s (n=" . $res->nsamples . ")";

  return $str;
}

sub _rate_str {
  my $self = shift;
  my $per_sec = shift || $self->_rate;

  # The joys of people-not-enjoying-scientific-notation