summaryrefslogtreecommitdiff
path: root/pp_sys.c
diff options
context:
space:
mode:
authorMichael G. Schwern <schwern@pobox.com>2008-10-03 16:05:10 -0400
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>2009-01-03 18:39:09 +0100
commit8efababc2f87779325166ff9fd8b47cde3763a95 (patch)
tree3c3ec29b9e68f8946dffed0ef23482e7a88a4da4 /pp_sys.c
parent0fb7f756cb6b1af5b0111c6cebcd5337b7ebd402 (diff)
downloadperl-8efababc2f87779325166ff9fd8b47cde3763a95.tar.gz
Fix gmtime() and localtime() so they can pop times larger than 2**55 off the stack. Neither POPn nor SvNVx work when casted to (Time64_T). Had to use a double and then cast.
Also POPq uses an SvIV so that's no good. This causes an unfortunate loss in accuracy near 2**63 up to 8 minutes. %lld is broken, it uses regular integers. Need to use doubles and %.0f instead, again losing accuracy. Now things can go out to 2**63-512.
Diffstat (limited to 'pp_sys.c')
-rw-r--r--pp_sys.c22
1 files changed, 15 insertions, 7 deletions
diff --git a/pp_sys.c b/pp_sys.c
index 5cfe38a844..26468e6bf6 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4415,11 +4415,15 @@ PP(pp_gmtime)
when = (Time64_T)now;
}
else {
- double now = POPn;
- when = (Time64_T)now;
- if( when != now ) {
+ /* XXX POPq uses an SvIV so it won't work with 32 bit integer scalars
+ using a double causes an unfortunate loss of accuracy on high numbers.
+ What we really need is an SvQV.
+ */
+ double input = POPn;
+ when = (Time64_T)input;
+ if( when != input ) {
Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
- "%.0f too large for %s", now, opname);
+ "%s(%.0f) too large", opname, input);
}
}
@@ -4429,25 +4433,29 @@ PP(pp_gmtime)
err = gmtime64_r(&when, &tmbuf);
if( err == NULL ) {
+ /* XXX %lld broken for quads */
Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
- "%s under/overflowed the year", opname);
+ "%s(%.0f) failed", opname, (double)when);
}
if (GIMME != G_ARRAY) { /* scalar context */
SV *tsv;
+ /* XXX newSVpvf()'s %lld type is broken, so cheat with a double */
+ double year = (double)tmbuf.tm_year + 1900;
+
EXTEND(SP, 1);
EXTEND_MORTAL(1);
if (err == NULL)
RETPUSHUNDEF;
- tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %lld",
+ tsv = Perl_newSVpvf(aTHX_ "%s %s %2d %02d:%02d:%02d %.0f",
dayname[tmbuf.tm_wday],
monname[tmbuf.tm_mon],
tmbuf.tm_mday,
tmbuf.tm_hour,
tmbuf.tm_min,
tmbuf.tm_sec,
- tmbuf.tm_year + 1900);
+ year);
mPUSHs(tsv);
}
else { /* list context */