This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: strtod / strtol patch for POSIX module
authorDavid Hammen <hammen@gothamcity.jsc.nasa.gov>
Mon, 18 Nov 1996 06:46:52 +0000 (18:46 +1200)
committerChip Salzenberg <chip@atlantic.net>
Tue, 19 Nov 1996 02:16:00 +0000 (14:16 +1200)
Configure
config_h.SH
ext/POSIX/POSIX.pm
ext/POSIX/POSIX.pod
ext/POSIX/POSIX.xs
t/lib/posix.t

index 36f612c..f1c6f92 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -394,6 +394,9 @@ d_strerrm=''
 d_strerror=''
 d_sysernlst=''
 d_syserrlst=''
+d_strtod=''
+d_strtol=''
+d_strtoul=''
 d_strxfrm=''
 d_symlink=''
 d_syscall=''
@@ -7598,6 +7601,18 @@ else
        d_strerrm='"unknown"'
 fi
 
+: see if strtod exists
+set strtod d_strtod
+eval $inlibc
+
+: see if strtol exists
+set strtol d_strtol
+eval $inlibc
+
+: see if strtoul exists
+set strtoul d_strtoul
+eval $inlibc
+
 : see if strxfrm exists
 set strxfrm d_strxfrm
 eval $inlibc
@@ -9444,19 +9459,24 @@ known_extensions=''
 : some additional extensions into the source tree and expect them
 : to be built.
 for xxx in * ; do
-       if $test -f $xxx/$xxx.xs; then
-               known_extensions="$known_extensions $xxx"
-       else
-               if $test -d $xxx; then
-                       cd $xxx
-                       for yyy in * ; do
-                               if $test -f $yyy/$yyy.xs; then
-                                       known_extensions="$known_extensions $xxx/$yyy"
-                               fi
-                       done
-                       cd ..
-               fi
-       fi
+       case "$xxx" in
+       DynaLoader)
+               known_extensions="$known_extensions $xxx" ;;
+       *)
+               if $test -f $xxx/$xxx.xs; then
+                       known_extensions="$known_extensions $xxx"
+               else
+                       if $test -d $xxx; then
+                               cd $xxx
+                               for yyy in * ; do
+                                       if $test -f $yyy/$yyy.xs; then
+                                               known_extensions="$known_extensions $xxx/$yyy"
+                                       fi
+                               done
+                               cd ..
+                       fi
+               fi ;;
+       esac
 done
 set X $known_extensions
 shift
@@ -9845,6 +9865,9 @@ d_strcoll='$d_strcoll'
 d_strctcpy='$d_strctcpy'
 d_strerrm='$d_strerrm'
 d_strerror='$d_strerror'
+d_strtod='$d_strtod'
+d_strtol='$d_strtol'
+d_strtoul='$d_strtoul'
 d_strxfrm='$d_strxfrm'
 d_suidsafe='$d_suidsafe'
 d_symlink='$d_symlink'
index 1f18809..0a8bc62 100644 (file)
@@ -800,6 +800,24 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
 #$d_syserrlst HAS_SYS_ERRLIST  /**/
 #define Strerror(e) $d_strerrm
 
