1*256a93a4Safresh1#!./perl 2*256a93a4Safresh1 3*256a93a4Safresh1# These Config-dependent tests were originally in t/opbasic/arith.t, 4*256a93a4Safresh1# but moved here because t/opbasic/* should not depend on sophisticated 5*256a93a4Safresh1# constructs like "use Config;". 6*256a93a4Safresh1 7*256a93a4Safresh1BEGIN { 8*256a93a4Safresh1 chdir 't' if -d 't'; 9*256a93a4Safresh1 require './test.pl'; 10*256a93a4Safresh1 set_up_inc('../lib'); 11*256a93a4Safresh1} 12*256a93a4Safresh1 13*256a93a4Safresh1use Config; 14*256a93a4Safresh1use strict; 15*256a93a4Safresh1 16*256a93a4Safresh1plan tests => 9; 17*256a93a4Safresh1 18*256a93a4Safresh1my $vms_no_ieee; 19*256a93a4Safresh1if ($^O eq 'VMS') { 20*256a93a4Safresh1 $vms_no_ieee = 1 unless defined($Config{useieee}); 21*256a93a4Safresh1} 22*256a93a4Safresh1 23*256a93a4Safresh1SKIP: 24*256a93a4Safresh1{ 25*256a93a4Safresh1 if ($^O eq 'vos') { 26*256a93a4Safresh1 skip "VOS raises SIGFPE instead of producing infinity", 1; 27*256a93a4Safresh1 } 28*256a93a4Safresh1 elsif ($vms_no_ieee || !$Config{d_double_has_inf}) { 29*256a93a4Safresh1 skip "the IEEE infinity model is unavailable in this configuration", 1; 30*256a93a4Safresh1 } 31*256a93a4Safresh1 # The computation of $v should overflow and produce "infinity" 32*256a93a4Safresh1 # on any system whose max exponent is less than 10**1506. 33*256a93a4Safresh1 # The exact string used to represent infinity varies by OS, 34*256a93a4Safresh1 # so we don't test for it; all we care is that we don't die. 35*256a93a4Safresh1 # 36*256a93a4Safresh1 # Perl considers it to be an error if SIGFPE is raised. 37*256a93a4Safresh1 # Chances are the interpreter will die, since it doesn't set 38*256a93a4Safresh1 # up a handler for SIGFPE. That's why this test is last; to 39*256a93a4Safresh1 # minimize the number of test failures. --PG 40*256a93a4Safresh1 41*256a93a4Safresh1 my $n = 5000; 42*256a93a4Safresh1 my $v = 2; 43*256a93a4Safresh1 while (--$n) { 44*256a93a4Safresh1 $v *= 2; 45*256a93a4Safresh1 } 46*256a93a4Safresh1 pass("infinity"); 47*256a93a4Safresh1} 48*256a93a4Safresh1 49*256a93a4Safresh1 50*256a93a4Safresh1# [perl #120426] 51*256a93a4Safresh1# small numbers shouldn't round to zero if they have extra floating digits 52*256a93a4Safresh1 53*256a93a4Safresh1SKIP: 54*256a93a4Safresh1{ 55*256a93a4Safresh1 skip "not IEEE", 8 unless $Config{d_double_style_ieee}; 56*256a93a4Safresh1 ok 0.153e-305 != 0.0, '0.153e-305'; 57*256a93a4Safresh1 ok 0.1530e-305 != 0.0, '0.1530e-305'; 58*256a93a4Safresh1 ok 0.15300e-305 != 0.0, '0.15300e-305'; 59*256a93a4Safresh1 ok 0.153000e-305 != 0.0, '0.153000e-305'; 60*256a93a4Safresh1 ok 0.1530000e-305 != 0.0, '0.1530000e-305'; 61*256a93a4Safresh1 ok 0.1530001e-305 != 0.0, '0.1530001e-305'; 62*256a93a4Safresh1 ok 1.17549435100e-38 != 0.0, 'min single'; 63*256a93a4Safresh1 # For flush-to-zero systems this may flush-to-zero, see PERL_SYS_FPU_INIT 64*256a93a4Safresh1 ok 2.2250738585072014e-308 != 0.0, 'min double'; 65*256a93a4Safresh1} 66