diff --git a/R/DBI.R b/R/DBI.R index c57b7b824..bd70d738d 100644 --- a/R/DBI.R +++ b/R/DBI.R @@ -25,17 +25,23 @@ createCache <- function(cachePath, drv = getOption("reproducible.drv", RSQLite:: checkPath(CacheStorageDir(cachePath), create = TRUE) if (useDBI()) { if (is.null(conn)) { - conn <- dbConnectAll(drv, cachePath = cachePath) - on.exit(dbDisconnect(conn)) + conn <- dbConnectAll(drv, cachePath = cachePath) + on.exit(dbDisconnect(conn)) } } dt <- .emptyCacheTable - retry(retries = 250, exponentialDecayBase = 1.01, quote( - dbWriteTable(conn, CacheDBTableName(cachePath, drv), dt, overwrite = TRUE, - field.types = c(cacheId = "text", tagKey = "text", - tagValue = "text", createdDate = "text"))) - ) + # Some tough to find cases where stalls on dbWriteTable -- this *may* prevent some + a <- retry(retries = 250, exponentialDecayBase = 1.01, + quote(dbListTables(conn))) + + if (isTRUE(!CacheDBTableName(cachePath, drv) %in% a)) + #retry(retries = 5, exponentialDecayBase = 1.5, quote( + try(dbWriteTable(conn, CacheDBTableName(cachePath, drv), dt, overwrite = FALSE, + field.types = c(cacheId = "text", tagKey = "text", + tagValue = "text", createdDate = "text")), silent = TRUE) + #) + } #' @rdname cacheTools diff --git a/R/cache.R b/R/cache.R index 18536809b..adbda0384 100644 --- a/R/cache.R +++ b/R/cache.R @@ -558,7 +558,8 @@ setMethod( dbTabName = dbTabNam, outputHash = outputHash, .con = conn) - res <- retry(quote(dbSendQuery(conn, qry))) + res <- retry(retries = 15, exponentialDecayBase = 1.01, + quote(dbSendQuery(conn, qry))) isInRepo <- setDT(dbFetch(res)) dbClearResult(res) } else { diff --git a/tests/testthat/test-cluster.R b/tests/testthat/test-cluster.R index 97e24554e..e627b21b7 100644 --- a/tests/testthat/test-cluster.R +++ b/tests/testthat/test-cluster.R @@ -28,6 +28,7 @@ test_that("test parallel collisions", { if (interactive()) { of <- tmpfile[3] cl <- makeCluster(N, outfile = of) + print(paste("log file is", of)) } else { cl <- makeCluster(N) } @@ -40,6 +41,9 @@ test_that("test parallel collisions", { # }) numToRun <- 40 skip_on_os("mac") + # THere is a creating Cache at the same time problem -- haven't resolved + # Just make cache first and it seems fine + Cache(rnorm, 1, cacheRepo = tmpdir) a <- try(clusterMap(cl = cl, fun, seq(numToRun), cacheRepo = tmpdir, .scheduling = "dynamic"), silent = FALSE) expect_false(is(a, "try-error"))