This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
POSIX: Make strtoul() return UV if possible
authorTAKAI Kousuke <62541129+t-a-k@users.noreply.github.com>
Thu, 4 Feb 2021 14:10:55 +0000 (23:10 +0900)
committerKarl Williamson <khw@cpan.org>
Sun, 25 Jul 2021 00:58:18 +0000 (17:58 -0700)
POSIX::strtoul() used to return NV if return value does not fit in IV,
but this caused loss of precision if unsigned long and NV are both 64-bit.

ext/POSIX/POSIX.xs
ext/POSIX/t/posix.t

index 27ba2dc..cb2d8d5 100644 (file)
@@ -3581,12 +3581,12 @@ strtoul(str, base = 0)
        PERL_UNUSED_VAR(base);
        if (base == 0 || inRANGE(base, 2, 36)) {
             num = strtoul(str, &unparsed, base);
-#if IVSIZE <= LONGSIZE
-            if (num > IV_MAX)
+#if UVSIZE < LONGSIZE
+            if (num > UV_MAX)
                 PUSHs(sv_2mortal(newSVnv((double)num)));
             else
 #endif
-                PUSHs(sv_2mortal(newSViv((IV)num)));
+                PUSHs(sv_2mortal(newSVuv((UV)num)));
             if (GIMME_V == G_LIST) {
                 EXTEND(SP, 1);
                 if (unparsed)
index 2f4d450..1db96c2 100644 (file)
@@ -10,7 +10,7 @@ BEGIN {
     require 'loc_tools.pl';
 }
 
-use Test::More tests => 96;
+use Test::More tests => 98;
 
 use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read strftime write
             errno localeconv dup dup2 lseek access);
@@ -249,11 +249,18 @@ SKIP: {
 }
 
 SKIP: {
-    skip("strtoul() not present", 2) unless $Config{d_strtoul};
+    skip("strtoul() not present", 4) unless $Config{d_strtoul};
 
     ($n, $x) = &POSIX::strtoul('88_TEARS');
     is($n, 88, 'strtoul() number');
     is($x, 6,  '          unparsed chars');
+
+    skip("'long' is not 64-bit", 2)
+        unless $Config{uvsize} >= $Config{longsize} && $Config{longsize} >= 8;
+    ($n, $x) = &POSIX::strtoul('abcdef0123456789', 16);
+    # Expected value is specified by a string to avoid unwanted NV conversion
+    is($n, '12379813738877118345', 'strtoul() 64-bit number');
+    is($x, 0,                      '          unparsed chars');
 }
 
 # Pick up whether we're really able to dynamically load everything.