+/* HAS_STRTOD:
+ *     This symbol, if defined, indicates that the strtod routine is
+ *     available to translate strings to doubles.
+ */
+#$d_strtod HAS_STRTOD  /**/
+
+/* HAS_STRTOL:
+ *     This symbol, if defined, indicates that the strtol routine is
+ *     available to translate strings to integers.
+ */
+#$d_strtol HAS_STRTOL  /**/
+
+/* HAS_STRTOUL:
+ *     This symbol, if defined, indicates that the strtoul routine is
+ *     available to translate strings to integers.
+ */
+#$d_strtoul HAS_STRTOUL        /**/
+
 /* HAS_STRXFRM:
  *     This symbol, if defined, indicates that the strxfrm() routine is
  *     available to transform strings.
index 66b55c1..22eed02 100644 (file)
@@ -96,7 +96,7 @@ $VERSION = "1.00" ;
     stdlib_h =>        [qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX
                abort atexit atof atoi atol bsearch calloc div
                free getenv labs ldiv malloc mblen mbstowcs mbtowc
-               qsort realloc strtod strtol stroul wcstombs wctomb)],
+               qsort realloc strtod strtol strtoul wcstombs wctomb)],
 
     string_h =>        [qw(NULL memchr memcmp memcpy memmove memset strcat
                strchr strcmp strcoll strcpy strcspn strerror strlen
@@ -628,18 +628,6 @@ sub srand {
     unimpl "srand()";
 }
 
-sub strtod {
-    unimpl "strtod() is C-specific, stopped";
-}
-
-sub strtol {
-    unimpl "strtol() is C-specific, stopped";
-}
-
-sub stroul {
-    unimpl "stroul() is C-specific, stopped";
-}
-
 sub system {
     usage "system(command)" if @_ != 1;
     system($_[0]);
index a8cd0d1..7dee4a3 100644 (file)
@@ -1060,7 +1060,26 @@ This is identical to Perl's builtin C<index()> function.
 
 =item strtod
 
-strtod() is C-specific.
+String to double translation. Returns the parsed number and the number
+of characters in the unparsed portion of the string.  Truly
+POSIX-compliant systems set $! ($ERRNO) to indicate a translation
+error, so clear $! before calling strtod.  However, non-POSIX systems
+may not check for overflow, and therefore will never set $!.
+
+strtod should respect any POSIX I<setlocale()> settings.
+
+To parse a string $str as a floating point number use
+
+    $! = 0;
+    ($num, $n_unparsed) = POSIX::strtod($str);
+
+The second returned item and $! can be used to check for valid input:
+
+    if (($str eq '') || ($n_unparsed != 0) || !$!) {
+        die "Non-numeric input $str" . $! ? ": $!\n" : "\n";
+    }
+
+When called in a scalar context strtod returns the parsed number.
 
 =item strtok
 
@@ -1068,7 +1087,42 @@ strtok() is C-specific.
 
 =item strtol
 
-strtol() is C-specific.
+String to (long) integer translation.  Returns the parsed number and
+the number of characters in the unparsed portion of the string.  Truly
+POSIX-compliant systems set $! ($ERRNO) to indicate a translation
+error, so clear $! before calling strtol.  However, non-POSIX systems
+may not check for overflow, and therefore will never set $!.
+
+strtol should respect any POSIX I<setlocale()> settings.
+
+To parse a string $str as a number in some base $base use
+
+    $! = 0;
+    ($num, $n_unparsed) = POSIX::strtol($str, $base);
+
+The base should be zero or between 2 and 36, inclusive.  When the base
+is zero or omitted strtol will use the string itself to determine the
+base: a leading "0x" or "0X" means hexadecimal; a leading "0" means
+octal; any other leading characters mean decimal.  Thus, "1234" is
+parsed as a decimal number, "01234" as an octal number, and "0x1234"
+as a hexadecimal number.
+
+The second returned item and $! can be used to check for valid input:
+
+    if (($str eq '') || ($n_unparsed != 0) || !$!) {
+        die "Non-numeric input $str" . $! ? ": $!\n" : "\n";
+    }
+
+When called in a scalar context strtol returns the parsed number.
+
+=item strtoul
+
+String to unsigned (long) integer translation.  strtoul is identical
+to strtol except that strtoul only parses unsigned integers.  See
+I<strtol> for details.
+
+Note: Some vendors supply strtod and strtol but not strtoul.
+Other vendors that do suply strtoul parse "-1" as a valid value.
 
 =item strxfrm
 
index def5fb1..808ef8e 100644 (file)
@@ -191,6 +191,9 @@ typedef struct termios* POSIX__Termios;
 
 /* Possibly needed prototypes */
 char *cuserid _((char *));
+double strtod _((const char *, char **));
+long strtol _((const char *, char **, int));
+unsigned long strtoul _((const char *, char **, int));
 
 #ifndef HAS_CUSERID
 #define cuserid(a) (char *) not_here("cuserid")
@@ -227,6 +230,15 @@ char *cuserid _((char *));
 #ifndef HAS_STRCOLL
 #define strcoll(s1,s2) not_here("strcoll")
 #endif
