From a52c82baf5317fe3d3f8fbb78cc68c253c63ae41 Mon Sep 17 00:00:00 2001 From: Lukas Mai Date: Mon, 6 Jan 2025 06:19:38 +0100 Subject: [PATCH] builtin: make inf/nan conditional depending on float support On some machines (VAX), the double type doesn't support Infinity/NaN values. Handle this case by making builtin::inf/builtin::nan throw a runtime error. Fixes #22882. --- builtin.c | 16 ++++++++++++++++ lib/builtin.pm | 8 +++++--- lib/builtin.t | 33 +++++++++++++++++++++++---------- pod/perldelta.pod | 8 ++++++++ pod/perldiag.pod | 10 ++++++++++ 5 files changed, 62 insertions(+), 13 deletions(-) diff --git a/builtin.c b/builtin.c index 57011f2e1fe3..7de4da5a02f7 100644 --- a/builtin.c +++ b/builtin.c @@ -96,8 +96,12 @@ XS(XS_builtin_inf) dXSARGS; if(items) croak_xs_usage(cv, ""); +#ifdef DOUBLE_HAS_INF EXTEND(SP, 1); XSRETURN_NV(NV_INF); +#else + Perl_croak_nocontext("builtin::inf not implemented"); +#endif } XS(XS_builtin_nan); @@ -106,8 +110,12 @@ XS(XS_builtin_nan) dXSARGS; if(items) croak_xs_usage(cv, ""); +#ifdef DOUBLE_HAS_NAN EXTEND(SP, 1); XSRETURN_NV(NV_NAN); +#else + Perl_croak_nocontext("builtin::nan not implemented"); +#endif } enum { @@ -135,8 +143,16 @@ static OP *ck_builtin_const(pTHX_ OP *entersubop, GV *namegv, SV *ckobj) switch(builtin->ckval) { case BUILTIN_CONST_FALSE: constval = &PL_sv_no; break; case BUILTIN_CONST_TRUE: constval = &PL_sv_yes; break; +#ifdef DOUBLE_HAS_INF case BUILTIN_CONST_INF: constval = newSVnv(NV_INF); break; +#else + case BUILTIN_CONST_INF: return entersubop; +#endif +#ifdef DOUBLE_HAS_NAN case BUILTIN_CONST_NAN: constval = newSVnv(NV_NAN); break; +#else + case BUILTIN_CONST_NAN: return entersubop; +#endif default: DIE(aTHX_ "panic: unrecognised builtin_const value %" IVdf, builtin->ckval); diff --git a/lib/builtin.pm b/lib/builtin.pm index f9455f40bc7a..d56bfb6f08f0 100644 --- a/lib/builtin.pm +++ b/lib/builtin.pm @@ -1,4 +1,4 @@ -package builtin 0.017; +package builtin 0.018; use v5.40; @@ -167,7 +167,8 @@ Available starting with Perl 5.36. This function is currently B. -Returns the floating-point infinity value. +Returns the floating-point infinity value. If the underlying numeric C type +does not support such a value, it throws a runtime error instead. Available starting with Perl 5.40. @@ -177,7 +178,8 @@ Available starting with Perl 5.40. This function is currently B. -Returns the floating-point "Not-a-Number" value. +Returns the floating-point "Not-a-Number" value. If the underlying numeric C +type does not support such a value, it throws a runtime error instead. Available starting with Perl 5.40. diff --git a/lib/builtin.t b/lib/builtin.t index 12a40e92eece..727c0180b0cc 100644 --- a/lib/builtin.t +++ b/lib/builtin.t @@ -8,6 +8,7 @@ BEGIN { use v5.36; no warnings 'experimental::builtin'; +use Config; package FetchStoreCounter { sub TIESCALAR($class, @args) { bless \@args, $class } @@ -55,19 +56,31 @@ package FetchStoreCounter { { use builtin qw( inf nan ); - ok(inf, 'inf is true'); - ok(inf > 1E10, 'inf is bigger than 1E10'); - ok(inf == inf, 'inf is equal to inf'); - ok(inf == inf + 1, 'inf is equal to inf + 1'); + if ($Config{d_double_has_inf}) { + ok(inf, 'inf is true'); + ok(inf > 1E10, 'inf is bigger than 1E10'); + ok(inf == inf, 'inf is equal to inf'); + ok(inf == inf + 1, 'inf is equal to inf + 1'); - # Invoke the real XSUB - my $inf = ( \&builtin::inf )->(); - ok($inf == $inf + 1, 'inf returned by real xsub'); + # Invoke the real XSUB + my $inf = ( \&builtin::inf )->(); + ok($inf == $inf + 1, 'inf returned by real xsub'); + } else { + is(eval { inf }, undef, 'inf throws'); + my $e = $@; + like($e, qr/^builtin::inf not implemented at/, 'inf fails with correct error'); + } - ok(nan != nan, 'NaN is not equal to NaN'); + if ($Config{d_double_has_nan}) { + ok(nan != nan, 'NaN is not equal to NaN'); - my $nan = ( \&builtin::nan )->(); - ok($nan != $nan, 'NaN returned by real xsub'); + my $nan = ( \&builtin::nan )->(); + ok($nan != $nan, 'NaN returned by real xsub'); + } else { + is(eval { nan }, undef, 'nan throws'); + my $e = $@; + like($e, qr/^builtin::nan not implemented at/, 'nan fails with correct error'); + } } # weakrefs diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 2d4881a6b6aa..b2d7b48f87f3 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -129,6 +129,14 @@ L has been upgraded from version A.xx to B.yy. XXX If there was something important to note about this change, include that here. +=item * + +L has been upgraded from version 0.017 to 0.018. + +On platforms that don't support Inf/NaN values in floating-point numbers (such +as VAX), C and C now throw a runtime error (rather +than breaking the perl build). [GH #22882] + =back =head2 Removed Modules and Pragmata diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 7f981e8008ff..c193c9711288 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -675,6 +675,16 @@ is currently being compiled. Since this method is used to introduce new lexical subroutines into the scope currently being compiled, this is not going to have any effect. +=item builtin::inf not implemented + +(F) Your machine doesn't support infinity as a numeric value (probably because +it's a VAX). + +=item builtin::nan not implemented + +(F) Your machine doesn't support NaN ("not a number") as a numeric value +(probably because it's a VAX). + =item Builtin version bundle "%s" is not supported by Perl (F) You attempted to C for a version number that is either