################################################################################
#
# Copyright (c) 2002-2015 Marcus Holland-Moritz. All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
################################################################################

use Test;
use Convert::Binary::C @ARGV;

$^W = 1;

BEGIN {
  plan tests => 50;
}

$reason = Convert::Binary::C::feature('ieeefp') ? '' : 'no IEEE floating point';

$SIG{__WARN__} = sub { push @warn, $_[0] };

my $c = eval { new Convert::Binary::C };
skip($reason,$@,'');

# check with reference data
while( <DATA> ) {

  s/^\s*//; s/\s*$//; s/#.*//;
  /\S/ or next;
  my($value, $double, $single) = split /\s*\|\s*/;
  my $sb = hex2str( $single );
  my $db = hex2str( $double );
  my $sl = reverse $sb;
  my $dl = reverse $db;
  my($u,$p);

  print "# checking $value\n";

  # Single Precision, BigEndian
  $c->FloatSize( length $sb )->ByteOrder( 'BigEndian' );

  $p = $c->pack('float', $value);
  printf "# pack(\$value) => %s\n", hexdump($p);
  skip( $reason, $p, $sb );

  $u = $c->unpack('float', $sb);
  print "# unpack(\$sb) => $u\n";
  skip( $reason, delta_ok( $value, $u, 1e-7 ) );

  # Double Precision, BigEndian
  $c->FloatSize( length $db )->ByteOrder( 'BigEndian' );

  $p = $c->pack('float', $value);
  printf "# pack(\$value) => %s\n", hexdump($p);
  skip( $reason, $p, $db );

  $u = $c->unpack('float', $db);
  print "# unpack(\$db) => $u\n";
  skip( $reason, delta_ok( $value, $u, 1e-15 ) );

  # Single Precision, LittleEndian
  $c->FloatSize( length $sl )->ByteOrder( 'LittleEndian' );

  $p = $c->pack('float', $value);
  printf "# pack(\$value) => %s\n", hexdump($p);
  skip( $reason, $p, $sl );

  $u = $c->unpack('float', $sl);
  print "# unpack(\$sl) => $u\n";
  skip( $reason, delta_ok( $value, $u, 1e-7 ) );

  # Double Precision, LittleEndian
  $c->FloatSize( length $dl )->ByteOrder( 'LittleEndian' );

  $p = $c->pack('float', $value);
  printf "# pack(\$value) => %s\n", hexdump($p);
  skip( $reason, $p, $dl );

  $u = $c->unpack('float', $dl);
  print "# unpack(\$dl) => $u\n";
  skip( $reason, delta_ok( $value, $u, 1e-15 ) );

}

skip( $reason, scalar @warn, 0, "unexpected warnings" );


sub delta_ok
{
  my($ref, $val, $delta) = @_;

  abs($val-$ref) <= $delta * abs($ref) and return 1;

  # catch the different cases of 'infinity'
  $ref > 1e10 and $val !~ /^[+-]?\d*(?:\.\d*)(?:[eE][+-]?\d+)?$/ and return 1;

  return 0;
}

sub hex2str { pack 'C*', map hex, split ' ', $_[0] }
sub hexdump { join ' ', map { sprintf '%02X', $_ } unpack 'C*', $_[0] }

__DATA__

-1.0            | BF F0 00 00 00 00 00 00 | BF 80 00 00
 0.0            | 00 00 00 00 00 00 00 00 | 00 00 00 00
 0.4            | 3F D9 99 99 99 99 99 9A | 3E CC CC CD
 1.0            | 3F F0 00 00 00 00 00 00 | 3F 80 00 00
 3.1415926535   | 40 09 21 FB 54 41 17 44 | 40 49 0F DB
 1.220703125e-4 | 3F 20 00 00 00 00 00 00 | 39 00 00 00
