Re: strtod / strtol patch for POSIX module

3 files changed, 128 insertions, 15 deletions

diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm
index 66b55c1565..22eed0283b 100644
--- a/ext/POSIX/POSIX.pm
+++ b/ext/POSIX/POSIX.pm
@@ -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]);
diff --git a/ext/POSIX/POSIX.pod b/ext/POSIX/POSIX.pod
index a8cd0d1ca0..7dee4a3652 100644
--- a/ext/POSIX/POSIX.pod
+++ b/ext/POSIX/POSIX.pod
@@ -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
 
diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs
index def5fb1235..808ef8e030 100644
--- a/ext/POSIX/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -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