From 3560b606eb2b815c3fe0c8a5ba801cccde4c72ff Mon Sep 17 00:00:00 2001 From: hornik Date: Wed, 20 Nov 2024 07:06:17 +0000 Subject: [PATCH 1/8] Check formal validity of language tags in DESCRIPTION Language field (PR#18818). git-svn-id: https://svn.r-project.org/R/trunk@87349 00db46b3-68df-0310-9c12-caf00c1e9a41 --- src/library/tools/R/check.R | 13 ++++++++++ src/library/tools/R/utils.R | 47 +++++++++++++++++++++++++++++++++++++ 2 files changed, 60 insertions(+) diff --git a/src/library/tools/R/check.R b/src/library/tools/R/check.R index b52014c28cf..3e585d57ca0 100644 --- a/src/library/tools/R/check.R +++ b/src/library/tools/R/check.R @@ -1194,6 +1194,19 @@ add_dummies <- function(dir, Log) } } + if(!is.na(lang <- db["Language"])) { + s <- unlist(strsplit(lang, ", *"), use.names = FALSE) + s <- s[!grepl(re_anchor(.make_RFC4646_langtag_regexp()), s)] + if(length(s)) { + if(!any) noteLog(Log) + any <- TRUE + printLog(Log, + paste(c("Language field contains the following invalid language tags:", + paste0(" ", s)), + collapse = "\n"), + "\n") + } + } out <- format(.check_package_description2(dfile)) if (length(out)) { diff --git a/src/library/tools/R/utils.R b/src/library/tools/R/utils.R index 34353ca769c..b49c7950836 100644 --- a/src/library/tools/R/utils.R +++ b/src/library/tools/R/utils.R @@ -1842,6 +1842,53 @@ function(parent = parent.frame()) } }) +### ** .make_RFC4646_langtag_regexp + +.make_RFC4646_langtag_regexp <- +function() +{ + ## See . + ## Language tags can be of the form (in ABNF, see + ## ): + ## langtag / privateuse / grandfathered + ## where + ## privateuse = ("x"/"X") 1*("-" (1*8alphanum)) + ## grandfathered = 1*3ALPHA 1*2("-" (2*8alphanum)) + ## We only allow langtag, for which in turn we have + ## (language + ## ["-" script] + ## ["-" region] + ## *(["-" variant]) + ## *(["-" extension]) + ## ["-" privateuse] + ## where + ## language = (2*3ALPHA [-extlang]) ; shortest ISO 639 code + ## / 4ALPHA ; reserved for future use + ## / 5*8ALPHA ; registered language subtag + ## extlang = *3("-" 3*ALPHA) ; reserved for future use + ## script = 4ALPHA ; ISO 15924 code + ## region = 2ALPHA ; ISO 3166 code + ## / 3DIGIT ; UN M.49 code + ## variant = 5*8alphanum ; registered variants + ## / (DIGIT 3alphanum) + ## extension = singleton 1*("-" (2*8alphanum)) + ## singleton = %x41-57 / %x59-5A / %x61-77 / %x79-7A / DIGIT + ## ; "a"-"w" / "y"-"z" / "A"-"W" / "Y"-"Z" / "0"-"9" + ## alphanum = (ALPHA / DIGIT) ; letters and numbers + + re_extlang <- "[[:alpha:]]{3}" + re_language <- + sprintf("[[:alpha:]]{2,3}(-%s){0,3}|[[:alpha:]]{4,8}", re_extlang) + re_script <- "[[:alpha:]]{4}" + re_region <- "[[:alpha:]]{2}|[[:digit:]]{3}" + re_variant <- "[[:alnum:]]{5,8}|[[:digit:]][[:alnum:]]{3}" + re_singleton <- "[abcdefghijklmnopqrstuvwyzABCDEFGHIJKLMNOPQRSTUVWYZ0123456789]" + re_extension <- sprintf("(%s)(-[[:alnum:]]{2,8}){1,}", re_singleton) + + sprintf("(%s)((-%s)?)((-%s)?)((-%s)*)((-%s)*)", + re_language, re_script, re_region, re_variant, re_extension) +} + ### ** nonS3methods [was .make_S3_methods_stop_list ] nonS3methods <- function(package) From 489066b6a6ca056638e361b85a8e9c741a7db276 Mon Sep 17 00:00:00 2001 From: maechler Date: Wed, 20 Nov 2024 10:08:32 +0000 Subject: [PATCH 2/8] forgotten update for r81968: `digits` is used git-svn-id: https://svn.r-project.org/R/trunk@87350 00db46b3-68df-0310-9c12-caf00c1e9a41 --- src/library/base/man/strptime.Rd | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/library/base/man/strptime.Rd b/src/library/base/man/strptime.Rd index 9ab47d2010c..96ec975bd64 100644 --- a/src/library/base/man/strptime.Rd +++ b/src/library/base/man/strptime.Rd @@ -39,7 +39,8 @@ strptime(x, format, tz = "") methods is \code{"\%Y-\%m-\%d \%H:\%M:\%S"} if any element has a time component which is not midnight, and \code{"\%Y-\%m-\%d"} - otherwise. If \code{\link{options}("digits.secs")} is set, up to + otherwise. If \code{digits} is not \code{NULL}, i.e., by default when + \code{\link{options}("digits.secs")} is set, up to the specified number of digits will be printed for seconds.} \item{\dots}{further arguments to be passed from or to other methods.} \item{usetz}{logical. Should the time zone abbreviation be appended @@ -235,11 +236,10 @@ strptime(x, format, tz = "") Specific to \R is \code{\%OSn}, which for output gives the seconds truncated to \code{0 <= n <= 6} decimal places (and if \code{\%OS} is - not followed by a digit, it uses the setting of - \code{\link{getOption}("digits.secs")}, or if that is unset, \code{n = - 0}). Further, for \code{strptime} \code{\%OS} will input seconds - including fractional seconds. Note that \code{\%S} does not read - fractional parts on output. + not followed by a digit, it uses \code{digits} unless that is + \code{NULL}, when \code{n = 0}). Further, for \code{strptime} + \code{\%OS} will input seconds including fractional seconds. Note that + \code{\%S} does not read fractional parts on output. The behaviour of other conversion specifications (and even if other character sequences commencing with \code{\%} \emph{are} conversion @@ -307,7 +307,7 @@ strptime(x, format, tz = "") year. (On some platforms this works better after conversion to \code{"POSIXct"}. Some platforms only recognize hour or half-hour offsets for output.)%% strftime in macOS 13. - + Using \code{\%z} for input makes most sense with \code{tz = "UTC"}. } @@ -426,7 +426,8 @@ stopifnot(identical(format(z2), as.character(z2))) ## time with fractional seconds z3 <- strptime("20/2/06 11:16:16.683", "\%d/\%m/\%y \%H:\%M:\%OS") \donttest{ -z3 # prints without fractional seconds by default, digits.sec = NULL ("= 0")} +z3 # prints without fractional seconds by default, digits.sec = NULL ("= 0") +print(z3, digits = 3) # shows extra digits} op <- options(digits.secs = 3) \donttest{z3 # shows the 3 extra digits} as.character(z3) # ditto From 609d977a2433ea15f688876960966d74934e0dac Mon Sep 17 00:00:00 2001 From: luke Date: Wed, 20 Nov 2024 20:34:53 +0000 Subject: [PATCH 3/8] Better argument names. git-svn-id: https://svn.r-project.org/R/trunk@87352 00db46b3-68df-0310-9c12-caf00c1e9a41 --- src/main/envir.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/envir.c b/src/main/envir.c index f56e8d9cbaf..fc6e26dd67b 100644 --- a/src/main/envir.c +++ b/src/main/envir.c @@ -1287,9 +1287,9 @@ static SEXP findVarLoc(SEXP symbol, SEXP rho) #endif } -R_varloc_t R_findVarLoc(SEXP rho, SEXP symbol) +R_varloc_t R_findVarLoc(SEXP symbol, SEXP rho) { - SEXP binding = findVarLoc(rho, symbol); + SEXP binding = findVarLoc(symbol, rho); R_varloc_t val; val.cell = binding == R_NilValue ? NULL : binding; return val; From 56ae3990df7dbbfc3d3e3c23757e690c03f55054 Mon Sep 17 00:00:00 2001 From: maechler Date: Thu, 21 Nov 2024 09:17:06 +0000 Subject: [PATCH 4/8] cosmetic `...` speedup; fix indentation (84928) git-svn-id: https://svn.r-project.org/R/trunk@87353 00db46b3-68df-0310-9c12-caf00c1e9a41 --- src/library/base/R/dates.R | 161 ++++++++++++++++++------------------- 1 file changed, 80 insertions(+), 81 deletions(-) diff --git a/src/library/base/R/dates.R b/src/library/base/R/dates.R index 6b0bc7acef0..86feeff1ca7 100644 --- a/src/library/base/R/dates.R +++ b/src/library/base/R/dates.R @@ -51,14 +51,14 @@ as.Date.character <- function(x, format, optional = FALSE, ...) { charToDate <- function(x) { - is.na(x) <- !nzchar(x) # PR#17909 - xx <- x[1L] + is.na(x) <- !nzchar(x) # PR#17909 + xx <- x[1L] if(is.na(xx)) { j <- 1L while(is.na(xx) && (j <- j+1L) <= length(x)) xx <- x[j] if(is.na(xx)) f <- "%Y-%m-%d" # all NAs } - if(is.na(xx)) + if(is.na(xx)) strptime(x, f) else { for(ff in tryFormats) @@ -80,16 +80,16 @@ as.Date.numeric <- function(x, origin, ...) as.Date.default <- function(x, ...) { if(inherits(x, "Date")) - x + x else if(is.null(x)) .Date(numeric()) else if(is.logical(x) && all(is.na(x))) - .Date(as.numeric(x)) + .Date(as.numeric(x)) else - stop(gettextf("do not know how to convert '%s' to class %s", - deparse1(substitute(x)), - dQuote("Date")), - domain = NA) + stop(gettextf("do not know how to convert '%s' to class %s", + deparse1(substitute(x)), + dQuote("Date")), + domain = NA) } ## ## Moved to package date @@ -123,13 +123,13 @@ print.Date <- function(x, max = NULL, ...) { if(is.null(max)) max <- getOption("max.print", 9999L) if(max < length(x)) { - print(format(x[seq_len(max)]), max=max+1, ...) - cat(" [ reached 'max' / getOption(\"max.print\") -- omitted", - length(x) - max, 'entries ]\n') + print(format(x[seq_len(max)]), max=max+1, ...) + cat(" [ reached 'max' / getOption(\"max.print\") -- omitted", + length(x) - max, 'entries ]\n') } else if(length(x)) - print(format(x), max = max, ...) - else - cat(class(x)[1L], "of length 0\n") + print(format(x), max = max, ...) + else + cat(class(x)[1L], "of length 0\n") invisible(x) } @@ -203,7 +203,7 @@ Summary.Date <- function (..., na.rm) ok <- switch(.Generic, max = , min = , range = TRUE, FALSE) if (!ok) stop(gettextf("%s not defined for \"Date\" objects", .Generic), domain = NA) - .Date(NextMethod(.Generic), oldClass(list(...)[[1L]])) + .Date(NextMethod(.Generic), oldClass(...elt(1L))) } `[.Date` <- function(x, ..., drop = TRUE) @@ -329,84 +329,84 @@ cut.Date <- x <- as.Date(x) if (inherits(breaks, "Date")) { - breaks <- sort(as.Date(breaks)) + breaks <- sort(as.Date(breaks)) } else if(is.numeric(breaks) && length(breaks) == 1L) { - ## specified number of breaks + ## specified number of breaks } else if(is.character(breaks) && length(breaks) == 1L) { - by2 <- strsplit(breaks, " ", fixed = TRUE)[[1L]] - if(length(by2) > 2L || length(by2) < 1L) - stop("invalid specification of 'breaks'") - valid <- - pmatch(by2[length(by2)], - c("days", "weeks", "months", "years", "quarters")) - if(is.na(valid)) stop("invalid specification of 'breaks'") - start <- as.POSIXlt(min(x, na.rm=TRUE)) - if(valid == 1L) incr <- 1L - if(valid == 2L) { # weeks - start$mday <- start$mday - start$wday - if(start.on.monday) - start$mday <- start$mday + ifelse(start$wday > 0L, 1L, -6L) + by2 <- strsplit(breaks, " ", fixed = TRUE)[[1L]] + if(length(by2) > 2L || length(by2) < 1L) + stop("invalid specification of 'breaks'") + valid <- + pmatch(by2[length(by2)], + c("days", "weeks", "months", "years", "quarters")) + if(is.na(valid)) stop("invalid specification of 'breaks'") + start <- as.POSIXlt(min(x, na.rm=TRUE)) + if(valid == 1L) incr <- 1L + if(valid == 2L) { # weeks + start$mday <- start$mday - start$wday + if(start.on.monday) + start$mday <- start$mday + ifelse(start$wday > 0L, 1L, -6L) start$isdst <- -1L - incr <- 7L - } - if(valid == 3L) { # months - start$mday <- 1L + incr <- 7L + } + if(valid == 3L) { # months + start$mday <- 1L start$isdst <- -1L maxx <- max(x, na.rm = TRUE) - end <- as.POSIXlt(maxx) - step <- if(length(by2) == 2L) as.integer(by2[1L]) else 1L - end <- as.POSIXlt(end + (31 * step * 86400)) - end$mday <- 1L + end <- as.POSIXlt(maxx) + step <- if(length(by2) == 2L) as.integer(by2[1L]) else 1L + end <- as.POSIXlt(end + (31 * step * 86400)) + end$mday <- 1L end$isdst <- -1L - breaks <- as.Date(seq(start, end, breaks)) + breaks <- as.Date(seq(start, end, breaks)) ## 31 days ahead could give an empty level, so - lb <- length(breaks) - if(maxx < breaks[lb-1]) breaks <- breaks[-lb] - } else if(valid == 4L) { # years - start$mon <- 0L - start$mday <- 1L + lb <- length(breaks) + if(maxx < breaks[lb-1]) breaks <- breaks[-lb] + } else if(valid == 4L) { # years + start$mon <- 0L + start$mday <- 1L start$isdst <- -1L maxx <- max(x, na.rm = TRUE) - end <- as.POSIXlt(maxx) - step <- if(length(by2) == 2L) as.integer(by2[1L]) else 1L - end <- as.POSIXlt(end + (366 * step * 86400)) - end$mon <- 0L - end$mday <- 1L + end <- as.POSIXlt(maxx) + step <- if(length(by2) == 2L) as.integer(by2[1L]) else 1L + end <- as.POSIXlt(end + (366 * step * 86400)) + end$mon <- 0L + end$mday <- 1L end$isdst <- -1L - breaks <- as.Date(seq(start, end, breaks)) + breaks <- as.Date(seq(start, end, breaks)) ## 366 days ahead could give an empty level, so - lb <- length(breaks) - if(maxx < breaks[lb-1]) breaks <- breaks[-lb] - } else if(valid == 5L) { # quarters - qtr <- rep(c(0L, 3L, 6L, 9L), each = 3L) - start$mon <- qtr[start$mon + 1L] - start$mday <- 1L + lb <- length(breaks) + if(maxx < breaks[lb-1]) breaks <- breaks[-lb] + } else if(valid == 5L) { # quarters + qtr <- rep(c(0L, 3L, 6L, 9L), each = 3L) + start$mon <- qtr[start$mon + 1L] + start$mday <- 1L start$isdst <- -1L - maxx <- max(x, na.rm = TRUE) - end <- as.POSIXlt(maxx) - step <- if(length(by2) == 2L) as.integer(by2[1L]) else 1L - end <- as.POSIXlt(end + (93 * step * 86400)) - end$mon <- qtr[end$mon + 1L] - end$mday <- 1L + maxx <- max(x, na.rm = TRUE) + end <- as.POSIXlt(maxx) + step <- if(length(by2) == 2L) as.integer(by2[1L]) else 1L + end <- as.POSIXlt(end + (93 * step * 86400)) + end$mon <- qtr[end$mon + 1L] + end$mday <- 1L end$isdst <- -1L - breaks <- as.Date(seq(start, end, paste(step * 3L, "months"))) - ## 93 days ahead could give an empty level, so - lb <- length(breaks) - if(maxx < breaks[lb-1]) breaks <- breaks[-lb] - } else { - start <- as.Date(start) - if (length(by2) == 2L) incr <- incr * as.integer(by2[1L]) - maxx <- max(x, na.rm = TRUE) - breaks <- seq(start, maxx + incr, breaks) - breaks <- breaks[seq_len(1L+max(which(breaks <= maxx)))] - } + breaks <- as.Date(seq(start, end, paste(step * 3L, "months"))) + ## 93 days ahead could give an empty level, so + lb <- length(breaks) + if(maxx < breaks[lb-1]) breaks <- breaks[-lb] + } else { + start <- as.Date(start) + if (length(by2) == 2L) incr <- incr * as.integer(by2[1L]) + maxx <- max(x, na.rm = TRUE) + breaks <- seq(start, maxx + incr, breaks) + breaks <- breaks[seq_len(1L+max(which(breaks <= maxx)))] + } } else stop("invalid specification of 'breaks'") res <- cut(unclass(x), unclass(breaks), labels = labels, - right = right, ...) + right = right, ...) if(is.null(labels)) { - levels(res) <- - as.character(if (is.numeric(breaks)) x[!duplicated(res)] - else breaks[-length(breaks)]) + levels(res) <- + as.character(if (is.numeric(breaks)) x[!duplicated(res)] + else breaks[-length(breaks)]) } res } @@ -465,9 +465,8 @@ diff.Date <- function (x, lag = 1L, differences = 1L, ...) r[-nrow(r):-(nrow(r) - lag + 1L), , drop = FALSE] else for (i in seq_len(differences)) r <- r[i1] - r[-length(r):-(length(r) - lag + 1L)] - dots <- list(...) - if("units" %in% names(dots) && dots$units != "auto") - units(r) <- match.arg(dots$units, choices = setdiff(eval(formals(difftime)$units), "auto")) + if("units" %in% ...names() && (dunits <- list(...)$units) != "auto") + units(r) <- match.arg(dunits, choices = setdiff(eval(formals(difftime)$units), "auto")) r } From ed0d98bc26d5724cbaaa7bd03760671746c79eb2 Mon Sep 17 00:00:00 2001 From: maechler Date: Thu, 21 Nov 2024 10:31:48 +0000 Subject: [PATCH 5/8] fix format.POSIXlt() for fractional secs git-svn-id: https://svn.r-project.org/R/trunk@87354 00db46b3-68df-0310-9c12-caf00c1e9a41 --- doc/NEWS.Rd | 6 ++++++ src/library/base/R/datetime.R | 20 +++++++++-------- src/library/base/man/strptime.Rd | 27 ++++++++++++++--------- tests/datetime5.R | 37 ++++++++++++++++++++++++++++++++ 4 files changed, 71 insertions(+), 19 deletions(-) diff --git a/doc/NEWS.Rd b/doc/NEWS.Rd index d7eed54a1a1..3505df45dd7 100644 --- a/doc/NEWS.Rd +++ b/doc/NEWS.Rd @@ -368,6 +368,12 @@ \item \code{debugonce(, signature=*)} now works correctly when \dQuote{called twice}, fixing \PR{18824} thanks to \I{Michael Jagan}. + + \item \code{format(dtime, digits=* / format=*)} is more consistent + 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}. } } } diff --git a/src/library/base/R/datetime.R b/src/library/base/R/datetime.R index f870e95a966..14d9003f4ad 100644 --- a/src/library/base/R/datetime.R +++ b/src/library/base/R/datetime.R @@ -382,18 +382,20 @@ format.POSIXlt <- function(x, format = "", usetz = FALSE, digits = getOption("digits.secs"), ...) { if(!inherits(x, "POSIXlt")) stop("wrong class") - if(any(f0 <- format == "")) { - ## need list [ method here. - times <- unlist(unclass(x)[1L:3L])[f0] - secs <- x$sec[f0]; secs <- secs[is.finite(secs)] - np <- if(is.null(digits)) 0L else min(6L, digits) - if(np >= 1L) # no unnecessary trailing '0' : - for (i in seq_len(np)- 1L) - if(all( abs(secs - round(secs, i)) < 1e-6 )) { + 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) + if(all( abs(secs - trunc(secs*(ti <- 10^i))/ti) < 1e-6 )) { np <- i break } - format[f0] <- + } else np <- 0L + ## need list `[` method here to get 1:3 ~ {sec, min, hour}: + times <- unlist(`names<-`(unclass(x)[1L:3L], NULL))[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) diff --git a/src/library/base/man/strptime.Rd b/src/library/base/man/strptime.Rd index 96ec975bd64..dc9ffd1e0f7 100644 --- a/src/library/base/man/strptime.Rd +++ b/src/library/base/man/strptime.Rd @@ -39,9 +39,11 @@ strptime(x, format, tz = "") methods is \code{"\%Y-\%m-\%d \%H:\%M:\%S"} if any element has a time component which is not midnight, and \code{"\%Y-\%m-\%d"} - otherwise. If \code{digits} is not \code{NULL}, i.e., by default when - \code{\link{options}("digits.secs")} is set, up to - the specified number of digits will be printed for seconds.} + otherwise. In the first case and if \code{digits} is not \code{NULL}, + i.e., by default when \code{\link{options}("digits.secs")} is set, up to + the specified number of digits will be printed for seconds, using + \code{"\%OS"} instead of \code{"\%S"} in the format, see also + \sQuote{Details}.} \item{\dots}{further arguments to be passed from or to other methods.} \item{usetz}{logical. Should the time zone abbreviation be appended to the output? This is used in printing times, and more reliable @@ -237,7 +239,9 @@ strptime(x, format, tz = "") Specific to \R is \code{\%OSn}, which for output gives the seconds truncated to \code{0 <= n <= 6} decimal places (and if \code{\%OS} is not followed by a digit, it uses \code{digits} unless that is - \code{NULL}, when \code{n = 0}). Further, for \code{strptime} + \code{NULL}, when \code{n = 0}). Note that the precedence is + \code{format="...\%OSn"} \eqn{\ll}{>>} \code{digits = n} \eqn{\ll}{>>} + \code{getOption("digits.prec")}. Further, for \code{strptime} \code{\%OS} will input seconds including fractional seconds. Note that \code{\%S} does not read fractional parts on output. @@ -424,14 +428,17 @@ z2 <- strptime(x, "\%m/\%d/\%y \%H:\%M:\%S") ## *here* (but not in general), the same as format(): stopifnot(identical(format(z2), as.character(z2))) -## time with fractional seconds -z3 <- strptime("20/2/06 11:16:16.683", "\%d/\%m/\%y \%H:\%M:\%OS") \donttest{ +## time with fractional seconds (setting `tz = ..` for reproducible output) +z3 <- strptime("20/2/06 11:16:16.683", "\%d/\%m/\%y \%H:\%M:\%OS", tz = "UTC") z3 # prints without fractional seconds by default, digits.sec = NULL ("= 0") -print(z3, digits = 3) # shows extra digits} -op <- options(digits.secs = 3) -\donttest{z3 # shows the 3 extra digits} -as.character(z3) # ditto +format(z3, digits = 3) # shows extra digits +format(z3, digits = 6) # still 3 digits: *not* showing trailing zeros +format(z3, format = "\%Y-\%m-\%d \%H:\%M:\%OS6") # *does* keep trailing zeros +op <- options(digits.secs = 3) # global option, the default for `digits` +z3 # shows the 3 extra digits options(op) +as.character(z3) # ditto + ## time zone names are not portable, but 'EST5EDT' comes pretty close. ## (but its interpretation may not be universal: see ?timezones) diff --git a/tests/datetime5.R b/tests/datetime5.R index a0a44867919..712736c617a 100644 --- a/tests/datetime5.R +++ b/tests/datetime5.R @@ -28,3 +28,40 @@ for (f in c("P", "k", "l", "s")) { dt2 <- as.POSIXlt(sprintf("%d-01-01 09:03;04", 2015:2018)) cat(format(dt2, "%Y: %U %V %W"), sep = "\n") + +## fractional seconds print() --> format.POSIXlt() -- PR#17350 (and rdev day #83) +## Original PR#17350 example (Vitalie Spinu): +op <- options(digits.secs = 6, scipen = 20, digits = 15) +## what we'd desire for print()ing etc: +chx <- paste0("2009-08-03 12:01:59", c("", paste0(".",1:3))) +print(chx, width = 40) +xl <- as.POSIXlt(chx) +stopifnot(identical(xl$sec, 59 + 0:3/10)) # POSIXlt keeping full precision (always did) +## (but all arithmetic with POSIX*t currently happens via POSIXct, losing precision) +fxl <- format(xl) # is perfect {with getOption("digits.secs") > 0 !} +stopifnot(identical(sub(".*:59", '', fxl), paste0(".", 0:3))) +x <- as.POSIXct("2009-08-03 12:01:59") + 0:3/10 # using POSIXct looses prec +x. <- structure(x, tzone = "") ## == Vitalie's explicit original ex. +identical(x, x.) # FALSE : x. contains `tzone = ""` +print(x, width = 40) # now .000000 .099999 2.00000 2.999999 (as digits.secs = 6 !) +fx <- format(x) +stopifnot(identical(fx, format(x.))) # *are* the same (for a while now) +## The %OS and %OS formats have been fine "always": +fD.OS <- function(d) format(x, format = paste0("%Y-%m-%d %H:%M:%OS", if(d=="_") "" else d)) +f.OSss <- vapply(c("_",0:6), fD.OS, character(length(x))) +t(f.OSss) |> print(width=111, quote=FALSE) # shows 'trunc()' instead of 'round()' +stopifnot(identical(f.OSss[,"_"], f.OSss[,"6"])) # by option digits.secs +(secDig <- sub(".*:59", '', f.OSss)) ## [,"1"] is *.0 *.0 *.2 *.2 - "bad" from using trunc() by design +## ___________ ___ __ __ "factory fresh" default +options(digits.secs = NULL, scipen = 0, digits = 7) +f.OSssD <- vapply(c("_",0:6), fD.OS, character(length(x))) # same call but different "digits.secs" option +## digits = now works "the same": +fdig <- vapply(c("_",0:6), \(d) format(x, digits = if(d != "_") d), character(length(x))) +stopifnot(exprs = { + nchar(t(secDig)) == c(7L, 0L, 2:7) # as always + identical(f.OSssD[, 1], f.OSssD[,"0"]) # "" <--> "0" + identical(f.OSss [,-1], f.OSssD[, -1]) # only meaning of `empty' "%OS" changes with "digits.secs" option + identical(fdig, f.OSssD) +}) +options(op) +## Number of digits used differed in several cases in R <= 4.4.z From 079a1fa73e73b5a68a2487a83026042d931b9cad Mon Sep 17 00:00:00 2001 From: kalibera Date: Thu, 21 Nov 2024 11:25:20 +0000 Subject: [PATCH 6/8] Fix link. git-svn-id: https://svn.r-project.org/R/trunk@87355 00db46b3-68df-0310-9c12-caf00c1e9a41 --- doc/manual/Makefile.in | 4 +++- doc/manual/Makefile.win | 4 +++- doc/manual/R-admin.texi | 8 ++++---- 3 files changed, 10 insertions(+), 6 deletions(-) diff --git a/doc/manual/Makefile.in b/doc/manual/Makefile.in index eeafa0897b8..c0434b1f739 100644 --- a/doc/manual/Makefile.in +++ b/doc/manual/Makefile.in @@ -211,7 +211,9 @@ version.texi: Makefile $(top_srcdir)/VERSION $(SVN_REV) v="$${vv} (`sed -e 1d -e 's/^Last Changed Date: //' $(SVN_REV)`)"; \ $(ECHO) "@set VERSION $${v}" >> $@; \ rwv=`$(R_EXE) -f $(top_srcdir)/src/gnuwin32/fixed/rwver.R`; \ - $(ECHO) "@set RWVERSION $${rwv}" >> $@ ) + $(ECHO) "@set RWVERSION $${rwv}" >> $@; \ + rwtv=`$(ECHO) $${rwv} | sed -e 's/\.[^.]\+$$//'` >> $@; \ + $(ECHO) "@set RWTVERSION $${rwtv}" >> $@ ) @if test "$(R_PAPERSIZE)" = "a4"; then \ $(ECHO) "@afourpaper" >> $@ ; \ fi diff --git a/doc/manual/Makefile.win b/doc/manual/Makefile.win index bccf08a0532..b3ad0b8adc2 100644 --- a/doc/manual/Makefile.win +++ b/doc/manual/Makefile.win @@ -171,7 +171,9 @@ version.texi: Makefile.win $(top_srcdir)/VERSION $(SVN_REV) v="$${vv} (`sed -e 1d -e 's/^Last Changed Date: //' $(SVN_REV)`)"; \ $(ECHO) "@set VERSION $${v}" >> $@; \ rwv=$(shell ../../bin$(R_ARCH)/Rscript ../../src/gnuwin32/fixed/rwver.R); \ - $(ECHO) "@set RWVERSION $${rwv}" >> $@ ) + $(ECHO) "@set RWVERSION $${rwv}" >> $@; \ + rwtv=`$(ECHO) $${rwv} | sed -e 's/\.[^.]\+$$//'`; \ + $(ECHO) "@set RWTVERSION $${rwtv}" >> $@ ) @if test "$(R_PAPERSIZE)" = "a4"; then \ $(ECHO) "@afourpaper" >> $@ ; \ fi diff --git a/doc/manual/R-admin.texi b/doc/manual/R-admin.texi index ace3db3ce01..ac6425b571e 100644 --- a/doc/manual/R-admin.texi +++ b/doc/manual/R-admin.texi @@ -1388,8 +1388,8 @@ The binary distribution of @R{} is currently built with tools from @uref{https://CRAN.R-project.org/bin/windows/Rtools/rtools44/rtools.html,Rtools44 for Windows}. See -@uref{https://CRAN.R-project.org/bin/windows/base/howto-R-devel.html, Building -R and packages} for more details on how to use it. +@uref{https://CRAN.R-project.org/bin/windows/base/howto-@value{RWTVERSION}.html, +Building @value{RWTVERSION} and packages on Windows} for more details on how to use it. The toolset includes compilers (currently GCC version 13.2.0 with selected additional patches) and runtime libraries from @@ -2074,8 +2074,8 @@ code, and @code{install.packages(type="source")} will work for such packages. Those with compiled code need the tools (see @ref{The Windows toolset}). The tools are found automatically by @R{} when installed by the toolset installer. See -@uref{https://cran.r-project.org/bin/windows/base/howto-R-devel.html,Building -R and packages} for more details. +@uref{https://cran.r-project.org/bin/windows/base/howto-@value{RWTVERSION}.html, +Building @value{RWTVERSION} and packages on Windows} for more details. Occasional permission problems after unpacking source packages have been seen on some systems: these have been circumvented by setting the From aef5726ff1f820b45e6d73f8a09ed4c156dae785 Mon Sep 17 00:00:00 2001 From: maechler Date: Thu, 21 Nov 2024 14:00:03 +0000 Subject: [PATCH 7/8] mv new strict checks from *5 to *3 git-svn-id: https://svn.r-project.org/R/trunk@87357 00db46b3-68df-0310-9c12-caf00c1e9a41 --- tests/datetime3.R | 38 ++++++++++++++++++++++++++++++++++++++ tests/datetime5.R | 38 -------------------------------------- 2 files changed, 38 insertions(+), 38 deletions(-) diff --git a/tests/datetime3.R b/tests/datetime3.R index 3e339e3c0f2..e0d3c222efd 100644 --- a/tests/datetime3.R +++ b/tests/datetime3.R @@ -601,6 +601,44 @@ stopifnot(exprs = { }) +## fractional seconds print() --> format.POSIXlt() -- PR#17350 (and rdev day #83) +## Original PR#17350 example (Vitalie Spinu): +op <- options(digits.secs = 6, scipen = 20, digits = 15) +## what we'd desire for print()ing etc: +chx <- paste0("2009-08-03 12:01:59", c("", paste0(".",1:3))) +print(chx, width = 40) +xl <- as.POSIXlt(chx) +stopifnot(identical(xl$sec, 59 + 0:3/10)) # POSIXlt keeping full precision (always did) +## (but all arithmetic with POSIX*t currently happens via POSIXct, losing precision) +fxl <- format(xl) # is perfect {with getOption("digits.secs") > 0 !} +stopifnot(identical(sub(".*:59", '', fxl), paste0(".", 0:3))) +x <- as.POSIXct("2009-08-03 12:01:59") + 0:3/10 # using POSIXct looses prec +x. <- structure(x, tzone = "") ## == Vitalie's explicit original ex. +identical(x, x.) # FALSE : x. contains `tzone = ""` +print(x, width = 40) # now .000000 .099999 2.00000 2.999999 (as digits.secs = 6 !) +fx <- format(x) +stopifnot(identical(fx, format(x.))) # *are* the same (for a while now) +## The %OS and %OS formats have been fine "always": +fD.OS <- function(d) format(x, format = paste0("%Y-%m-%d %H:%M:%OS", if(d=="_") "" else d)) +f.OSss <- vapply(c("_",0:6), fD.OS, character(length(x))) +t(f.OSss) |> print(width=111, quote=FALSE) # shows 'trunc()' instead of 'round()' +stopifnot(identical(f.OSss[,"_"], f.OSss[,"6"])) # by option digits.secs +(secDig <- sub(".*:59", '', f.OSss)) ## [,"1"] is *.0 *.0 *.2 *.2 - "bad" from using trunc() by design +## ___________ ___ __ __ "factory fresh" default +options(digits.secs = NULL, scipen = 0, digits = 7) +f.OSssD <- vapply(c("_",0:6), fD.OS, character(length(x))) # same call but different "digits.secs" option +## digits = now works "the same": +fdig <- vapply(c("_",0:6), \(d) format(x, digits = if(d != "_") d), character(length(x))) +stopifnot(exprs = { + nchar(t(secDig)) == c(7L, 0L, 2:7) # as always + identical(f.OSssD[, 1], f.OSssD[,"0"]) # "" <--> "0" + identical(f.OSss [,-1], f.OSssD[, -1]) # only meaning of `empty' "%OS" changes with "digits.secs" option + identical(fdig, f.OSssD) +}) +options(op) +## Number of digits used differed in several cases in R <= 4.4.z + + ## keep at end rbind(last = proc.time() - .pt, diff --git a/tests/datetime5.R b/tests/datetime5.R index 712736c617a..d1b6098bdb0 100644 --- a/tests/datetime5.R +++ b/tests/datetime5.R @@ -27,41 +27,3 @@ 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") - - -## fractional seconds print() --> format.POSIXlt() -- PR#17350 (and rdev day #83) -## Original PR#17350 example (Vitalie Spinu): -op <- options(digits.secs = 6, scipen = 20, digits = 15) -## what we'd desire for print()ing etc: -chx <- paste0("2009-08-03 12:01:59", c("", paste0(".",1:3))) -print(chx, width = 40) -xl <- as.POSIXlt(chx) -stopifnot(identical(xl$sec, 59 + 0:3/10)) # POSIXlt keeping full precision (always did) -## (but all arithmetic with POSIX*t currently happens via POSIXct, losing precision) -fxl <- format(xl) # is perfect {with getOption("digits.secs") > 0 !} -stopifnot(identical(sub(".*:59", '', fxl), paste0(".", 0:3))) -x <- as.POSIXct("2009-08-03 12:01:59") + 0:3/10 # using POSIXct looses prec -x. <- structure(x, tzone = "") ## == Vitalie's explicit original ex. -identical(x, x.) # FALSE : x. contains `tzone = ""` -print(x, width = 40) # now .000000 .099999 2.00000 2.999999 (as digits.secs = 6 !) -fx <- format(x) -stopifnot(identical(fx, format(x.))) # *are* the same (for a while now) -## The %OS and %OS formats have been fine "always": -fD.OS <- function(d) format(x, format = paste0("%Y-%m-%d %H:%M:%OS", if(d=="_") "" else d)) -f.OSss <- vapply(c("_",0:6), fD.OS, character(length(x))) -t(f.OSss) |> print(width=111, quote=FALSE) # shows 'trunc()' instead of 'round()' -stopifnot(identical(f.OSss[,"_"], f.OSss[,"6"])) # by option digits.secs -(secDig <- sub(".*:59", '', f.OSss)) ## [,"1"] is *.0 *.0 *.2 *.2 - "bad" from using trunc() by design -## ___________ ___ __ __ "factory fresh" default -options(digits.secs = NULL, scipen = 0, digits = 7) -f.OSssD <- vapply(c("_",0:6), fD.OS, character(length(x))) # same call but different "digits.secs" option -## digits = now works "the same": -fdig <- vapply(c("_",0:6), \(d) format(x, digits = if(d != "_") d), character(length(x))) -stopifnot(exprs = { - nchar(t(secDig)) == c(7L, 0L, 2:7) # as always - identical(f.OSssD[, 1], f.OSssD[,"0"]) # "" <--> "0" - identical(f.OSss [,-1], f.OSssD[, -1]) # only meaning of `empty' "%OS" changes with "digits.secs" option - identical(fdig, f.OSssD) -}) -options(op) -## Number of digits used differed in several cases in R <= 4.4.z From 4222b9a6b76b7dbf0f84d7533350c4ca720494c3 Mon Sep 17 00:00:00 2001 From: maechler Date: Thu, 21 Nov 2024 14:12:34 +0000 Subject: [PATCH 8/8] mention \dontdiff{} git-svn-id: https://svn.r-project.org/R/trunk@87358 00db46b3-68df-0310-9c12-caf00c1e9a41 --- src/library/tools/man/Rdiff.Rd | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/library/tools/man/Rdiff.Rd b/src/library/tools/man/Rdiff.Rd index ff285a5f6b3..a7e00b6d8cd 100644 --- a/src/library/tools/man/Rdiff.Rd +++ b/src/library/tools/man/Rdiff.Rd @@ -1,6 +1,6 @@ % File src/library/tools/man/Rdiff.Rd % Part of the R package, https://www.R-project.org -% Copyright 2010-2023 R Core Team +% Copyright 2010-2024 R Core Team % Distributed under GPL 2 or later \name{Rdiff} @@ -58,6 +58,8 @@ Rdiff(from, to, useDiff = FALSE, forEx = FALSE, Mainly for use in examples and tests, text from marker \samp{> ## IGNORE_RDIFF_BEGIN} up to (but not including) \samp{> ## IGNORE_RDIFF_END} is ignored. + In examples, since \R 4.4.0, the built-in Rd macro \verb{\dontdiff\{\}} + can be used instead. } \value{ If \code{Log} is true, a list with components \code{status} (see