ensure hashtable growth for small HASHSIZE(table) <= 4

git-svn-id: https://svn.r-project.org/R/trunk@82178 00db46b3-68df-0310-9c12-caf00c1e9a41

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}.
 

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);

tests/reg-tests-1d.R

@@ -5837,17 +5837,27 @@ stopifnot(tanpi(outer(pm1/4, k, `+`)) == pm1,
 ## in R <= 4.1.x, tanpi(<int> +- 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(<lm>, 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