extern void _fwalk(int (*)(FILE *));
_fwalk(&fflush);
return 0;
-# else
- long open_max = -1;
+# else
# if defined(FFLUSH_ALL) && defined(HAS_STDIO_STREAM_ARRAY)
+ long open_max = -1;
# ifdef PERL_FFLUSH_ALL_FOPEN_MAX
open_max = PERL_FFLUSH_ALL_FOPEN_MAX;
# else
-# if defined(HAS_SYSCONF) && defined(_SC_OPEN_MAX)
+# if defined(HAS_SYSCONF) && defined(_SC_OPEN_MAX)
open_max = sysconf(_SC_OPEN_MAX);
-# else
-# ifdef FOPEN_MAX
+# else
+# ifdef FOPEN_MAX
open_max = FOPEN_MAX;
-# else
-# ifdef OPEN_MAX
+# else
+# ifdef OPEN_MAX
open_max = OPEN_MAX;
-# else
-# ifdef _NFILE
+# else
+# ifdef _NFILE
open_max = _NFILE;
+# endif
+# endif
# endif
# endif
# endif
-# endif
-# endif
if (open_max > 0) {
long i;
for (i = 0; i < open_max; i++)
if ((PL_hints & HINT_LOCALE) && PL_numeric_local) {
NV y;
- Perl_atof2(s, x);
+ Perl_atof2(aTHX_ s, &x);
SET_NUMERIC_STANDARD();
- Perl_atof2(s, y);
+ Perl_atof2(aTHX_ s, &y);
SET_NUMERIC_LOCAL();
if ((y < 0.0 && y < x) || (y > 0.0 && y > x))
return y;
}
else
- Perl_atof2(s, x);
+ Perl_atof2(aTHX_ s, &x);
#else
- Perl_atof2(s, x);
+ Perl_atof2(aTHX_ s, &x);
#endif
return x;
}
+NV
+S_mulexp10(NV value, I32 exponent)
+{
+ NV result = value;
+ NV power = 10.0;
+ I32 bit;
+
+ if (exponent > 0) {
+ for (bit = 1; exponent; bit <<= 1) {
+ if (exponent & bit) {
+ exponent ^= bit;
+ result *= power;
+ }
+ power *= power;
+ }
+ }
+ else if (exponent < 0) {
+ exponent = -exponent;
+ for (bit = 1; exponent; bit <<= 1) {
+ if (exponent & bit) {
+ exponent ^= bit;
+ result /= power;
+ }
+ power *= power;
+ }
+ }
+ return result;
+}
+
+char*
+Perl_my_atof2(pTHX_ const char* orig, NV* value)
+{
+ NV result = 0.0;
+ bool negative = 0;
+ char* s = (char*)orig;
+ char* point = "."; /* locale-dependent decimal point equivalent */
+ STRLEN pointlen = 1;
+ bool seendigit = 0;
+ I32 expextra = 0;
+ I32 exponent = 0;
+ I32 i;
+/* this is arbitrary */
+#define PARTLIM 6
+/* we want the largest integers we can usefully use */
+#if defined(HAS_QUAD) && defined(USE_64_BIT_INT)
+# define PARTSIZE ((int)TYPE_DIGITS(U64)-1)
+ U64 part[PARTLIM];
+#else
+# define PARTSIZE ((int)TYPE_DIGITS(U32)-1)
+ U32 part[PARTLIM];
+#endif
+ I32 ipart = 0; /* index into part[] */
+ I32 offcount; /* number of digits in least significant part */
+
+ if (PL_numeric_radix_sv)
+ point = SvPV(PL_numeric_radix_sv, pointlen);
+
+ /* sign */
+ switch (*s) {
+ case '-':
+ negative = 1;
+ /* fall through */
+ case '+':
+ ++s;
+ }
+
+ part[0] = offcount = 0;
+ if (isDIGIT(*s)) {
+ seendigit = 1; /* get this over with */
+
+ /* skip leading zeros */
+ while (*s == '0')
+ ++s;
+ }
+
+ /* integer digits */
+ while (isDIGIT(*s)) {
+ if (++offcount > PARTSIZE) {
+ if (++ipart < PARTLIM) {
+ part[ipart] = 0;
+ offcount = 1; /* ++0 */
+ }
+ else {
+ /* limits of precision reached */
+ --ipart;
+ --offcount;
+ if (*s >= '5')
+ ++part[ipart];
+ while (isDIGIT(*s)) {
+ ++expextra;
+ ++s;
+ }
+ /* warn of loss of precision? */
+ break;
+ }
+ }
+ part[ipart] = part[ipart] * 10 + (*s++ - '0');
+ }
+
+ /* decimal point */
+ if (memEQ(s, point, pointlen)) {
+ s += pointlen;
+ if (isDIGIT(*s))
+ seendigit = 1; /* get this over with */
+
+ /* decimal digits */
+ while (isDIGIT(*s)) {
+ if (++offcount > PARTSIZE) {
+ if (++ipart < PARTLIM) {
+ part[ipart] = 0;
+ offcount = 1; /* ++0 */
+ }
+ else {
+ /* limits of precision reached */
+ --ipart;
+ --offcount;
+ if (*s >= '5')
+ ++part[ipart];
+ while (isDIGIT(*s))
+ ++s;
+ /* warn of loss of precision? */
+ break;
+ }
+ }
+ --expextra;
+ part[ipart] = part[ipart] * 10 + (*s++ - '0');
+ }
+ }
+
+ /* combine components of mantissa */
+ for (i = 0; i <= ipart; ++i)
+ result += S_mulexp10((NV)part[ipart - i],
+ i ? offcount + (i - 1) * PARTSIZE : 0);
+
+ if (seendigit && (*s == 'e' || *s == 'E')) {
+ bool expnegative = 0;
+
+ ++s;
+ switch (*s) {
+ case '-':
+ expnegative = 1;
+ /* fall through */
+ case '+':
+ ++s;
+ }
+ while (isDIGIT(*s))
+ exponent = exponent * 10 + (*s++ - '0');
+ if (expnegative)
+ exponent = -exponent;
+ }
+
+ /* now apply the exponent */
+ exponent += expextra;
+ result = S_mulexp10(result, exponent);
+
+ /* now apply the sign */
+ if (negative)
+ result = -result;
+ *value = result;
+ return s;
+}
+
void
Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op)
{
New(0, buf, buflen, char);
len = strftime(buf, buflen, fmt, &mytm);
/*
- ** The following is needed to handle to the situation where
+ ** The following is needed to handle to the situation where
** tmpbuf overflows. Basically we want to allocate a buffer
** and try repeatedly. The reason why it is so complicated
** is that getting a return value of 0 from strftime can indicate
/* Possibly buf overflowed - try again with a bigger buf */
int fmtlen = strlen(fmt);
int bufsize = fmtlen + buflen;
-
+
New(0, buf, bufsize, char);
while (buf) {
buflen = strftime(buf, bufsize, fmt, &mytm);
int
Perl_sv_getcwd(pTHX_ register SV *sv)
{
+#ifndef PERL_MICRO
+
#ifndef HAS_GETCWD
struct stat statbuf;
int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
#endif
return TRUE;
+#else
+ return FALSE;
+#endif
}
/*
=for apidoc sv_realpath
-Emulate realpath(3)
+Wrap or emulate realpath(3).
-XXX: add configure test for realpath(3) and prefer if available
=cut
*/
int
Perl_sv_realpath(pTHX_ SV *sv, char *path, STRLEN len)
{
+#ifndef PERL_MICRO
+ char name[MAXPATHLEN] = { 0 }, *s;
+ STRLEN pathlen, namelen;
+
+#ifdef HAS_REALPATH
+ /* Be paranoid about the use of realpath(),
+ * it is an infamous source of buffer overruns. */
+
+ /* Is the source buffer too long?
+ * Don't use strlen() to avoid running off the end. */
+ s = memchr(path, '\0', MAXPATHLEN);
+ pathlen = s ? s - path : MAXPATHLEN;
+ if (pathlen == MAXPATHLEN) {
+ Perl_warn(aTHX_ "sv_realpath: realpath(\"%s\"): %c= (MAXPATHLEN = %d)",
+ path, s ? '=' : '>', MAXPATHLEN);
+ SV_CWD_RETURN_UNDEF;
+ }
+
+ /* Here goes nothing. */
+ if (realpath(path, name) == NULL) {
+ Perl_warn(aTHX_ "sv_realpath: realpath(\"%s\"): %s",
+ path, Strerror(errno));
+ SV_CWD_RETURN_UNDEF;
+ }
+
+ /* Is the destination buffer too long?
+ * Don't use strlen() to avoid running off the end. */
+ s = memchr(name, '\0', MAXPATHLEN);
+ namelen = s ? s - name : MAXPATHLEN;
+ if (namelen == MAXPATHLEN) {
+ Perl_warn(aTHX_ "sv_realpath: realpath(\"%s\"): %c= (MAXPATHLEN = %d)",
+ path, s ? '=' : '>', MAXPATHLEN);
+ SV_CWD_RETURN_UNDEF;
+ }
+
+ /* The coast is clear? */
+ sv_setpvn(sv, name, namelen);
+ SvPOK_only(sv);
+
+ return TRUE;
+#else
DIR *parent;
Direntry_t *dp;
char dotdots[MAXPATHLEN] = { 0 };
- char name[MAXPATHLEN] = { 0 };
- int namelen = 0, pathlen = 0;
struct stat cst, pst, tst;
if (PerlLIO_stat(path, &cst) < 0) {
dotdots, Strerror(errno));
SV_CWD_RETURN_UNDEF;
}
-
+
if (pst.st_dev == cst.st_dev && pst.st_ino == cst.st_ino) {
/* We've reached the root: previous is same as current */
break;
dotdots, Strerror(errno));
SV_CWD_RETURN_UNDEF;
}
-
+
SETERRNO(0,SS$_NORMAL); /* for readdir() */
while ((dp = PerlDir_read(parent)) != NULL) {
if (SV_CWD_ISDOT(dp)) {
continue;
}
-
+
Copy(dotdots, name, dotdotslen, char);
name[dotdotslen] = '/';
#ifdef DIRNAMLEN
#endif
Copy(dp->d_name, name + dotdotslen + 1, namelen, char);
name[dotdotslen + 1 + namelen] = 0;
-
+
if (PerlLIO_lstat(name, &tst) < 0) {
PerlDir_close(parent);
Perl_warn(aTHX_ "sv_realpath: lstat(\"%s\"): %s",
name, Strerror(errno));
SV_CWD_RETURN_UNDEF;
}
-
+
if (tst.st_dev == pst.st_dev && tst.st_ino == pst.st_ino)
break;
SvPOK_only(sv);
return TRUE;
+#endif
+#else
+ return FALSE;
+#endif
}