From 2bdd816d4b9c1bdc4958456bba1b35dadaff180e Mon Sep 17 00:00:00 2001 From: maechler Date: Wed, 4 Dec 2024 11:38:28 +0000 Subject: [PATCH] more thorough fixing format.POSIXlt() for fractional secs git-svn-id: https://svn.r-project.org/R/trunk@87419 00db46b3-68df-0310-9c12-caf00c1e9a41 --- doc/NEWS.Rd | 9 ++- src/library/base/R/datetime.R | 37 +++++---- tests/datetime5.R | 14 +++- tests/datetime5.Rout.save | 141 +++++++++++++++++++++++++++++++++- 4 files changed, 181 insertions(+), 20 deletions(-) diff --git a/doc/NEWS.Rd b/doc/NEWS.Rd index 916503628cd..b5ab8c5c7e7 100644 --- a/doc/NEWS.Rd +++ b/doc/NEWS.Rd @@ -398,7 +398,8 @@ when the \code{POSIXt} date-time object \code{dtime} has fractional (non integer) seconds. Fixes \PR{17350}, thanks to new contributions by \I{LatinR}'s \sQuote{\I{R Dev Day}} participants, \I{Heather - Turner} and \I{Dirk Eddelbuettel}. + Turner} and \I{Dirk Eddelbuettel}; also fixes more cases, notably + when \code{format} contains "%OS". \item \code{options(scipen = NULL)} and other invalid values now signal an error instead of invalidating ops relying on a finite @@ -406,9 +407,6 @@ about and set to a respective boundary or to the default \code{0}, e.g., in case of an \code{NA}. - \item \code{isGeneric(fdef = print)} now works, fixing \PR{18369} - thanks to \I{Mikael Jagan}. - \item \code{cbind()} could segfault with \code{NULL} inputs. (Seen when \R was built with \command{gcc14}, \abbr{LTO} and C99 inlining semantics.) @@ -464,6 +462,9 @@ \item \code{isGeneric(, fdef=*, getName=TRUE)} now also returns the name instead of just \code{TRUE}, fixing \PR{18829} reported by \I{Mikael Jagan}. + + \item \code{isGeneric(fdef = print)} now works, fixing \PR{18369} + thanks to \I{Mikael Jagan}. } } } diff --git a/src/library/base/R/datetime.R b/src/library/base/R/datetime.R index 5312c95c09a..c2d6b772ab6 100644 --- a/src/library/base/R/datetime.R +++ b/src/library/base/R/datetime.R @@ -382,24 +382,35 @@ format.POSIXlt <- function(x, format = "", usetz = FALSE, digits = getOption("digits.secs"), ...) { if(!inherits(x, "POSIXlt")) stop("wrong class") - if(any(f0 <- format == "" | grepl("%OS$", format))) { - if(!is.null(digits)) { - secs <- x$sec[f0]; secs <- secs[is.finite(secs)] - np <- min(6L, digits) - ## no unnecessary trailing '0' ; use trunc() as .Internal() code: - for(i in seq_len(np)- 1L) + nf <- length(format) + useDig <- function(secs, digits) { + secs <- secs[is.finite(secs)] + np <- min(6L, digits) + if(np >= 1L) # no unnecessary trailing '0'; use trunc() as .Internal() code: + for (i in seq_len(np)- 1L) if(all( abs(secs - trunc(secs*(ti <- 10^i))/ti) < 1e-6 )) { np <- i break } - } else np <- 0L - ## need list `[` method here to get 1:3 ~ {sec, min, hour}: - times <- unlist(unclass(x)[1L:3L], use.names=FALSE)[f0] - format[f0] <- - if(all(times[is.finite(times)] == 0)) "%Y-%m-%d" - else if(np == 0L) "%Y-%m-%d %H:%M:%S" - else paste0("%Y-%m-%d %H:%M:%OS", np) + np } + if(any(f0 <- format == "")) { + x_ <- if(nf == 1L) x else x[f0] # any(f0) & nf = 1 ==> x[f0] = x + np <- if(!is.null(digits)) useDig(x_$sec, digits) else 0L + ## need list `[` method here to get 1:3 ~ {sec, min, hour} : + times <- unlist(unclass(x_)[1L:3L], use.names = FALSE) + format[f0] <- + if(all(times[is.finite(times)] == 0)) "%Y-%m-%d" + else if(np == 0L) "%Y-%m-%d %H:%M:%S" + else paste0("%Y-%m-%d %H:%M:%OS", np) + } + if(!missing(digits) && !is.null(digits) && digits != getOption("digits.secs", 0L) && + any(OS. <- grepl("%OS[^0-9]", format))) { ## use digits to find n to use for "%OS" + x_ <- if(nf == 1L) x else x[OS.] + np <- useDig(x_$sec, digits) + format[OS.] <- gsub("%OS([^0-9])", paste0("%OS", np, "\\1"), format[OS.]) + } + ## C code in do_formatPOSIXlt() *does* recycle {x, format} as needed: .Internal(format.POSIXlt(x, format, usetz)) } diff --git a/tests/datetime5.R b/tests/datetime5.R index d1b6098bdb0..7f9c1118876 100644 --- a/tests/datetime5.R +++ b/tests/datetime5.R @@ -1,4 +1,4 @@ -### tests of strftime (formatting POSIXlt objects). +### tests of strftime (formatting POSIXlt objects via format.POSIXlt) Sys.setenv(TZ = "Europe/Rome") @@ -27,3 +27,15 @@ for (f in c("P", "k", "l", "s")) { ## week numbers dt2 <- as.POSIXlt(sprintf("%d-01-01 09:03;04", 2015:2018)) cat(format(dt2, "%Y: %U %V %W"), sep = "\n") + +## recycling *both* {x, format} "heavily"; digits = must influence %OS; PR#17350 +(fmt <- c("", paste0("%H:%M:%OS", c("", 2), " in %Y"), # || nasty (but "correct") + paste0("%Y-%m-%d", c("", paste0(" %H:%M:%OS", c("", 0, 1, 6, 9, 11)))))) +weekD <- seq(as.Date("2020-04-01"), by = "weeks", length.out = 5 * length(fmt)) ; joff <- (0:4)*length(fmt) +weekPlt <- as.POSIXlt(weekD, tz = "UTC") +(Lf1 <- split(f1 <- format(weekPlt, format = fmt), fmt)) +(Lf. <- split(f. <- format(weekPlt + 0.25, format = fmt), fmt)) +(Lf3 <- split(f3 <- format(weekPlt + 0.25, format = fmt, digits = 3), fmt)) +stopifnot(f3[2L+joff] == f3[3L+joff], + grepl("^00:00:00.25 in 202[01]", f3[2L+joff])) +## digits = 3 had no effect on "%OS " diff --git a/tests/datetime5.Rout.save b/tests/datetime5.Rout.save index 0c179875616..200c1d2f9c6 100644 --- a/tests/datetime5.Rout.save +++ b/tests/datetime5.Rout.save @@ -1,5 +1,5 @@ -R Under development (unstable) (2024-03-19 r86151) -- "Unsuffered Consequences" +R Under development (unstable) (2024-12-03 r87418) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu @@ -15,7 +15,7 @@ Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. -> ### tests of strftime (formatting POSIXlt objects). +> ### tests of strftime (formatting POSIXlt objects via format.POSIXlt) > > Sys.setenv(TZ = "Europe/Rome") > @@ -89,4 +89,141 @@ Type 'q()' to quit R. 2017: 01 52 00 2018: 00 01 01 > +> ## recycling *both* {x, format} "heavily"; digits = must influence %OS; PR#17350 +> (fmt <- c("", paste0("%H:%M:%OS", c("", 2), " in %Y"), # || nasty (but "correct") ++ paste0("%Y-%m-%d", c("", paste0(" %H:%M:%OS", c("", 0, 1, 6, 9, 11)))))) + [1] "" "%H:%M:%OS in %Y" "%H:%M:%OS2 in %Y" + [4] "%Y-%m-%d" "%Y-%m-%d %H:%M:%OS" "%Y-%m-%d %H:%M:%OS0" + [7] "%Y-%m-%d %H:%M:%OS1" "%Y-%m-%d %H:%M:%OS6" "%Y-%m-%d %H:%M:%OS9" +[10] "%Y-%m-%d %H:%M:%OS11" +> weekD <- seq(as.Date("2020-04-01"), by = "weeks", length.out = 5 * length(fmt)) ; joff <- (0:4)*length(fmt) +> weekPlt <- as.POSIXlt(weekD, tz = "UTC") +> (Lf1 <- split(f1 <- format(weekPlt, format = fmt), fmt)) +[[1]] +[1] "2020-04-01" "2020-06-10" "2020-08-19" "2020-10-28" "2021-01-06" + +$`%H:%M:%OS in %Y` +[1] "00:00:00 in 2020" "00:00:00 in 2020" "00:00:00 in 2020" "00:00:00 in 2020" +[5] "00:00:00 in 2021" + +$`%H:%M:%OS2 in %Y` +[1] "00:00:00.00 in 2020" "00:00:00.00 in 2020" "00:00:00.00 in 2020" +[4] "00:00:00.00 in 2020" "00:00:00.00 in 2021" + +$`%Y-%m-%d` +[1] "2020-04-22" "2020-07-01" "2020-09-09" "2020-11-18" "2021-01-27" + +$`%Y-%m-%d %H:%M:%OS` +[1] "2020-04-29 00:00:00" "2020-07-08 00:00:00" "2020-09-16 00:00:00" +[4] "2020-11-25 00:00:00" "2021-02-03 00:00:00" + +$`%Y-%m-%d %H:%M:%OS0` +[1] "2020-05-06 00:00:00" "2020-07-15 00:00:00" "2020-09-23 00:00:00" +[4] "2020-12-02 00:00:00" "2021-02-10 00:00:00" + +$`%Y-%m-%d %H:%M:%OS1` +[1] "2020-05-13 00:00:00.0" "2020-07-22 00:00:00.0" "2020-09-30 00:00:00.0" +[4] "2020-12-09 00:00:00.0" "2021-02-17 00:00:00.0" + +$`%Y-%m-%d %H:%M:%OS11` +[1] "2020-06-03 00:00:00.01" "2020-08-12 00:00:00.01" "2020-10-21 00:00:00.01" +[4] "2020-12-30 00:00:00.01" "2021-03-10 00:00:00.01" + +$`%Y-%m-%d %H:%M:%OS6` +[1] "2020-05-20 00:00:00.000000" "2020-07-29 00:00:00.000000" +[3] "2020-10-07 00:00:00.000000" "2020-12-16 00:00:00.000000" +[5] "2021-02-24 00:00:00.000000" + +$`%Y-%m-%d %H:%M:%OS9` +[1] "2020-05-27 00:00:00.000000" "2020-08-05 00:00:00.000000" +[3] "2020-10-14 00:00:00.000000" "2020-12-23 00:00:00.000000" +[5] "2021-03-03 00:00:00.000000" + +> (Lf. <- split(f. <- format(weekPlt + 0.25, format = fmt), fmt)) +[[1]] +[1] "2020-04-01 00:00:00" "2020-06-10 00:00:00" "2020-08-19 00:00:00" +[4] "2020-10-28 00:00:00" "2021-01-06 00:00:00" + +$`%H:%M:%OS in %Y` +[1] "00:00:00 in 2020" "00:00:00 in 2020" "00:00:00 in 2020" "00:00:00 in 2020" +[5] "00:00:00 in 2021" + +$`%H:%M:%OS2 in %Y` +[1] "00:00:00.25 in 2020" "00:00:00.25 in 2020" "00:00:00.25 in 2020" +[4] "00:00:00.25 in 2020" "00:00:00.25 in 2021" + +$`%Y-%m-%d` +[1] "2020-04-22" "2020-07-01" "2020-09-09" "2020-11-18" "2021-01-27" + +$`%Y-%m-%d %H:%M:%OS` +[1] "2020-04-29 00:00:00" "2020-07-08 00:00:00" "2020-09-16 00:00:00" +[4] "2020-11-25 00:00:00" "2021-02-03 00:00:00" + +$`%Y-%m-%d %H:%M:%OS0` +[1] "2020-05-06 00:00:00" "2020-07-15 00:00:00" "2020-09-23 00:00:00" +[4] "2020-12-02 00:00:00" "2021-02-10 00:00:00" + +$`%Y-%m-%d %H:%M:%OS1` +[1] "2020-05-13 00:00:00.2" "2020-07-22 00:00:00.2" "2020-09-30 00:00:00.2" +[4] "2020-12-09 00:00:00.2" "2021-02-17 00:00:00.2" + +$`%Y-%m-%d %H:%M:%OS11` +[1] "2020-06-03 00:00:00.21" "2020-08-12 00:00:00.21" "2020-10-21 00:00:00.21" +[4] "2020-12-30 00:00:00.21" "2021-03-10 00:00:00.21" + +$`%Y-%m-%d %H:%M:%OS6` +[1] "2020-05-20 00:00:00.250000" "2020-07-29 00:00:00.250000" +[3] "2020-10-07 00:00:00.250000" "2020-12-16 00:00:00.250000" +[5] "2021-02-24 00:00:00.250000" + +$`%Y-%m-%d %H:%M:%OS9` +[1] "2020-05-27 00:00:00.250000" "2020-08-05 00:00:00.250000" +[3] "2020-10-14 00:00:00.250000" "2020-12-23 00:00:00.250000" +[5] "2021-03-03 00:00:00.250000" + +> (Lf3 <- split(f3 <- format(weekPlt + 0.25, format = fmt, digits = 3), fmt)) +[[1]] +[1] "2020-04-01 00:00:00.25" "2020-06-10 00:00:00.25" "2020-08-19 00:00:00.25" +[4] "2020-10-28 00:00:00.25" "2021-01-06 00:00:00.25" + +$`%H:%M:%OS in %Y` +[1] "00:00:00.25 in 2020" "00:00:00.25 in 2020" "00:00:00.25 in 2020" +[4] "00:00:00.25 in 2020" "00:00:00.25 in 2021" + +$`%H:%M:%OS2 in %Y` +[1] "00:00:00.25 in 2020" "00:00:00.25 in 2020" "00:00:00.25 in 2020" +[4] "00:00:00.25 in 2020" "00:00:00.25 in 2021" + +$`%Y-%m-%d` +[1] "2020-04-22" "2020-07-01" "2020-09-09" "2020-11-18" "2021-01-27" + +$`%Y-%m-%d %H:%M:%OS` +[1] "2020-04-29 00:00:00" "2020-07-08 00:00:00" "2020-09-16 00:00:00" +[4] "2020-11-25 00:00:00" "2021-02-03 00:00:00" + +$`%Y-%m-%d %H:%M:%OS0` +[1] "2020-05-06 00:00:00" "2020-07-15 00:00:00" "2020-09-23 00:00:00" +[4] "2020-12-02 00:00:00" "2021-02-10 00:00:00" + +$`%Y-%m-%d %H:%M:%OS1` +[1] "2020-05-13 00:00:00.2" "2020-07-22 00:00:00.2" "2020-09-30 00:00:00.2" +[4] "2020-12-09 00:00:00.2" "2021-02-17 00:00:00.2" + +$`%Y-%m-%d %H:%M:%OS11` +[1] "2020-06-03 00:00:00.21" "2020-08-12 00:00:00.21" "2020-10-21 00:00:00.21" +[4] "2020-12-30 00:00:00.21" "2021-03-10 00:00:00.21" + +$`%Y-%m-%d %H:%M:%OS6` +[1] "2020-05-20 00:00:00.250000" "2020-07-29 00:00:00.250000" +[3] "2020-10-07 00:00:00.250000" "2020-12-16 00:00:00.250000" +[5] "2021-02-24 00:00:00.250000" + +$`%Y-%m-%d %H:%M:%OS9` +[1] "2020-05-27 00:00:00.250000" "2020-08-05 00:00:00.250000" +[3] "2020-10-14 00:00:00.250000" "2020-12-23 00:00:00.250000" +[5] "2021-03-03 00:00:00.250000" + +> stopifnot(f3[2L+joff] == f3[3L+joff], ++ grepl("^00:00:00.25 in 202[01]", f3[2L+joff])) +> ## digits = 3 had no effect on "%OS " >