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