+#ifndef HAS_STRTOD
+#define strtod(s1,s2) not_here("strtod")
+#endif
+#ifndef HAS_STRTOL
+#define strtol(s1,s2,b) not_here("strtol")
+#endif
+#ifndef HAS_STRTOUL
+#define strtoul(s1,s2,b) not_here("strtoul")
+#endif
 #ifndef HAS_STRXFRM
 #define strxfrm(s1,s2,n) not_here("strxfrm")
 #endif
@@ -3034,6 +3046,65 @@ strcoll(s1, s2)
        char *          s1
        char *          s2
 
+void
+strtod(str)
+       char *          str
+    PREINIT:
+       double num;
+       char *unparsed;
+    PPCODE:
+       num = strtod(str, &unparsed);
+       PUSHs(sv_2mortal(newSVnv(num)));
+       if (GIMME == G_ARRAY) {
+           EXTEND(sp, 1);
+           if (unparsed)
+               PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
+           else
+               PUSHs(&sv_undef);
+       }
+
+void
+strtol(str, base = 0)
+       char *          str
+       int             base
+    PREINIT:
+       long num;
+       char *unparsed;
+    PPCODE:
+       num = strtol(str, &unparsed, base);
+       if (num >= IV_MIN && num <= IV_MAX)
+           PUSHs(sv_2mortal(newSViv((IV)num)));
+       else
+           PUSHs(sv_2mortal(newSVnv((double)num)));
+       if (GIMME == G_ARRAY) {
+           EXTEND(sp, 1);
+           if (unparsed)
+               PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
+           else
+               PUSHs(&sv_undef);
+       }
+
+void
+strtoul(str, base = 0)
+       char *          str
+       int             base
+    PREINIT:
+       unsigned long num;
+       char *unparsed;
+    PPCODE:
+       num = strtoul(str, &unparsed, base);
+       if (num <= IV_MAX)
+           PUSHs(sv_2mortal(newSViv((IV)num)));
+       else
+           PUSHs(sv_2mortal(newSVnv((double)num)));
+       if (GIMME == G_ARRAY) {
+           EXTEND(sp, 1);
+           if (unparsed)
+               PUSHs(sv_2mortal(newSViv(strlen(unparsed))));
+           else
+               PUSHs(&sv_undef);
+       }
+
 SV *
 strxfrm(src)
        SV *            src
index 23007ff..3adc602 100755 (executable)
@@ -14,7 +14,7 @@ use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read write);
 use strict subs;
 
 $| = 1;
-print "1..14\n";
+print "1..17\n";
 
 $testfd = open("TEST", O_RDONLY, 0) and print "ok 1\n";
 read($testfd, $buffer, 9) if $testfd > 2;
@@ -58,8 +58,25 @@ print &_POSIX_OPEN_MAX > $fds[1] ? "ok 12\n" : "not ok 12\n";
 
 print getcwd() =~ m#/t$# ? "ok 13\n" : "not ok 13\n";
 
+# Check string conversion functions.
+
+if ($Config{d_strtod}) {
+    ($n, $x) = &POSIX::strtod('3.14159_OR_SO');
+    print (($n == 3.14159) && ($x == 6) ? "ok 14\n" : "not ok 14\n");
+} else { print "# strtod not present\n", "ok 14\n"; }
+
+if ($Config{d_strtol}) {
+    ($n, $x) = &POSIX::strtol('21_PENGUINS');
+    print (($n == 21) && ($x == 9) ? "ok 15\n" : "not ok 15\n");
+} else { print "# strtol not present\n", "ok 15\n"; }
+
+if ($Config{d_strtoul}) {
+    ($n, $x) = &POSIX::strtoul('88_TEARS');
+    print (($n == 88) && ($x == 6) ? "ok 16\n" : "not ok 16\n");
+} else { print "# strtoul not present\n", "ok 16\n"; }
+
 # Pick up whether we're really able to dynamically load everything.
-print &POSIX::acos(1.0) == 0.0 ? "ok 14\n" : "not ok 14\n";
+print &POSIX::acos(1.0) == 0.0 ? "ok 17\n" : "not ok 17\n";
 
 $| = 0;
 print '@#!*$@(!@#$';