diff --git a/doc/NEWS.Rd b/doc/NEWS.Rd index 4937d20af7b..aa26a0e07da 100644 --- a/doc/NEWS.Rd +++ b/doc/NEWS.Rd @@ -50,7 +50,7 @@ [In progress: scheduled for May 5 if enough packages are corrected before then. - + Setting environment variable \env{_R_INSTALL_USE_FC_LEN_T_} to a true value enables this \emph{pro tem}. This is set by \command{R CMD check --as-cran} when it installs a package.] @@ -65,6 +65,13 @@ [Scheduled for Apr 23.] } } + + \subsection{BUG FIXES}{ + \itemize{ + \item Hashed \code{environment}s with sizes less than 5 now can grow, + too. (Reported to R-devel by Duncan Garmonsway.) + } + } } \section{\Rlogo CHANGES IN R 4.2.0}{ @@ -293,7 +300,7 @@ \item New functions \code{psmirnov()}, \code{qsmirnov()} and \code{rsmirnov()} in package \pkg{stats} implementing the asymptotic and exact distributions of the two-sample Smirnov statistic. - + \item \code{iconv()} now allows \code{sub = "c99"} to use C99-style escapes for UTF-8 inputs which cannot be converted to encoding \code{to}. diff --git a/src/main/envir.c b/src/main/envir.c index a1b9f96fddc..f877fb6dea0 100644 --- a/src/main/envir.c +++ b/src/main/envir.c @@ -1,6 +1,6 @@ /* * R : A Computer Language for Statistical Data Analysis - * Copyright (C) 1999--2021 The R Core Team. + * Copyright (C) 1999--2022 The R Core Team. * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka * * This program is free software; you can redistribute it and/or modify @@ -425,9 +425,6 @@ static void R_HashDelete(int hashcode, SEXP symbol, SEXP env, int *found) static SEXP R_HashResize(SEXP table) { - SEXP new_table, chain, new_chain, tmp_chain; - int counter, new_hashcode; - /* Do some checking */ if (TYPEOF(table) != VECSXP) error("first argument ('table') not of type VECSXP, from R_HashResize"); @@ -437,17 +434,17 @@ static SEXP R_HashResize(SEXP table) /* hash_grow = HASHSIZE(table); */ /* Allocate the new hash table */ - new_table = R_NewHashTable((int)(HASHSIZE(table) * HASHTABLEGROWTHRATE)); - for (counter = 0; counter < length(table); counter++) { - chain = VECTOR_ELT(table, counter); + SEXP new_table = R_NewHashTable(1 + (int)(HASHSIZE(table) * HASHTABLEGROWTHRATE)); + for (int counter = 0; counter < length(table); counter++) { + SEXP chain = VECTOR_ELT(table, counter); while (!ISNULL(chain)) { - new_hashcode = R_Newhashpjw(CHAR(PRINTNAME(TAG(chain)))) % + int new_hashcode = R_Newhashpjw(CHAR(PRINTNAME(TAG(chain)))) % HASHSIZE(new_table); - new_chain = VECTOR_ELT(new_table, new_hashcode); + SEXP new_chain = VECTOR_ELT(new_table, new_hashcode); /* If using a primary slot then increase HASHPRI */ if (ISNULL(new_chain)) SET_HASHPRI(new_table, HASHPRI(new_table) + 1); - tmp_chain = chain; + SEXP tmp_chain = chain; chain = CDR(chain); SETCDR(tmp_chain, new_chain); SET_VECTOR_ELT(new_table, new_hashcode, tmp_chain); diff --git a/tests/reg-tests-1d.R b/tests/reg-tests-1d.R index 73e9fb98183..90e0a880f11 100644 --- a/tests/reg-tests-1d.R +++ b/tests/reg-tests-1d.R @@ -5837,17 +5837,27 @@ stopifnot(tanpi(outer(pm1/4, k, `+`)) == pm1, ## in R <= 4.1.x, tanpi( +- 1/4 ) values typically were off (by +/- 2^-53) -## plot.lm(which = 5), when leverages are constant, -## failed for character predictors in R <= 4.1.x -- PR#17840 +## plot.lm(which = 5), when leverages are constant -- PR#17840 dd <- expand.grid(a = factor(1:3), b = factor(1:2), c = as.character(1:2), stringsAsFactors = FALSE) dd$y <- rnorm(nrow(dd)) plot(lm(y~a+b+c, dd), which = 5) # gave Error: non-conformable arguments plot(lm(y~ b+c, dd), which = 5) # gave Error: 'x' and 'y' lengths differ -tryCatch( +r <- tryCatch( plot(lm(y~ c, dd), which = 5) # gave empty plot, noting missing factors -, message = function(m) - stopifnot(!grepl("no factor predictors", conditionMessage(m), fixed=TRUE))) + , message = conditionMessage) +stopifnot("plot(, which=5) gave message and no plot" = is.null(r)) +## failed for character predictors in R <= 4.1.x + + +## very small size hashed environments +n <- 123 +l <- setNames(vector("list", n), seq_len(n)) +ehLs <- lapply(1:6, function(sz) list2env(l, hash=TRUE, size = sz)) +(nch <- vapply(ehLs, \(.) env.profile(.)$nchains, 0))# gave 1 2 3 4 109 109 +stopifnot(nch >= 24) # seeing 106 .. 106 111 +## hashed environments did not grow for size <= 4 in R <= 4.1.x + ## keep at end