From: David Hammen Date: Mon, 18 Nov 1996 06:46:52 +0000 (+1200) Subject: Re: strtod / strtol patch for POSIX module X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a89d8a78dff47ec38c74499f0534e21e544ac9a1;p=p5sagit%2Fp5-mst-13.2.git Re: strtod / strtol patch for POSIX module --- diff --git a/Configure b/Configure index 36f612c..f1c6f92 100755 --- 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' diff --git a/config_h.SH b/config_h.SH index 1f18809..0a8bc62 100644 --- a/config_h.SH +++ b/config_h.SH @@ -800,6 +800,24 @@ sed <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. diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index 66b55c1..22eed02 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 a8cd0d1..7dee4a3 100644 --- a/ext/POSIX/POSIX.pod +++ b/ext/POSIX/POSIX.pod @@ -1060,7 +1060,26 @@ This is identical to Perl's builtin C 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 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 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 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 def5fb1..808ef8e 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 diff --git a/t/lib/posix.t b/t/lib/posix.t index 23007ff..3adc602 100755 --- a/t/lib/posix.t +++ b/t/lib/posix.t @@ -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 '@#!*$@(!@#$';