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
|
#! perl -w
# Test integer constants (DBL_DIG, DBL_MAX_EXP, FP_*, ...) are IV, not NV.
use strict;
use Test::More;
use Devel::Peek;
use POSIX;
use Config;
# Capture output from Devel::Peek::Dump() into Perl string
sub capture_dump
{
open my $olderr, '>&', *STDERR
or die "Can't save STDERR: $!";
my $str;
my $result = eval {
local $SIG{__DIE__};
close STDERR;
open STDERR, '>', \$str
or die "Can't redirect STDERR: $!";
Dump($_[0]);
1;
};
my $reason = $@;
open STDERR, '>&', $olderr
or die "Can't restore STDERR: $!";
$result or die $reason;
$str;
}
# Avoid die() in a test harness.
sub capture_dump_in_test
{
my $str;
eval { $str = capture_dump($_[0]); 1 } or BAIL_OUT $@;
$str;
}
sub is_iv ($$)
{
# We would write "ok(SvIOK($_[0]), ...)",
# but unfortunately SvIOK is not available in Perl.
my $dump = capture_dump_in_test($_[0]);
#note($dump);
ok($dump =~ /^\h*FLAGS = .*\bIOK\b/m && $dump =~ /^\h*IV =/m, $_[1]);
}
my @tests = qw(EXIT_SUCCESS);
push @tests, qw(FLT_RADIX FP_NORMAL FP_ZERO FP_SUBNORMAL FP_INFINITE FP_NAN);
if ($Config{uselongdouble} ? $Config{d_ilogbl} : $Config{d_ilogb}) {
push @tests, qw(FP_ILOGB0);
push @tests, qw(FP_ILOGBNAN) if $Config{d_double_has_nan};
}
foreach my $flt ('FLT', 'DBL', ($Config{d_longdbl} ? ('LDBL') : ())) {
push @tests, "${flt}_$_"
foreach qw(DIG MANT_DIG MAX_10_EXP MAX_EXP MIN_10_EXP MIN_EXP);
}
push @tests, qw(FE_TONEAREST FE_TOWARDZERO FE_UPWARD FE_DOWNWARD)
if $Config{d_fegetround};
is_iv(eval "POSIX::$_", "$_ is an integer") foreach @tests;
SKIP: {
my $x;
skip $@, 1 unless eval '$x = FLT_ROUNDS; 1';
is_iv($x, 'FLT_ROUNDS is an integer');
}
done_testing();
|
