1#! perl -w
2
3# Test integer constants (DBL_DIG, DBL_MAX_EXP, FP_*, ...) are IV, not NV.
4
5use strict;
6use Test::More;
7use Devel::Peek;
8use POSIX;
9use Config;
10
11# Capture output from Devel::Peek::Dump() into Perl string
12sub capture_dump
13{
14    open my $olderr, '>&', *STDERR
15        or die "Can't save STDERR: $!";
16    my $str;
17    my $result = eval {
18        local $SIG{__DIE__};
19        close STDERR;
20        open STDERR, '>', \$str
21            or die "Can't redirect STDERR: $!";
22        Dump($_[0]);
23        1;
24    };
25    my $reason = $@;
26    open STDERR, '>&', $olderr
27        or die "Can't restore STDERR: $!";
28    $result or die $reason;
29    $str;
30}
31
32# Avoid die() in a test harness.
33sub capture_dump_in_test
34{
35    my $str;
36    eval { $str = capture_dump($_[0]); 1 } or BAIL_OUT $@;
37    $str;
38}
39
40sub is_iv ($$)
41{
42    # We would write "ok(SvIOK($_[0]), ...)",
43    # but unfortunately SvIOK is not available in Perl.
44
45    my $dump = capture_dump_in_test($_[0]);
46    #note($dump);
47    ok($dump =~ /^\h*FLAGS = .*\bIOK\b/m && $dump =~ /^\h*IV =/m, $_[1]);
48}
49
50my @tests = qw(EXIT_SUCCESS);
51
52push @tests, qw(FLT_RADIX FP_NORMAL FP_ZERO FP_SUBNORMAL FP_INFINITE FP_NAN);
53
54if ($Config{uselongdouble} ? $Config{d_ilogbl} : $Config{d_ilogb}) {
55    push @tests, qw(FP_ILOGB0);
56    push @tests, qw(FP_ILOGBNAN) if $Config{d_double_has_nan};
57}
58
59foreach my $flt ('FLT', 'DBL', ($Config{d_longdbl} ? ('LDBL') : ())) {
60    push @tests, "${flt}_$_"
61        foreach qw(DIG MANT_DIG MAX_10_EXP MAX_EXP MIN_10_EXP MIN_EXP);
62}
63
64push @tests, qw(FE_TONEAREST FE_TOWARDZERO FE_UPWARD FE_DOWNWARD)
65    if $Config{d_fegetround};
66
67is_iv(eval "POSIX::$_", "$_ is an integer") foreach @tests;
68
69SKIP: {
70    my $x;
71    skip $@, 1 unless eval '$x = FLT_ROUNDS; 1';
72    is_iv($x, 'FLT_ROUNDS is an integer');
73}
74
75done_testing();
76