view release on metacpan or search on metacpan
NEG_INF
NEG_SNAN_FIRST NEG_SNAN_LAST
NEG_IND NEG_QNAN_FIRST NEG_QNAN_LAST
);
my @EXPORT_INFO = qw(isSignMinus isNormal isFinite isZero isSubnormal
isInfinite isNaN isSignaling isSignalingConvertedToQuiet isCanonical
class radix totalOrder totalOrderMag compareFloatingValue compareFloatingMag);
my @EXPORT_SIGNBIT = qw(copy negate abs copySign isSignMinus);
our @EXPORT_OK = (@EXPORT_FLOATING, @EXPORT_RAW754, @EXPORT_ULP, @EXPORT_CONST, @EXPORT_INFO, @EXPORT_SIGNBIT);
our %EXPORT_TAGS = (
The first three nibbles (hexadecimal digits) encode the sign and the exponent. The sign is
the most significant bit of the three nibbles (so AND the first nibble with 8; if it's true,
the number is negative, else it's positive). The remaining 11 bits of the nibbles encode the
exponent: convert the 11bits to decimal, then subtract 1023. If the resulting exponent is -1023,
it indicates a zero or denormal value; if the exponent is +1024, it indicates an infinite (Inf) or
not-a-number (NaN) value, which are generally used to indicate the calculation has grown to large
to fit in an IEEE754 double (Inf) or has tried an performed some other undefined operation (divide
by zero or the logarithm of a zero or negative value) (NaN).
The final thirteen nibbles are the encoding of the fractional value (usually C<1 + thirteennibbles /
16**13>, unless it's zero, denormal, infinite, or not a number).
Of course, this is easier to decode using the L</to_dec_floatingpoint()> function, which interprets
NEG_SNAN_LAST # -0x1.#SNAN00000000p+0000 # negative signaling NAN with "0x7FFFFFFFFFFFF" as the system-dependent information [*]
NEG_IND # -0x1.#IND000000000p+0000 # negative quiet NAN with "0x8000000000000" as the system-dependent information [%]
NEG_QNAN_FIRST # -0x1.#QNAN00000000p+0000 # negative quiet NAN with "0x8000000000001" as the system-dependent information
NEG_QNAN_LAST # -0x1.#QNAN00000000p+0000 # negative quiet NAN with "0xFFFFFFFFFFFFF" as the system-dependent information
[*] note that many perl interpreters will internally convert Signalling NaN (SNAN) to Quiet NaN (QNAN)
[%] some perl interpreters define the zeroeth negative Quiet NaN, NEG_IND, as an "indeterminate" value (IND);
in a symmetrical world, they would also define the zeroeth positive Quiet NaN, POS_IND, as an "indeterminate" value (IND)
=cut
{ my $local; sub POS_ZERO () { $local = hexstr754_to_double('000'.'0000000000000') unless defined $local; return $local; } }
{ my $local; sub POS_DENORM_SMALLEST() { $local = hexstr754_to_double('000'.'0000000000001') unless defined $local; return $local; } }
C<nextUp(I<value>)>; if I<direction> is numerically below I<float>, return C<nextDown(I<value>)>.
=cut
sub nextAfter {
return $_[0] if $_[0] != $_[0]; # return value when value is NaN
return $_[1] if $_[1] != $_[1]; # return direction when direction is NaN
return $_[1] if $_[1] == $_[0]; # return direction when the two are equal
return nextUp($_[0]) if $_[1] > $_[0]; # return nextUp if direction > value
return nextDown($_[0]); # otherwise, return nextDown()
}
information about the floating-point value: most define whether a value is a special condition of
floating-point or not (such as normal, finite, zero, ...).
=head3 isSignMinus( I<value> )
Returns 1 if I<value> has negative sign (even applies to zeroes and NaNs); otherwise, returns 0.
=cut
sub isSignMinus {
# look at leftmost nibble, and determine whether it has the 8-bit or not (which is the sign bit)
return (hex(substr(hexstr754_from_double(shift),0,1)) & 8) >> 3;
}
=head3 isNormal( I<value> )
Returns 1 if I<value> is a normal number (not zero, subnormal, infinite, or NaN); otherwise, returns 0.
=cut
sub isNormal {
# it's normal if the leftmost three nibbles (excluding sign bit) are not 000 or 7FF
return (0 < $exp) && ($exp < 0x7FF) || 0;
}
=head3 isFinite( I<value> )
Returns 1 if I<value> is a finite number (zero, subnormal, or normal; not infinite or NaN); otherwise, returns 0.
=cut
sub isFinite {
# it's finite if the leftmost three nibbles (excluding sign bit) are not 7FF
return ($str eq '0'x15) || 0;
}
=head3 isSubnormal( I<value> )
Returns 1 if I<value> is subnormal (not zero, normal, infinite, nor NaN); otherwise, returns 0.
=cut
sub isSubnormal {
# it's subnormal if it's 0x[80]00___ and the last 13 digits are not all zero
return ($exp eq '000' || $exp eq '800') && ($frc ne '0'x13) || 0;
}
=head3 isInfinite( I<value> )
Returns 1 if I<value> is positive or negative infinity (not zero, subnormal, normal, nor NaN); otherwise, returns 0.
=cut
sub isInfinite {
# it's infinite if it's 0x[F7]FF_0000000000000
my $exp = substr($h,0,3);
my $frc = substr($h,3,13);
return ($exp eq '7FF' || $exp eq 'FFF') && ($frc eq '0'x13) || 0;
}
=head3 isNaN( I<value> )
Returns 1 if I<value> is NaN (not zero, subnormal, normal, nor infinite); otherwise, returns 0.
=cut
sub isNaN {
# it's infinite if it's 0x[F7]FF_0000000000000
my $h = hexstr754_from_double(shift);
my $exp = substr($h,0,3);
my $frc = substr($h,3,13);
return ($exp eq '7FF' || $exp eq 'FFF') && ($frc ne '0'x13) || 0;
}
=head3 isSignaling( I<value> )
Returns 1 if I<value> is a signaling NaN (not zero, subnormal, normal, nor infinite), otherwise, returns 0.
Note that some perl implementations convert some or all signaling NaNs to quiet NaNs, in which case,
C<isSignaling> might return only 0.
=cut
sub isSignaling {
# it's signaling if isNaN and MSB of fractional portion is 1
my $h = hexstr754_from_double(shift);
my $exp = substr($h,0,3);
my $frc = substr($h,3,13);
my $qbit = (0x8 && hex(substr($h,3,1))) >> 3; # 1: quiet, 0: signaling
return ($exp eq '7FF' || $exp eq 'FFF') && ($frc ne '0'x13) && (!$qbit) || 0; # v0.013_007 = possible coverage bug: don't know whether it's the paren or non-paren, but the "LEFT=TRUE" condition of "OR 2 CONDITIONS" is never covered
}
=head4 isSignalingConvertedToQuiet()
Returns 1 if your implementation of perl converts a SignalingNaN to a QuietNaN, otherwise returns 0.
This is I<not> a standard IEEE 754 function; but this is used to determine if the C<isSignaling()>
function is meaningful in your implementation of perl.
=cut
=head3 class( I<value> )
Returns the "class" of the I<value>:
signalingNaN
quietNaN
negativeInfinity
negativeNormal
negativeSubnormal
negativeZero
positiveZero
positiveInfinity
=cut
sub class {
return 'signalingNaN' if isSignaling($_[0]); # v0.013 coverage note: ignore Devel::Cover failures on this line (won't return on systems that quiet SNaNs
return 'quietNaN' if isNaN($_[0]);
return 'negativeInfinity' if isInfinite($_[0]) && isSignMinus($_[0]);
return 'negativeNormal' if isNormal($_[0]) && isSignMinus($_[0]);
return 'negativeSubnormal' if isSubnormal($_[0]) && isSignMinus($_[0]);
return 'negativeZero' if isZero($_[0]) && isSignMinus($_[0]);
return 'positiveZero' if isZero($_[0]) && !isSignMinus($_[0]); # v0.013 coverage note: ignore Devel::Cover->CONDITION failure; alternate condition already returned above
Returns TRUE if I<x> E<le> I<y>, FALSE if I<x> E<gt> I<y>.
Special cases are ordered as below:
-quietNaN < -signalingNaN < -infinity < ...
... < -normal < -subnormal < -zero < ...
... < +zero < +subnormal < +normal < ...
... < +infinity < +signalingNaN < +quietNaN
=cut
sub totalOrder {
my ($x, $y) = @_[0,1];
my ($bx,$by) = map { binstr754_from_double($_) } $x, $y; # convert to binary strings
my @xsegs = ($bx =~ /(.)(.{11})(.{20})(.{32})/); # split into sign, exponent, MSB, LSB
my @ysegs = ($by =~ /(.)(.{11})(.{20})(.{32})/); # split into sign, exponent, MSB, LSB
my ($xin, $yin) = map { isNaN($_) } $x, $y; # determine if NaN: used twice each, so save the values rather than running twice each during if-switch
if( $xin && $yin ) { # BOTH NaN
# use a trick: the rules for both-NaN treat it as if it's just another floating point,
# so lie about the exponent and do a normal comparison
($bx, $by) = map { $_->[1] = '1' . '0'x10; join '', @$_ } \@xsegs, \@ysegs;
($x, $y) = map { binstr754_to_double($_) } $bx, $by;
return (($x <= $y) || 0);
} elsif ( $xin ) { # just x NaN: TRUE if x is NEG
return ( ($xsegs[0]) || 0 );
} elsif ( $yin ) { # just y NaN: TRUE if y is not NEG
return ( (!$ysegs[0]) || 0 );
} elsif ( isZero($x) && isZero($y) ) { # both zero: TRUE if x NEG, or if x==y
# trick = -signbit(x) <= -signbit(y), since signbit is 1 for negative, -signbit = -1 for negative
return ( (-$xsegs[0] <= -$ysegs[0]) || 0 );
} else { # numeric comparison (works for inf, normal, subnormal, or only one +/-zero)
totalOrder( abs(x), abs(y) )
Special cases are ordered as below:
zero < subnormal < normal < infinity < signalingNaN < quietNaN
=cut
sub totalOrderMag {
my ($x, $y) = @_[0,1];
These are similar to C<totalOrder()> and C<totalOrderMag()>, except they return
-1 for C<x E<lt> y>, 0 for C<x == y>, and +1 for C<x E<gt> y>.
These are not in IEEE 754-2008, but are included as functions to replace the perl spaceship
(C<E<lt>=E<gt>>) when comparing floating-point values that might be NaN.
=cut
sub compareFloatingValue {
my ($x, $y) = @_[0,1];
my ($bx,$by) = map { binstr754_from_double($_) } $x, $y; # convert to binary strings
my @xsegs = ($bx =~ /(.)(.{11})(.{20})(.{32})/); # split into sign, exponent, MSB, LSB
my @ysegs = ($by =~ /(.)(.{11})(.{20})(.{32})/); # split into sign, exponent, MSB, LSB
my ($xin, $yin) = map { isNaN($_) } $x, $y; # determine if NaN: used twice each, so save the values rather than running twice each during if-switch
if( $xin && $yin ) { # BOTH NaN
# use a trick: the rules for both-NaN treat it as if it's just another floating point,
# so lie about the exponent and do a normal comparison
($bx, $by) = map { $_->[1] = '1' . '0'x10; join '', @$_ } \@xsegs, \@ysegs;
($x, $y) = map { binstr754_to_double($_) } $bx, $by;
return ($x <=> $y);
} elsif ( $xin ) { # just x NaN: if isNaN(x) && isNegative(x) THEN -1 (x<y) ELSE (x>y)
return ( ($xsegs[0])*-1 || +1 );
} elsif ( $yin ) { # just y NaN: if isNaN(y) && !isNegative(y) THEN -1 (x<y) ELSE (x>y)
return ( (!$ysegs[0])*-1 || +1 );
} elsif ( isZero($x) && isZero($y) ) { # both zero: TRUE if x NEG, or if x==y
# trick = -signbit(x) <=> -signbit(y), since signbit is 1 for negative, -signbit = -1 for negative
return (-$xsegs[0] <=> -$ysegs[0]);
} else { # numeric comparison (works for inf, normal, subnormal, or only one +/-zero)
These functions, from IEEE Std 754-2008, manipulate the sign bits
of the argument(s)set P.
See IEEE Std 754-2008 #5.5.1 "Sign bit operations": This section asserts
that the sign bit operations (including C<negate>, C<abs>, and C<copySign>)
should only affect the sign bit, and should treat numbers and NaNs alike.
=head3 copy( I<value> )
Copies the I<value> to the output, leaving the sign bit unchanged, for all
numbers and NaNs.
=cut
sub copy {
return shift;
=head3 negate( I<value> )
Reverses the sign bit of I<value>. (If the sign bit is set on I<value>,
it will not be set on the output, and vice versa; this will work on
signed zeroes, on infinities, and on NaNs.)
=cut
sub negate {
my $b = binstr754_from_double(shift); # convert to binary string
module-based function to get the absolute value (magnitude) of a 64bit
floating-point number.
The C<CORE::abs()> function behaves properly (per the IEEE 754 description)
for all classes of I<value>, except that many implementations do not correctly
handle -NaN properly, outputting -NaN, which is in violation of the standard.
The C<Data::IEEE754::Tools::abs()> function correctly treats NaNs in the same
way it treats numerical values, and clears the sign bit on the output.
Please note that exporting C<abs()> or C<:signbit> from this module will
"hide" the builtin C<abs()> function. If you really need to use the builtin
version (for example, you care more about execution speed than its ability to find
the absolute value of a signed NaN), then you may call it as C<CORE::abs>.
=cut
sub abs {
my $b = binstr754_from_double(shift); # convert to binary string
=item * L<Perlmonks: Integers sometimes turn into Reals after substraction|http://perlmonks.org/?node_id=1163025> for
inspiring me to go down the IEEE754-expansion trail in perl.
=item * L<Perlmonks: Exploring IEEE754 floating point bit patterns|http://perlmonks.org/?node_id=984141> as a resource
for how perl interacts with the various "edge cases" (+/-infinity, L<denormalized numbers|https://en.wikipedia.org/wiki/Denormal_number>,
signaling and quiet L<NaNs (Not-A-Number)|https://en.wikipedia.org/wiki/NaN>.
=item * L<Data::IEEE754>: I really wanted to use this module, but it didn't get me very far down the "Tools" track,
and included a lot of overhead modules for its install/test that I didn't want to require for B<Data::IEEE754::Tools>.
However, I was inspired by his byteorder-dependent anonymous subs (which were in turn derived from L<Data::MessagePack::PP>);
they were more efficient, on a per-call-to-subroutine basis, than my original inclusion of the if(byteorder) in every call to
view all matches for this distribution
view release on metacpan or search on metacpan
share/js/00-sprintf.min.js view on Meta::CPAN
/*! sprintf-js v1.1.2 | Copyright (c) 2007-present, Alexandru MÄrÄÈteanu <hello@alexei.ro> | BSD-3-Clause */
!function(){"use strict";var g={not_string:/[^s]/,not_bool:/[^t]/,not_type:/[^T]/,not_primitive:/[^v]/,number:/[diefg]/,numeric_arg:/[bcdiefguxX]/,json:/[j]/,not_json:/[^j]/,text:/^[^\x25]+/,modulo:/^\x25{2}/,placeholder:/^\x25(?:([1-9]\d*)\$|\(([^)]...
//# sourceMappingURL=sprintf.min.js.map
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Data/JSONSchema/Ajv/src.pm view on Meta::CPAN
=cut
__DATA__
/* ajv 6.8.1: Another JSON Schema Validator */
!function(e){if("object"==typeof exports&&"undefined"!=typeof module)module.exports=e();else if("function"==typeof define&&define.amd)define([],e);else{("undefined"!=typeof window?window:"undefined"!=typeof global?global:"undefined"!=typeof self?self...
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Data/JavaScript/Anon.pm view on Meta::CPAN
@ISA = 'Class::Default';
$errstr = '';
# Attempt to define a single, all encompasing,
# regex for detecting a legal JavaScript number.
# We do not support the exotic values, such as Infinite and NaN.
my $_sci = qr/[eE](?:\+|\-)?\d+/; # The scientific notation exponent ( e.g. 'e+12' )
my $_dec = qr/\.\d+/; # The decimal section ( e.g. '.0212' )
my $_int = qr/(?:[1-9]\d*|0)/; # The integers section ( e.g. '2312' )
my $real = qr/(?:$_int(?:$_dec)?|$_dec)(?:$_sci)?/; # Merge the integer, decimal and scientific parts
my $_hex = qr/0[xX][0-9a-fA-F]+/; # Hexidecimal notation
lib/Data/JavaScript/Anon.pm view on Meta::CPAN
When generating the javascript, numbers will be printed directly and not
quoted. The C<is_a_number> method provides convenient access to the test
that is used to see if something is a number. The test handles just about
everything legal in JavaScript, with the one exception of the exotics, such
as Infinite, -Infinit and NaN.
Returns true is a scalar is numeric, or false otherwise.
You may also access method in using an instantiated object.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Data/JavaScript.pm view on Meta::CPAN
for undefined values. You may define your own default--for either version--at
compile time by supplying the default value on the C<use> line:
use Data::JavaScript {JS=>1.1, UNDEF=>'null'};
Other useful values might be C<0>, C<null>, or C<NaN>.
=head1 EXPORT
In addition, althought the module no longer uses Exporter, it heeds its
import conventions; C<qw(:all>), C<()>, etc.
view all matches for this distribution
view release on metacpan or search on metacpan
s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
s++;
}
sawinf = 1;
} else if (*s == 'N' || *s == 'n') {
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++;
sawnan = 1;
} else
view all matches for this distribution
view release on metacpan or search on metacpan
xt/timeout_validation.t view on Meta::CPAN
use Time::HiRes qw(time);
use Data::Log::Shared;
plan skip_all => 'AUTHOR_TESTING not set' unless $ENV{AUTHOR_TESTING};
# Boundary timeouts: negative, +Inf, NaN. None should crash; results
# should match documented behavior or croak cleanly.
my $h = Data::Log::Shared->new(undef, 4096);
# Run each timeout in a child to detect signal-death.
xt/timeout_validation.t view on Meta::CPAN
my $r2 = run_child('inf timeout',
sub { local $SIG{ALRM} = sub { _exit(0) }; alarm 1; $h->wait_for(0, "Inf"+0) });
isnt $r2, 'signal_11', "inf timeout: no SIGSEGV (got $r2)";
isnt $r2, 'signal_6', "inf timeout: no SIGABRT (got $r2)";
# NaN: implementation-defined, must not crash
my $r3 = run_child('nan timeout',
sub { local $SIG{ALRM} = sub { _exit(0) }; alarm 1; $h->wait_for(0, "NaN"+0) });
isnt $r3, 'signal_11', "NaN timeout: no SIGSEGV (got $r3)";
isnt $r3, 'signal_6', "NaN timeout: no SIGABRT (got $r3)";
done_testing;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Data/MATFile.pm view on Meta::CPAN
sub double_from_hex { unpack 'd', scalar reverse pack 'H*', $_[0] }
use constant POS_INF => double_from_hex '7FF0000000000000';
use constant NEG_INF => double_from_hex 'FFF0000000000000';
use constant NaN => double_from_hex '7FF8000000000000';
sub parse_double
{
my ($bytes) = @_;
my ($bottom, $top) = unpack ("LL", $bytes);
lib/Data/MATFile.pm view on Meta::CPAN
elsif ($top == 0xfff00000) {
return NEG_INF;
}
}
elsif ($top == 0x7ff00000) {
return NaN;
}
my $sign = $top >> 31;
# print "$sign\n";
my $exponent = (($top >> 20) & 0x7FF) - 1023;
# print "$exponent\n";
view all matches for this distribution
view release on metacpan or search on metacpan
t/test-mails/josey-fold view on Meta::CPAN
On Nov 13, 9:56am in "Re: Defect in XBD lr", Joanna Farley wrote:
> Sun's expert in this area after some discussions with a colleague
> outside of Sun concluded that for lround, to align with both C99 and SUS
> changes of the following form were necessary:
>
> + If x is +/-Inf/NaN, a domain error occurs, and
> + errno is set to EDOM in MATH_ERRNO mode;
> + the invalid exception is raised in MATH_ERREXCEPT mode.
> [to align with C99 Annex F.4]
>
> + If x is too large to be represented as a long, a *range* error
t/test-mails/josey-fold view on Meta::CPAN
>
> Andrew Josey wrote:
> >
> > The text referred to is MX shaded and part of the ISO 60559 floating
> > point option. I do not think changing the Domain Error to a Range Error
> > is the fix or at least not the fix for the NaN and +-Inf cases. ISO C
> > 99 describes the range error case if the magnitude of x is too large as a
> > may fail. I'll ask Fred T for his thoughts on this one...
> > regards
> > Andrew
> >
view all matches for this distribution
view release on metacpan or search on metacpan
msgpack-3.3.0/test/msgpack_basic.cpp view on Meta::CPAN
v.push_back(nanf("tag"));
if (numeric_limits<float>::has_infinity) {
v.push_back(numeric_limits<float>::infinity());
v.push_back(-numeric_limits<float>::infinity());
}
if (numeric_limits<float>::has_quiet_NaN) {
v.push_back(numeric_limits<float>::quiet_NaN());
}
if (numeric_limits<float>::has_signaling_NaN) {
v.push_back(numeric_limits<float>::signaling_NaN());
}
for (unsigned int i = 0; i < kLoop; i++) {
v.push_back(static_cast<float>(msgpack_rand()));
v.push_back(static_cast<float>(-msgpack_rand()));
msgpack-3.3.0/test/msgpack_basic.cpp view on Meta::CPAN
v.push_back(nanf("tag"));
if (numeric_limits<double>::has_infinity) {
v.push_back(numeric_limits<double>::infinity());
v.push_back(-numeric_limits<double>::infinity());
}
if (numeric_limits<double>::has_quiet_NaN) {
v.push_back(numeric_limits<double>::quiet_NaN());
}
if (numeric_limits<double>::has_signaling_NaN) {
v.push_back(numeric_limits<double>::signaling_NaN());
}
for (unsigned int i = 0; i < kLoop; i++) {
v.push_back(msgpack_rand());
v.push_back(-msgpack_rand());
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Data/Mining/Apriori.pm view on Meta::CPAN
next if(defined $self->{metrics}{minConfidence} && $confidence < $self->{metrics}{minConfidence});
my $lift = ($support/($supportAntecedent*$supportConsequent));
next if(defined $self->{metrics}{minLift} && $lift < $self->{metrics}{minLift});
my $leverage = ($support-($supportAntecedent*$supportConsequent));
next if(defined $self->{metrics}{minLeverage} && $leverage < $self->{metrics}{minLeverage});
my $conviction = ((1-$supportConsequent)==0)?"NaN":((1-$confidence)==0)?"NaN":((1-$supportConsequent)/(1-$confidence));
next if(defined $self->{metrics}{minConviction} && $conviction < $self->{metrics}{minConviction});
my $coverage = $supportAntecedent;
next if(defined $self->{metrics}{minCoverage} && $coverage < $self->{metrics}{minCoverage});
my $correlation = (($support-($supportAntecedent*$supportConsequent))/sqrt($supportAntecedent*(1-$supportAntecedent)*$supportConsequent*(1-$supportConsequent)));
next if(defined $self->{metrics}{minCorrelation} && $correlation < $self->{metrics}{minCorrelation});
lib/Data/Mining/Apriori.pm view on Meta::CPAN
$self->{rule}++;
$support = sprintf("%.$self->{precision}f", $support);
$confidence = sprintf("%.$self->{precision}f", $confidence);
$lift = sprintf("%.$self->{precision}f", $lift);
$leverage = sprintf("%.$self->{precision}f", $leverage);
$conviction = sprintf("%.$self->{precision}f", $conviction)if($conviction ne "NaN");
$coverage = sprintf("%.$self->{precision}f", $coverage);
$correlation = sprintf("%.$self->{precision}f", $correlation);
$cosine = sprintf("%.$self->{precision}f", $cosine);
$laplace = sprintf("%.$self->{precision}f", $laplace);
$jaccard = sprintf("%.$self->{precision}f", $jaccard);
view all matches for this distribution
view release on metacpan or search on metacpan
s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
s++;
}
sawinf = 1;
} else if (*s == 'N' || *s == 'n') {
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++;
sawnan = 1;
} else
view all matches for this distribution
view release on metacpan or search on metacpan
s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
s++;
}
sawinf = 1;
} else if (*s == 'N' || *s == 'n') {
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++;
sawnan = 1;
} else
view all matches for this distribution
view release on metacpan or search on metacpan
t/04-edge-cases.t view on Meta::CPAN
# --- F64 edge values ---
my $f64 = Data::Pool::Shared::F64->new(undef, 4);
$s = $f64->alloc;
# Use string->NV so literals produce real Inf/NaN under -Duselongdouble
# (where 9e999 would fit in long double and not overflow to Inf).
my $posinf = "Inf" + 0;
my $neginf = "-Inf" + 0;
my $nan = "NaN" + 0;
# Infinity
$f64->set($s, $posinf);
my $v = $f64->get($s);
ok $v == $posinf, "F64 +Inf";
t/04-edge-cases.t view on Meta::CPAN
# -Infinity
$f64->set($s, $neginf);
$v = $f64->get($s);
ok $v == $neginf, "F64 -Inf";
# NaN
$f64->set($s, $nan);
$v = $f64->get($s);
ok $v != $v, "F64 NaN (NaN != NaN)";
# Negative zero
$f64->set($s, -0.0);
$v = $f64->get($s);
ok $v == 0.0, "F64 -0.0 compares equal to 0.0";
view all matches for this distribution
view release on metacpan or search on metacpan
t/004_dump.t view on Meta::CPAN
is(dump(-33), "-33", "-33");
is(dump(-1.5), "-1.5", "-1.5");
is(dump("Inf"), qq("Inf"), qq("Inf"));
is(dump("-Inf"), qq("-Inf"), qq("-Inf"));
is(dump("nan"), qq("nan"), qq("nan"));
is(dump("NaN"), qq("NaN"), qq("NaN"));
is(dump("0123"), qq("0123"), qq("0123"));
is(dump(1..2), "(1, 2)", "(1, 2)");
is(dump(1..3), "(1, 2, 3)", "(1, 2, 3)");
is(dump(1..4), "(1 .. 4)", "(1 .. 4)");
is(dump(1..5,6,8,9), "(1 .. 6, 8, 9)", "(1 .. 6, 8, 9)");
view all matches for this distribution
view release on metacpan or search on metacpan
xt/timeout_validation.t view on Meta::CPAN
use Time::HiRes qw(time);
use Data::Queue::Shared;
plan skip_all => 'AUTHOR_TESTING not set' unless $ENV{AUTHOR_TESTING};
# Boundary timeouts: negative, +Inf, NaN. None should crash; results
# should match documented behavior or croak cleanly.
my $h = Data::Queue::Shared::Int->new(undef, 4);
# Run each timeout in a child to detect signal-death.
xt/timeout_validation.t view on Meta::CPAN
my $r2 = run_child('inf timeout',
sub { local $SIG{ALRM} = sub { _exit(0) }; alarm 1; $h->pop_wait("Inf"+0) });
isnt $r2, 'signal_11', "inf timeout: no SIGSEGV (got $r2)";
isnt $r2, 'signal_6', "inf timeout: no SIGABRT (got $r2)";
# NaN: implementation-defined, must not crash
my $r3 = run_child('nan timeout',
sub { local $SIG{ALRM} = sub { _exit(0) }; alarm 1; $h->pop_wait("NaN"+0) });
isnt $r3, 'signal_11', "NaN timeout: no SIGSEGV (got $r3)";
isnt $r3, 'signal_6', "NaN timeout: no SIGABRT (got $r3)";
done_testing;
view all matches for this distribution
view release on metacpan or search on metacpan
s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
s++;
}
sawinf = 1;
} else if (*s == 'N' || *s == 'n') {
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++;
sawnan = 1;
} else
view all matches for this distribution
view release on metacpan or search on metacpan
t/04-edges.t view on Meta::CPAN
is $r->count, 2, 'count tracks total writes';
my $stats = $r->stats;
is $stats->{overwrites}, 1, 'one overwrite tracked';
}
# --- all-null / all-0xFF binary (F64 â NaN/Inf edges) ---
{
my $r = Data::RingBuffer::Shared::F64->new(undef, 8);
$r->write(0.0);
$r->write("Inf" + 0);
$r->write("-Inf" + 0);
$r->write("NaN" + 0);
is $r->latest(3), 0.0;
ok $r->latest(2) > 0 && ($r->latest(2) == $r->latest(2) + 1), 'positive inf';
ok $r->latest(1) < 0 && ($r->latest(1) == $r->latest(1) - 1), 'negative inf';
my $nan = $r->latest(0);
ok $nan != $nan, 'NaN != NaN';
}
# --- odd (non-power-of-2) capacity ---
{
my $r = Data::RingBuffer::Shared::Int->new(undef, 17);
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Data/Rlist.pm view on Meta::CPAN
- lexical conventions such as the C<"0b"> (binary), C<"0"> (octal), C<"0x"> (hex) prefix to denote
a number-base other than decimal, and
- Perls' legible numbers, e.g. F<3.14_15_92>,
- the IEEE 754 notations of Infinite and NaN.
See also
$ perldoc -q "whether a scalar is a number"
lib/Data/Rlist.pm view on Meta::CPAN
The C<"threads"> L<compile option|/Compile Options> has not yet been implemented.
=item *
IEEE 754 notations of Infinite and NaN not yet implemented.
=item *
F<L</compile_Perl>> is experimental.
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Data/Sah/Coerce/js/To_date/From_obj/date.pm view on Meta::CPAN
$res->{expr_match} = join(
" && ",
"($dt instanceof Date)",
);
$res->{expr_coerce} = "isNaN($dt) ? ['Invalid date', $dt] : [null, $dt]";
$res;
}
1;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Data/Sah/Format/js/iso8601_date.pm view on Meta::CPAN
my $res = {};
$res->{expr} = join(
"",
"$dt instanceof Date ? (isNaN($dt) ? d : $dt.toISOString().substring(0, 10)) : ",
$attempt_parse ? "(function(pd) { pd = new Date($dt); return isNaN(pd) ? $dt : pd.toISOString().substring(0, 10) })()" : "$dt",
);
$res;
}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Data/Sah/Compiler/js/TH/date.pm view on Meta::CPAN
=back
But note that if the arguments are invalid, Date() will still return a Date
object, but if we try to do C<d.getMonth()> or C<d.getYear()> it will return
NaN. This can be used to check that a date is invalid: C<< isNaN(d.getYear()) >>
or simply C<<isNaN(d)>>.
To compare 2 Date object, we can use C<< d1 > d2 >>, C<< d1 < d2 >>, but for
anything involving equality check, we need to prefix using C<+>, C<+d1 === +d2>.
=for Pod::Coverage ^(clause_.+|superclause_.+|handle_.+|before_.+|after_.+)$
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Data/Sah/Compiler/human/TH/float.pm view on Meta::CPAN
if ($cd->{cl_is_expr}) {
$c->add_ccl($cd, {});
} else {
$c->add_ccl($cd, {
fmt => $cv ?
q[%(modal_verb)s be a NaN] :
q[%(modal_verb_neg)s be a NaN],
});
}
}
sub clause_is_inf {
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Docs/Site_SVD/Data_SecsPack.pm view on Meta::CPAN
# Expected: 'U1[1] 80
U1[2] 128 0
'
The second group of failures the UUT C<unpack_float> subroutine
is always returning a NaN. This subroutine heavily uses the
native floating point for calcuations and it appears to
be limiting out with C<Not a Number> type error.
# Test 27 got: '0' (t/Data/SecsPackStress.t at line 396 fail #2)
# Expected: '1' (got: NaN, expected: -10.5
# actual tolerance: NaN, expected tolerance: 0.0001)
Check version of C<Math::BigInt> in the ActiveState Perl 5.06
distribution to those on CPAN. ActiveState C<Math::BigInt>
was 0.01 while CPAN was 1.70. The difference between the two
is night and day. Install C<Math::BigInt> 1.70.
lib/Docs/Site_SVD/Data_SecsPack.pm view on Meta::CPAN
# Expected: 'U1[1] 80
U1[2] 128 0
'
The second group of failures the UUT C<unpack_float> subroutine
is always returning a NaN. This subroutine heavily uses the
native floating point for calcuations and it appears to
be limiting out with C<Not a Number> type error.
# Test 27 got: '0' (t/Data/SecsPackStress.t at line 396 fail #2)
# Expected: '1' (got: NaN, expected: -10.5
# actual tolerance: NaN, expected tolerance: 0.0001)
Check version of C<Math::BigInt> in the ActiveState Perl 5.06
distribution to those on CPAN. ActiveState C<Math::BigInt>
was 0.01 while CPAN was 1.70. The difference between the two
is night and day. Install C<Math::BigInt> 1.70.
view all matches for this distribution
view release on metacpan or search on metacpan
s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
s++;
}
sawinf = 1;
} else if (*s == 'N' || *s == 'n') {
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++;
sawnan = 1;
} else
view all matches for this distribution
view release on metacpan or search on metacpan
xt/timeout_validation.t view on Meta::CPAN
use Time::HiRes qw(time);
use Data::Stack::Shared;
plan skip_all => 'AUTHOR_TESTING not set' unless $ENV{AUTHOR_TESTING};
# Boundary timeouts: negative, +Inf, NaN. None should crash; results
# should match documented behavior or croak cleanly.
my $h = Data::Stack::Shared::Int->new(undef, 4);
# Run each timeout in a child to detect signal-death.
xt/timeout_validation.t view on Meta::CPAN
my $r2 = run_child('inf timeout',
sub { local $SIG{ALRM} = sub { _exit(0) }; alarm 1; $h->pop_wait("Inf"+0) });
isnt $r2, 'signal_11', "inf timeout: no SIGSEGV (got $r2)";
isnt $r2, 'signal_6', "inf timeout: no SIGABRT (got $r2)";
# NaN: implementation-defined, must not crash
my $r3 = run_child('nan timeout',
sub { local $SIG{ALRM} = sub { _exit(0) }; alarm 1; $h->pop_wait("NaN"+0) });
isnt $r3, 'signal_11', "NaN timeout: no SIGSEGV (got $r3)";
isnt $r3, 'signal_6', "NaN timeout: no SIGABRT (got $r3)";
done_testing;
view all matches for this distribution
view release on metacpan or search on metacpan
s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
s++;
}
sawinf = 1;
} else if (*s == 'N' || *s == 'n') {
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++;
sawnan = 1;
} else
view all matches for this distribution
view release on metacpan or search on metacpan
s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
s++;
}
sawinf = 1;
} else if (*s == 'N' || *s == 'n') {
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
s++;
sawnan = 1;
} else
view all matches for this distribution
view release on metacpan or search on metacpan
t/05_security.t view on Meta::CPAN
my $encoder = Data::TOON::Encoder->new(max_depth => 10); # Low limit to catch circular ref
my $encoded = eval { $encoder->encode($data) };
like($@ // '', qr/circular|reference|depth/i, 'encode detects circular references or depth limit');
}
# Test 10: NaN and Infinity are strings, not numbers
{
my $toon_text = <<'TOON';
value1: NaN
value2: Infinity
TOON
my $data = Data::TOON->decode($toon_text);
is($data->{value1}, 'NaN', 'NaN decoded as string');
is($data->{value2}, 'Infinity', 'Infinity decoded as string');
}
# Test 11: Shell injection-like patterns (data escaping)
{
view all matches for this distribution