From 618d780721377dae31f736dd699cfa142a0d6925 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 14 Jun 2024 16:15:59 +0100 Subject: [PATCH 1/8] Report abs path where necessary in init --- DESCRIPTION | 2 +- R/root.R | 10 +++++++--- drivers/windows/DESCRIPTION | 2 +- 3 files changed, 9 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 596df618..9481b277 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: hipercow Title: High Performance Computing -Version: 1.0.24 +Version: 1.0.25 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Wes", "Hinsley", role = "aut"), diff --git a/R/root.R b/R/root.R index bc85b5da..ac3e38bf 100644 --- a/R/root.R +++ b/R/root.R @@ -24,15 +24,19 @@ ##' path <- withr::local_tempfile() ##' hipercow_init(path) hipercow_init <- function(root = ".", driver = NULL, ...) { + desc_root <- sprintf("'%s' %s", root, + if (getwd() != root) sprintf("(%s)", getwd()) else "") + dest <- file.path(root, "hipercow") if (fs::dir_exists(dest)) { - cli::cli_alert_info("hipercow already initialised at '{root}'") + cli::cli_alert_info("hipercow already initialised at {desc_root}") } else if (fs::file_exists(dest)) { cli::cli_abort( - "Unexpected file 'hipercow' (rather than directory) found at '{root}'") + "Unexpected file 'hipercow' (rather than directory) found at {desc_root}") } else { fs::dir_create(dest) - cli::cli_alert_success("Initialised hipercow at '{root}'") + + cli::cli_alert_success("Initialised hipercow at {desc_root}") } root <- hipercow_root(root) if (is.null(driver)) { diff --git a/drivers/windows/DESCRIPTION b/drivers/windows/DESCRIPTION index ff414789..52e2dfe8 100644 --- a/drivers/windows/DESCRIPTION +++ b/drivers/windows/DESCRIPTION @@ -1,6 +1,6 @@ Package: hipercow.windows Title: DIDE HPC Support for Windows -Version: 1.0.24 +Version: 1.0.25 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Wes", "Hinsley", role = "aut"), From 97d119a78c2d87dbf168a1d32483f81908c66e42 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 14 Jun 2024 16:17:31 +0100 Subject: [PATCH 2/8] Cleanup --- R/root.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/root.R b/R/root.R index ac3e38bf..3f514a25 100644 --- a/R/root.R +++ b/R/root.R @@ -26,7 +26,6 @@ hipercow_init <- function(root = ".", driver = NULL, ...) { desc_root <- sprintf("'%s' %s", root, if (getwd() != root) sprintf("(%s)", getwd()) else "") - dest <- file.path(root, "hipercow") if (fs::dir_exists(dest)) { cli::cli_alert_info("hipercow already initialised at {desc_root}") @@ -35,7 +34,6 @@ hipercow_init <- function(root = ".", driver = NULL, ...) { "Unexpected file 'hipercow' (rather than directory) found at {desc_root}") } else { fs::dir_create(dest) - cli::cli_alert_success("Initialised hipercow at {desc_root}") } root <- hipercow_root(root) From 5c128d1505a51a914aa23dd696b430f603869ed9 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 14 Jun 2024 16:18:20 +0100 Subject: [PATCH 3/8] Even better --- R/root.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/root.R b/R/root.R index 3f514a25..b6a9862d 100644 --- a/R/root.R +++ b/R/root.R @@ -24,8 +24,8 @@ ##' path <- withr::local_tempfile() ##' hipercow_init(path) hipercow_init <- function(root = ".", driver = NULL, ...) { - desc_root <- sprintf("'%s' %s", root, - if (getwd() != root) sprintf("(%s)", getwd()) else "") + desc_root <- sprintf("'%s'%s", root, + if (getwd() != root) sprintf(" (%s)", getwd()) else "") dest <- file.path(root, "hipercow") if (fs::dir_exists(dest)) { cli::cli_alert_info("hipercow already initialised at {desc_root}") From e0c87b9adf8393a6bfafc001929cb9f7536f4105 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 14 Jun 2024 17:03:57 +0100 Subject: [PATCH 4/8] Use fs::path_abs and test --- R/root.R | 5 ++++- tests/testthat/test-root.R | 22 ++++++++++++++++++++++ 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/R/root.R b/R/root.R index b6a9862d..1a4ebf6a 100644 --- a/R/root.R +++ b/R/root.R @@ -24,8 +24,11 @@ ##' path <- withr::local_tempfile() ##' hipercow_init(path) hipercow_init <- function(root = ".", driver = NULL, ...) { + abs_path <- fs::path_abs(root) + not_same_path <- !((abs_path == root) || + (gsub("/", "\\\\", abs_path) == root)) desc_root <- sprintf("'%s'%s", root, - if (getwd() != root) sprintf(" (%s)", getwd()) else "") + if (not_same_path) sprintf(" (%s)", abs_path) else "") dest <- file.path(root, "hipercow") if (fs::dir_exists(dest)) { cli::cli_alert_info("hipercow already initialised at {desc_root}") diff --git a/tests/testthat/test-root.R b/tests/testthat/test-root.R index cfc9b520..ea795c5e 100644 --- a/tests/testthat/test-root.R +++ b/tests/testthat/test-root.R @@ -120,3 +120,25 @@ test_that("Prevent loading old root", { expect_true(task_eval(b$ids[[13]], root = path_old)) expect_equal(task_result(b$ids[[13]], root = path_old), sqrt(13)) }) + + +test_that("Report working directory if helpful", { + path <- withr::local_tempdir() + withr::with_dir(path, + res <- testthat::evaluate_promise(hipercow_init(".")) + ) + msg <- substring(res$messages[[1]], 3) + + expect_equal(msg, + sprintf("Initialised hipercow at '.' (%s)\n", + fs::path_abs(path))) + + path <- withr::local_tempdir() + withr::with_dir(path, + res <- testthat::evaluate_promise(hipercow_init(path)) + ) + msg <- substring(res$messages[[1]], 3) + expect_equal(msg, + sprintf("Initialised hipercow at '%s'\n", path)) + +}) From 98f002194f2ad536f939d9177c1787287741b3f4 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 14 Jun 2024 17:06:01 +0100 Subject: [PATCH 5/8] Appease codefactor --- tests/testthat/test-root.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-root.R b/tests/testthat/test-root.R index ea795c5e..81471f10 100644 --- a/tests/testthat/test-root.R +++ b/tests/testthat/test-root.R @@ -128,7 +128,6 @@ test_that("Report working directory if helpful", { res <- testthat::evaluate_promise(hipercow_init(".")) ) msg <- substring(res$messages[[1]], 3) - expect_equal(msg, sprintf("Initialised hipercow at '.' (%s)\n", fs::path_abs(path))) From 065f4f1777b301633fec6f44d32d8e29a1c1090e Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 14 Jun 2024 17:15:21 +0100 Subject: [PATCH 6/8] Relax test for MacOS --- tests/testthat/test-root.R | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-root.R b/tests/testthat/test-root.R index 81471f10..ffa9be04 100644 --- a/tests/testthat/test-root.R +++ b/tests/testthat/test-root.R @@ -128,16 +128,13 @@ test_that("Report working directory if helpful", { res <- testthat::evaluate_promise(hipercow_init(".")) ) msg <- substring(res$messages[[1]], 3) - expect_equal(msg, - sprintf("Initialised hipercow at '.' (%s)\n", - fs::path_abs(path))) + expect_match(msg, "Initialised hipercow at '.' (.+)\n") path <- withr::local_tempdir() withr::with_dir(path, res <- testthat::evaluate_promise(hipercow_init(path)) ) msg <- substring(res$messages[[1]], 3) - expect_equal(msg, - sprintf("Initialised hipercow at '%s'\n", path)) + expect_match(msg, "Initialised hipercow at '.+'\n") }) From 8dbbb3485e51576770902986dfa6d13ea4fbabf7 Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 14 Jun 2024 17:18:36 +0100 Subject: [PATCH 7/8] Catch // in Mac OS path --- R/root.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/root.R b/R/root.R index 1a4ebf6a..5c5f997b 100644 --- a/R/root.R +++ b/R/root.R @@ -26,7 +26,8 @@ hipercow_init <- function(root = ".", driver = NULL, ...) { abs_path <- fs::path_abs(root) not_same_path <- !((abs_path == root) || - (gsub("/", "\\\\", abs_path) == root)) + (gsub("/", "\\\\", abs_path) == root) || + (gsub("//", "/", root) == abs_path)) desc_root <- sprintf("'%s'%s", root, if (not_same_path) sprintf(" (%s)", abs_path) else "") dest <- file.path(root, "hipercow") From d1eb0ab15e325b5180ed471293622cec11fbbada Mon Sep 17 00:00:00 2001 From: Wes Hinsley Date: Fri, 14 Jun 2024 17:39:08 +0100 Subject: [PATCH 8/8] Try fs::pat_norm --- R/root.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/root.R b/R/root.R index 5c5f997b..f5d499e7 100644 --- a/R/root.R +++ b/R/root.R @@ -25,9 +25,8 @@ ##' hipercow_init(path) hipercow_init <- function(root = ".", driver = NULL, ...) { abs_path <- fs::path_abs(root) - not_same_path <- !((abs_path == root) || - (gsub("/", "\\\\", abs_path) == root) || - (gsub("//", "/", root) == abs_path)) + norm_path <- fs::path_norm(root) + not_same_path <- (abs_path != norm_path) desc_root <- sprintf("'%s'%s", root, if (not_same_path) sprintf(" (%s)", abs_path) else "") dest <- file.path(root, "hipercow")