1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
################################################################################
#
# $Project: /Convert-Binary-C $
# $Author: mhx $
# $Date: 2009/03/15 04:10:57 +0100 $
# $Revision: 15 $
# $Source: /tests/222_ieee.t $
#
################################################################################
#
# Copyright (c) 2002-2009 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
|
