d_strerror=''
d_sysernlst=''
d_syserrlst=''
+d_strtod=''
+d_strtol=''
+d_strtoul=''
d_strxfrm=''
d_symlink=''
d_syscall=''
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
: 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
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'
#$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.
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
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]);
=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
=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
/* 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")
#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
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
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;
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 '@#!*$@(!@#$';
projects / p5sagit/p5-mst-13.2.git / commitdiff