In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d89b078ec109c9afe0d362eabf2ee60d10ed4213?hp=ee4b19b959afbc7b1778ed123bdc8612e6fb0cd6>
- Log ----------------------------------------------------------------- commit d89b078ec109c9afe0d362eabf2ee60d10ed4213 Author: Jarkko Hietaniemi <[email protected]> Date: Fri Jul 1 20:14:00 2016 -0400 If only miniperl, no use re for you. M t/re/reg_eval_scope.t commit 47918419113dff4cba30ab6146bd20044d8f0abb Author: Jarkko Hietaniemi <[email protected]> Date: Fri Jul 1 20:07:18 2016 -0400 If only miniperl, no use utf8 for you. M t/op/tr.t commit 15899733e6c3ba2d82e9b5373dabc6958554975c Author: Jarkko Hietaniemi <[email protected]> Date: Mon Jun 27 18:57:14 2016 -0400 VAX: test changes for VAX floats The hexfp (literals or %a) seems to be partially working: simple cases seem to work, but there are failures. M t/base/num.t M t/op/inc.t M t/op/infnan.t M t/op/numconvert.t M t/op/pack.t M t/op/sprintf.t M t/op/sprintf2.t M t/op/time.t M t/opbasic/arith.t commit a7157111fed730f765c2c281a61bcde95bacc9ed Author: Jarkko Hietaniemi <[email protected]> Date: Sat Jun 25 22:14:41 2016 -0400 VAX: code changes for VAX floats Mainly to avoid Inf and NaN, which VAX does does not have. There is something like Inf called "excess" but that is a deadly exception, seems to manifest itself in vax-netbsd either as a SIGFPE or SIGSEGV (pretty much untrappable at least from Perl level). The range of VAX floats is different from IEEE. There is positive zero, but no negative zero. M numeric.c M perl.h M pp_pack.c M sv.c commit c183cd86045c09fcbba056a606ae50f11c9c5b5a Author: Jarkko Hietaniemi <[email protected]> Date: Sat Jun 25 21:57:55 2016 -0400 VAX: Configure changes for VAX floats Detect the VAX floating point formats D and G. And the F float, but that is float (duh), never likely to be the double, but do it for consistency (we detect IEEE single precision floats, too). The T float and X float are the IEEE 64-bit and 128-bit, but those were available only on the Alpha. Tested on vax-netbsd. M Configure M config_h.SH M uconfig.h ----------------------------------------------------------------------- Summary of changes: Configure | 22 ++++++++++++++++++++-- config_h.SH | 6 ++++++ numeric.c | 35 ++++++++++++++++++++++++----------- perl.h | 45 +++++++++++++++++++++++++++++++++++++++++++-- pp_pack.c | 10 ++++++---- sv.c | 12 ++++++++---- t/base/num.t | 6 ++++-- t/op/inc.t | 5 +++++ t/op/infnan.t | 5 +++++ t/op/numconvert.t | 3 +++ t/op/pack.t | 15 ++++++++++----- t/op/sprintf.t | 37 +++++++++++++++++++++++++------------ t/op/sprintf2.t | 30 ++++++++++++++++++++---------- t/op/time.t | 6 +++++- t/op/tr.t | 8 ++++++-- t/opbasic/arith.t | 9 +++++++-- t/re/reg_eval_scope.t | 4 ++++ uconfig.h | 8 +++++++- 18 files changed, 208 insertions(+), 58 deletions(-) diff --git a/Configure b/Configure index 2b2cd07..89585f1 100755 --- a/Configure +++ b/Configure @@ -10127,6 +10127,11 @@ int main() { printf("2\n"); exit(0); } + if (b[0] == 0xCC && b[3] == 0xCC) { + /* VAX format F */ + printf("9\n"); + exit(0); + } #endif #if DOUBLESIZE == 8 if (b[0] == 0x9A && b[7] == 0xBF) { @@ -10153,6 +10158,16 @@ int main() { printf("8\n"); exit(0); } + if (b[0] == 0xCC && b[7] == 0xCC) { + /* VAX format D, 64-bit little-endian. */ + printf("10\n"); + exit(0); + } + if (b[0] == 0xD9 && b[7] == 0x99) { + /* VAX format G, 64-bit little-endian. */ + printf("11\n"); + exit(0); + } #endif #if DOUBLESIZE == 16 if (b[0] == 0x9A && b[15] == 0xBF) { @@ -10166,7 +10181,7 @@ int main() { exit(0); } #endif - /* Then there are old mainframe/miniframe formats like VAX, IBM, and CRAY. + /* Then there are old mainframe/miniframe formats like IBM, and CRAY. * Whether those environments can still build Perl is debatable. */ printf("-1\n"); /* unknown */ exit(0); @@ -10187,7 +10202,10 @@ case "$doublekind" in 6) echo "You have IEEE 754 128-bit big endian doubles." >&4 ;; 7) echo "You have IEEE 754 64-bit mixed endian doubles (32-bit LEs in BE)." >&4 ;; 8) echo "You have IEEE 754 64-bit mixed endian doubles (32-bit BEs in LE)." >&4 ;; -*) echo "Cannot figure out your double. You VAX, or something?" >&4 ;; +9) echo "You have VAX format F 32-bit little-endian doubles." >&4 ;; +10) echo "You have VAX format D 64-bit little-endian doubles." >&4 ;; +11) echo "You have VAX format G 64-bit little-endian doubles." >&4 ;; +*) echo "Cannot figure out your double. You CRAY, or something?" >&4 ;; esac $rm_try diff --git a/config_h.SH b/config_h.SH index 6e8cd3b..9d3b5d8 100755 --- a/config_h.SH +++ b/config_h.SH @@ -3965,6 +3965,9 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un * DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN * DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE * DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE + * DOUBLE_IS_VAX_F_FLOAT + * DOUBLE_IS_VAX_D_FLOAT + * DOUBLE_IS_VAX_G_FLOAT * DOUBLE_IS_UNKNOWN_FORMAT */ #define DOUBLEKIND $doublekind /**/ @@ -3976,6 +3979,9 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un #define DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN 6 #define DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE 7 #define DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE 8 +#define DOUBLE_IS_VAX_F_FLOAT 9 +#define DOUBLE_IS_VAX_D_FLOAT 10 +#define DOUBLE_IS_VAX_G_FLOAT 11 #define DOUBLE_IS_UNKNOWN_FORMAT -1 #$d_PRIfldbl PERL_PRIfldbl $sPRIfldbl /**/ #$d_PRIgldbl PERL_PRIgldbl $sPRIgldbl /**/ diff --git a/numeric.c b/numeric.c index f645502..5fc3df3 100644 --- a/numeric.c +++ b/numeric.c @@ -1138,7 +1138,7 @@ S_mulexp10(NV value, I32 exponent) * a hammer. Therefore we need to catch potential overflows before * it's too late. */ -#if ((defined(VMS) && !defined(_IEEE_FP)) || defined(_UNICOS)) && defined(NV_MAX_10_EXP) +#if ((defined(VMS) && !defined(_IEEE_FP)) || defined(_UNICOS) || defined(DOUBLE_IS_VAX_FLOAT)) && defined(NV_MAX_10_EXP) STMT_START { const NV exp_v = log10(value); if (exponent >= NV_MAX_10_EXP || exponent + exp_v >= NV_MAX_10_EXP) @@ -1185,7 +1185,11 @@ S_mulexp10(NV value, I32 exponent) result *= power; #ifdef FP_OVERFLOWS_TO_ZERO if (result == 0) +# ifdef NV_INF return value < 0 ? -NV_INF : NV_INF; +# else + return value < 0 ? -FLT_MAX : FLT_MAX; +# endif #endif /* Floating point exceptions are supposed to be turned off, * but if we're obviously done, don't risk another iteration. @@ -1247,6 +1251,7 @@ Perl_my_atof(pTHX_ const char* s) return x; } +#if defined(NV_INF) || defined(NV_NAN) #ifdef USING_MSVC6 # pragma warning(push) @@ -1276,8 +1281,6 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value /* If still here, we didn't have either NV_INF or NV_NAN, * and can try falling back to native strtod/strtold. * - * (Though, are our NV_INF or NV_NAN ever not defined?) - * * The native interface might not recognize all the possible * inf/nan strings Perl recognizes. What we can try * is to try faking the input. We will try inf/-inf/nan @@ -1286,36 +1289,44 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value const char* fake = NULL; char* endp; NV nv; +#ifdef NV_INF if ((infnan & IS_NUMBER_INFINITY)) { fake = ((infnan & IS_NUMBER_NEG)) ? "-inf" : "inf"; } - else if ((infnan & IS_NUMBER_NAN)) { +#endif +#ifdef NV_NAN + if ((infnan & IS_NUMBER_NAN)) { fake = "nan"; } +#endif assert(fake); nv = Perl_strtod(fake, &endp); if (fake != endp) { +#ifdef NV_INF if ((infnan & IS_NUMBER_INFINITY)) { -#ifdef Perl_isinf +# ifdef Perl_isinf if (Perl_isinf(nv)) *value = nv; -#else +# else /* last resort, may generate SIGFPE */ *value = Perl_exp((NV)1e9); if ((infnan & IS_NUMBER_NEG)) *value = -*value; -#endif +# endif return (char*)p; /* p, not endp */ } - else if ((infnan & IS_NUMBER_NAN)) { -#ifdef Perl_isnan +#endif +#ifdef NV_NAN + if ((infnan & IS_NUMBER_NAN)) { +# ifdef Perl_isnan if (Perl_isnan(nv)) *value = nv; -#else +# else /* last resort, may generate SIGFPE */ *value = Perl_log((NV)-1.0); -#endif +# endif return (char*)p; /* p, not endp */ +#endif } } } @@ -1327,6 +1338,8 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value # pragma warning(pop) #endif +#endif /* if defined(NV_INF) || defined(NV_NAN) */ + char* Perl_my_atof2(pTHX_ const char* orig, NV* value) { diff --git a/perl.h b/perl.h index a1dae95..3cb9739 100644 --- a/perl.h +++ b/perl.h @@ -5736,6 +5736,12 @@ EXTCONST bool PL_valid_types_NV_set[]; * Also, do NOT try doing NV_NAN based on NV_INF and trying (NV_INF-NV_INF). * Though logically correct, some compilers (like Visual C 2003) * falsely misoptimize that to zero (x-x is always zero, right?) + * + * Finally, note that not all floating point formats define Inf (or NaN). + * For the infinity a large number may be used instead. Operations that + * under the IEEE floating point would return Inf or NaN may return + * either large numbers (positive or negative), or they may cause + * a floating point exception or some other fault. */ /* The quadmath literals are anon structs which -Wc++-compat doesn't like. */ @@ -6743,6 +6749,14 @@ extern void moncontrol(int); #define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE #define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE|PERL_PV_ESCAPE_NONASCII +#if DOUBLEKIND == DOUBLE_IS_VAX_F_FLOAT || \ + DOUBLEKIND == DOUBLE_IS_VAX_D_FLOAT || \ + DOUBLEKIND == DOUBLE_IS_VAX_G_FLOAT +# define DOUBLE_IS_VAX_FLOAT +#else +# define DOUBLE_IS_IEEE_FORMAT +#endif + #if DOUBLEKIND == DOUBLE_IS_IEEE_754_32_BIT_LITTLE_ENDIAN || \ DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_LITTLE_ENDIAN || \ DOUBLEKIND == DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN @@ -6760,11 +6774,23 @@ extern void moncontrol(int); # define DOUBLE_MIX_ENDIAN #endif +/* Even though the VAX formats are kind of little-endian, + * they are not really fully little-endian like Intel IEEE, + * but neither they are really IEEE-mixed endian like the + * mixed-endian ARM IEEE formats (with swapped bytes). + * The VAX format ultimately come from PDP. */ + +#ifdef DOUBLE_IS_VAX_FLOAT +# define DOUBLE_VAX_ENDIAN +#endif + +#ifdef DOUBLE_IS_IEEE_FORMAT /* All the basic IEEE formats have the implicit bit, * except for the 80-bit extended formats, which will undef this. */ -#define NV_IMPLICIT_BIT +# define NV_IMPLICIT_BIT +#endif -#ifdef LONG_DOUBLEKIND +#if defined(LONG_DOUBLEKIND) && LONG_DOUBLEKIND != LONG_DOUBLE_IS_DOUBLE # if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN || \ LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN || \ @@ -6818,6 +6844,9 @@ extern void moncontrol(int); # ifdef DOUBLE_MIX_ENDIAN # define NV_MIX_ENDIAN # endif +# ifdef DOUBLE_VAX_ENDIAN +# define NV_VAX_ENDIAN +# endif #elif NVSIZE == LONG_DOUBLESIZE # ifdef LONGDOUBLE_LITTLE_ENDIAN # define NV_LITTLE_ENDIAN @@ -6830,6 +6859,13 @@ extern void moncontrol(int); # endif #endif +#ifdef DOUBLE_IS_IEEE_FORMAT +# define DOUBLE_HAS_INF +# define DOUBLE_HAS_NAN +#endif + +#ifdef DOUBLE_HAS_NAN + /* NaNs (not-a-numbers) can carry payload bits, in addition to * "nan-ness". Part of the payload is the quiet/signaling bit. * To back up a bit (harhar): @@ -6980,6 +7016,8 @@ extern void moncontrol(int); # elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE # define NV_NAN_QS_BYTE_OFFSET 5 /* bytes 3 2 1 0 7 6 5 4 (MSB 7) */ # else +/* For example the VAX formats should never + * get here because they do not have NaN. */ # error "Unexpected double format" # endif #endif @@ -7182,6 +7220,9 @@ extern void moncontrol(int); # error "Unexpected double format" # endif #endif + +#endif /* DOUBLE_HAS_NAN */ + /* (KEEP THIS LAST IN perl.h!) diff --git a/pp_pack.c b/pp_pack.c index f6964c3..891d2e2 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -2674,7 +2674,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) NV anv; fromstr = NEXTFROM; anv = SvNV(fromstr); -# if defined(VMS) && !defined(_IEEE_FP) +# if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT) /* IEEE fp overflow shenanigans are unavailable on VAX and optional * on Alpha; fake it if we don't have them. */ @@ -2684,15 +2684,17 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) afloat = -FLT_MAX; else afloat = (float)anv; # else -#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) +# if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) if(Perl_isnan(anv)) afloat = (float)NV_NAN; else -#endif +# endif +# ifdef NV_INF /* a simple cast to float is undefined if outside * the range of values that can be represented */ afloat = (float)(anv > FLT_MAX ? NV_INF : anv < -FLT_MAX ? -NV_INF : anv); +# endif # endif PUSH_VAR(utf8, cur, afloat, needs_swap); } @@ -2703,7 +2705,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) NV anv; fromstr = NEXTFROM; anv = SvNV(fromstr); -# if defined(VMS) && !defined(_IEEE_FP) +# if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT) /* IEEE fp overflow shenanigans are unavailable on VAX and optional * on Alpha; fake it if we don't have them. */ diff --git a/sv.c b/sv.c index 2ceec5a..1e294dd 100644 --- a/sv.c +++ b/sv.c @@ -2097,15 +2097,19 @@ S_sv_setnv(pTHX_ SV* sv, int numtype) { bool pok = cBOOL(SvPOK(sv)); bool nok = FALSE; +#ifdef NV_INF if ((numtype & IS_NUMBER_INFINITY)) { SvNV_set(sv, (numtype & IS_NUMBER_NEG) ? -NV_INF : NV_INF); nok = TRUE; - } - else if ((numtype & IS_NUMBER_NAN)) { + } else +#endif +#ifdef NV_NAN + if ((numtype & IS_NUMBER_NAN)) { SvNV_set(sv, NV_NAN); nok = TRUE; - } - else if (pok) { + } else +#endif + if (pok) { SvNV_set(sv, Atof(SvPVX_const(sv))); /* Purposefully no true nok here, since we don't want to blow * away the possible IOK/UV of an existing sv. */ diff --git a/t/base/num.t b/t/base/num.t index 8a61fb9..6ccc0cf 100644 --- a/t/base/num.t +++ b/t/base/num.t @@ -176,12 +176,14 @@ $a = 0.00049999999999999999999999999999999999999; $b = 0.0005000000000000000104; print $a <= $b ? "ok 46\n" : "not ok 46\n"; -if ($^O eq 'ultrix' || $^O eq 'VMS') { +if ($^O eq 'ultrix' || $^O eq 'VMS' || + (pack("d", 1) =~ /^[\x80\x10]\x40/) # VAX D_FLOAT, G_FLOAT. + ) { # Ultrix enters looong nirvana over this. VMS blows up when configured with # D_FLOAT (but with G_FLOAT or IEEE works fine). The test should probably # make the number of 0's a function of NV_DIG, but that's not in Config and # we probably don't want to suck Config into a base test anyway. - print "ok 47\n"; + print "ok 47 # skipped on $^O\n"; } else { $a = 0.00000000000000000000000000000000000000000000000000000000000000000001; print $a > 0 ? "ok 47\n" : "not ok 47\n"; diff --git a/t/op/inc.t b/t/op/inc.t index a98307a..e362ed1 100644 --- a/t/op/inc.t +++ b/t/op/inc.t @@ -191,6 +191,11 @@ SKIP: { ($Config{longdblkind} == 6 || $Config{longdblkind} == 5)) { skip "the double-double format is weird", 1; } + if ($Config{doublekind} == 9 || + $Config{doublekind} == 10 || + $Config{doublekind} == 11) { + skip "the VAX format is not IEEE", 1; + } # I'm sure that there's an IBM format with a 48 bit mantissa # IEEE doubles have a 53 bit mantissa diff --git a/t/op/infnan.t b/t/op/infnan.t index dc1ff22..06fb60d 100644 --- a/t/op/infnan.t +++ b/t/op/infnan.t @@ -16,6 +16,11 @@ BEGIN { # but Inf is completely broken (e.g. Inf + 0 -> NaN). skip_all "$^O with long doubles does not have sane inf/nan"; } + if ($Config{doublekind} == 9 || + $Config{doublekind} == 10 || + $Config{doublekind} == 11) { + skip_all "the doublekind $Config{doublekind} does not have inf/nan"; + } } my $PInf = "Inf" + 0; diff --git a/t/op/numconvert.t b/t/op/numconvert.t index bfdb488..e62cac3 100644 --- a/t/op/numconvert.t +++ b/t/op/numconvert.t @@ -39,6 +39,9 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; + if (pack("d", 1) =~ /^[\x80\10]\x40/) { + skip_all("VAX float cannot do infinity"); + } } use strict; diff --git a/t/op/pack.t b/t/op/pack.t index a2da636..df16464 100644 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -50,6 +50,8 @@ for my $size ( 16, 32, 64 ) { my $IsTwosComplement = pack('i', -1) eq "\xFF" x $Config{intsize}; print "# \$IsTwosComplement = $IsTwosComplement\n"; +my $vax_float = (pack("d", 1) =~ /^[\x80\x10]\x40/); + sub is_valid_error { my $err = shift; @@ -295,7 +297,7 @@ sub list_eq ($$) { # Is this a stupid thing to do on VMS, VOS and other unusual platforms? skip("-- the IEEE infinity model is unavailable in this configuration.", 1) - if (($^O eq 'VMS') && !defined($Config{useieee})); + if (($^O eq 'VMS') && !defined($Config{useieee}) || $vax_float); skip("-- $^O has serious fp indigestion on w-packed infinities", 1) if ( @@ -320,7 +322,7 @@ sub list_eq ($$) { SKIP: { skip("-- the full range of an IEEE double may not be available in this configuration.", 3) - if (($^O eq 'VMS') && !defined($Config{useieee})); + if (($^O eq 'VMS') && !defined($Config{useieee}) || $vax_float); skip("-- $^O does not like 2**1023", 3) if (($^O eq 'ultrix')); @@ -1340,7 +1342,7 @@ SKIP: { | [Bb] (?{ '101' }) | [Hh] (?{ 'b8' }) | [svnSiIlVNLqQjJ] (?{ 10111 }) - | [FfDd] (?{ 1.36514538e67 }) + | [FfDd] (?{ 1.36514538e37 }) | [pP] (?{ "try this buffer" }) /x; $^R } @codes; my @end = (0x12345678, 0x23456781, 0x35465768, 0x15263748); @@ -1531,8 +1533,11 @@ is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_ my (@y) = unpack("%b10a", "abcd"); is($x[1], $y[1], "checksum advance ok"); - # verify that the checksum is not overflowed with C0 - is(unpack("C0%128U", "abcd"), unpack("U0%128U", "abcd"), "checksum not overflowed"); + SKIP: { + skip("-- VAX float", 1) if $vax_float; + # verify that the checksum is not overflowed with C0 + is(unpack("C0%128U", "abcd"), unpack("U0%128U", "abcd"), "checksum not overflowed"); + } } my $U_1FFC_bytes = byte_utf8a_to_utf8n("\341\277\274"); diff --git a/t/op/sprintf.t b/t/op/sprintf.t index 7ccb88d..4aef466 100644 --- a/t/op/sprintf.t +++ b/t/op/sprintf.t @@ -111,18 +111,29 @@ for (@tests) { if ($comment =~ s/\s+skip:\s*(.*)//) { my $os = $1; my $osv = exists $Config{osvers} ? $Config{osvers} : "0"; + my $archname = $Config{archname}; # >comment skip: all< if ($os =~ /\ball\b/i) { $skip = 1; - # >comment skip: VMS hpux:10.20< - } elsif ($os =~ /\b$^O(?::(\S+))?\b/i) { - my $vsn = defined $1 ? $1 : "0"; - # Only compare on the the first pair of digits, as numeric - # compares do not like 2.6.10-3mdksmp or 2.6.8-24.10-default - s/^(\d+(\.\d+)?).*/$1/ for $osv, $vsn; - $skip = $vsn ? ($osv <= $vsn ? 1 : 0) : 1; + } elsif ($os =~ /\b$^O(?::(\S+))\b/i) { + my $cond = $1; + if ($cond =~ m{^/(.+)/$}) { + # >comment skip: solaris:/86/< + my $vsr = $1; + $skip = $Config{archname} =~ /$vsr/; + } elsif ($cond =~ /^\d/) { + # >comment skip: VMS hpux:10.20< + my $vsn = $cond; + # Only compare on the the first pair of digits, as numeric + # compares do not like 2.6.10-3mdksmp or 2.6.8-24.10-default + s/^(\d+(\.\d+)?).*/$1/ for $osv, $vsn; + $skip = $vsn ? ($osv <= $vsn ? 1 : 0) : 1; + } else { + # >comment skip: netbsd:vax-netbsd< + $skip = $cond eq $archname; + } } - $skip and $comment =~ s/$/, failure expected on $^O $osv/; + $skip and $comment =~ s/$/, failure expected on $^O $osv $archname/; } if ($x eq ">$result<") { @@ -163,9 +174,11 @@ for (@tests) { # # Tests that are expected to fail on a certain OS can be marked as such # by trailing the comment with a skip: section. Skips are tags separated -# bu space consisting of a $^O optionally trailed with :osvers. In the -# latter case, all os-levels below that are expected to fail. A special -# tag 'all' is allowed for todo tests that should fail on any system +# by space consisting of a $^O optionally trailed with :osvers or :archname. +# In the osvers case, all os-levels below that are expected to fail. +# In the archname case, an exact match is expected, unless the archname +# begins (and ends) with a "/", in which case a regexp is expected. +# A special tag 'all' is allowed for todo tests that should fail on any system # # >%G< >1234567e96< >1.23457E+102< >exponent too big skip: os390< # >%.0g< >-0.0< >-0< >No minus skip: MSWin32 VMS hpux:10.20< @@ -420,7 +433,7 @@ __END__ > %.0g< >[]< > 0 MISSING< >%.2g< >[]< >0 MISSING< >%.2gC< >[]< >0C MISSING< ->%.0g< >-0.0< >-0< >C99 standard mandates minus sign but C89 does not skip: MSWin32 VMS hpux:10.20 openbsd netbsd:1.5 irix darwin freebsd:4.9 android< +>%.0g< >-0.0< >-0< >C99 standard mandates minus sign but C89 does not skip: MSWin32 VMS netbsd:vax-netbsd hpux:10.20 openbsd netbsd:1.5 irix darwin freebsd:4.9 android< >%.0g< >12345.6789< >1e+04< >%#.0g< >12345.6789< >1.e+04< >%.2g< >12345.6789< >1.2e+04< diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t index 43ed919..d975630 100644 --- a/t/op/sprintf2.t +++ b/t/op/sprintf2.t @@ -529,10 +529,15 @@ for my $num (0, -1, 1) { } } -# test that %f doesn't panic with +Inf, -Inf, NaN [perl #45383] -foreach my $n (2**1e100, -2**1e100, 2**1e100/2**1e100) { # +Inf, -Inf, NaN - eval { my $f = sprintf("%f", $n); }; - is $@, "", "sprintf(\"%f\", $n)"; +my $vax_float = (pack("d", 1) =~ /^[\x80\x10]\x40/); + +SKIP: { + if ($vax_float) { skip "VAX float has no Inf or NaN", 3 } + # test that %f doesn't panic with +Inf, -Inf, NaN [perl #45383] + foreach my $n ('2**1e100', '-2**1e100', '2**1e100/2**1e100') { # +Inf, -Inf, NaN + eval { my $f = sprintf("%f", eval $n); }; + is $@, "", "sprintf(\"%f\", $n)"; + } } # test %ll formats with and without HAS_QUAD @@ -595,6 +600,9 @@ $o::count = 0; is $o::count, 0, 'sprintf %d string overload count is 0'; is $o::numcount, 1, 'sprintf %d number overload count is 1'; +SKIP: { # hexfp + if ($vax_float) { skip "VAX float no hexfp", scalar @hexfloat } + my $ppc_linux = $Config{archname} =~ /^(?:ppc|power(?:pc)?)(?:64)?-linux/; my $irix_ld = $Config{archname} =~ /^IP\d+-irix-ld$/; @@ -682,6 +690,8 @@ for my $t (@hexfloat) { ok($ok, "'$format' '$arg' -> '$result' cf '$expected'"); } +} # SKIP: # hexfp + # double-double long double %a special testing. SKIP: { skip("uselongdouble=" . ($Config{uselongdouble} ? 'define' : 'undef') @@ -696,17 +706,17 @@ SKIP: { && $^O eq 'linux' ); # [rt.perl.org 125633] - like(sprintf("%La\n", (2**1020) + (2**-1072)), + like(sprintf("%La\n", eval '(2**1020) + (2**-1072)'), qr/^0x1.0{522}1p\+1020$/); - like(sprintf("%La\n", (2**1021) + (2**-1072)), + like(sprintf("%La\n", eval '(2**1021) + (2**-1072)'), qr/^0x1.0{523}8p\+1021$/); - like(sprintf("%La\n", (2**1022) + (2**-1072)), + like(sprintf("%La\n", eval '(2**1022) + (2**-1072)'), qr/^0x1.0{523}4p\+1022$/); - like(sprintf("%La\n", (2**1023) + (2**-1072)), + like(sprintf("%La\n", eval '(2**1023) + (2**-1072)'), qr/^0x1.0{523}2p\+1023$/); - like(sprintf("%La\n", (2**1023) + (2**-1073)), + like(sprintf("%La\n", eval '(2**1023) + (2**-1073)'), qr/^0x1.0{523}1p\+1023$/); - like(sprintf("%La\n", (2**1023) + (2**-1074)), + like(sprintf("%La\n", eval '(2**1023) + (2**-1074)'), qr/^0x1.0{524}8p\+1023$/); } diff --git a/t/op/time.t b/t/op/time.t index d3b8b9c..c726ebf 100644 --- a/t/op/time.t +++ b/t/op/time.t @@ -239,7 +239,11 @@ SKIP: { #rt #73040 like $warning, qr/^localtime\($small_time_f\) failed/m; } -{ +my $is_vax = (pack("d", 1) =~ /^[\x80\x10]\x40/); +my $has_nan = !$is_vax; + +SKIP: { + skip("No NaN", 2) unless $has_nan; local $^W; is scalar gmtime("NaN"), undef, '[perl #123495] gmtime(NaN)'; is scalar localtime("NaN"), undef, 'localtime(NaN)'; diff --git a/t/op/tr.t b/t/op/tr.t index 6783dad..36858f4 100644 --- a/t/op/tr.t +++ b/t/op/tr.t @@ -1,14 +1,18 @@ # tr.t $|=1; -use utf8; - BEGIN { chdir 't' if -d 't'; require './test.pl'; set_up_inc('../lib'); + if (is_miniperl()) { + eval 'require utf8'; + skip_all("miniperl, no 'utf8'"); + } } +use utf8; + plan tests => 164; # Test this first before we extend the stack with other operations. diff --git a/t/opbasic/arith.t b/t/opbasic/arith.t index 7992260..8aa1e16 100644 --- a/t/opbasic/arith.t +++ b/t/opbasic/arith.t @@ -426,12 +426,13 @@ if ($^O eq 'VMS') { eval {require Config; import Config}; $vms_no_ieee = 1 unless defined($Config{useieee}); } +my $vax_float = (pack("d",1) =~ /^[\x80\x10]\x40/); if ($^O eq 'vos') { print "not ok ", $T++, " # TODO VOS raises SIGFPE instead of producing infinity.\n"; } -elsif ($vms_no_ieee) { - print $T++, " # SKIP -- the IEEE infinity model is unavailable in this configuration.\n" +elsif ($vms_no_ieee || $vax_float) { + print "ok ", $T++, " # SKIP -- the IEEE infinity model is unavailable in this configuration.\n" } elsif ($^O eq 'ultrix') { print "not ok ", $T++, " # TODO Ultrix enters deep nirvana instead of producing infinity.\n"; @@ -460,6 +461,9 @@ else { # [perl #120426] # small numbers shouldn't round to zero if they have extra floating digits +if ($vax_float) { +for (1..8) { print "ok ", $T++, " # SKIP -- VAX not IEEE\n" } +} else { try $T++, 0.153e-305 != 0.0, '0.153e-305'; try $T++, 0.1530e-305 != 0.0, '0.1530e-305'; try $T++, 0.15300e-305 != 0.0, '0.15300e-305'; @@ -469,6 +473,7 @@ try $T++, 0.1530001e-305 != 0.0, '0.1530001e-305'; try $T++, 1.17549435100e-38 != 0.0, 'min single'; # For flush-to-zero systems this may flush-to-zero, see PERL_SYS_FPU_INIT try $T++, 2.2250738585072014e-308 != 0.0, 'min double'; +} # string-to-nv should equal float literals try $T++, "1.23" + 0 == 1.23, '1.23'; diff --git a/t/re/reg_eval_scope.t b/t/re/reg_eval_scope.t index 2c176ef..25b90b6 100644 --- a/t/re/reg_eval_scope.t +++ b/t/re/reg_eval_scope.t @@ -6,6 +6,10 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; set_up_inc(qw(lib ../lib)); + if (is_miniperl()) { + eval 'require re'; + if ($@) { skip_all("miniperl, no 're'") } + } } plan 48; diff --git a/uconfig.h b/uconfig.h index 9c008fe..415ec7c 100644 --- a/uconfig.h +++ b/uconfig.h @@ -3930,6 +3930,9 @@ * DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN * DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE * DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE + * DOUBLE_IS_VAX_F_FLOAT + * DOUBLE_IS_VAX_D_FLOAT + * DOUBLE_IS_VAX_G_FLOAT * DOUBLE_IS_UNKNOWN_FORMAT */ #define DOUBLEKIND 3 /**/ @@ -3941,6 +3944,9 @@ #define DOUBLE_IS_IEEE_754_128_BIT_BIG_ENDIAN 6 #define DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE 7 #define DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE 8 +#define DOUBLE_IS_VAX_F_FLOAT 9 +#define DOUBLE_IS_VAX_D_FLOAT 10 +#define DOUBLE_IS_VAX_G_FLOAT 11 #define DOUBLE_IS_UNKNOWN_FORMAT -1 /*#define PERL_PRIfldbl "llf" / **/ /*#define PERL_PRIgldbl "llg" / **/ @@ -5253,6 +5259,6 @@ #endif /* Generated from: - * c14530f7567d861ce42d42446fc2ee9cd3625763f65867d5f42849c337bbc361 config_h.SH + * 8559c6ec4e935f6478ac3149c106aed3eacfd60544281f97fd1383110d8a5cce config_h.SH * 3b14c76342a834042da506e8c3b4269f7d545453079733cb740970ab9cc4294e uconfig.sh * ex: set ro: */ -- Perl5 Master Repository
