Merge pull request #10 from edwardlavender/dev

Fix windows issues

R/julia-helpers.R

@@ -59,10 +59,17 @@ julia_proj_path <- function(JULIA_PROJ) {
     }
     # If still missing, use `NULL` with a warning
     if (missing(JULIA_PROJ)) {
-      warn("`JULIA_PROJ` not found in global options or environmental variables: using `JULIA_PROJ = NULL`.")
+      msg("`JULIA_PROJ` not found in global options or environmental variables: using `JULIA_PROJ = NULL`.")
       JULIA_PROJ <- NULL
     }
   }
+  # Normalise path
+  # * This is required for correct parsing on windows in downstream functions:
+  # * julia_proj_generate()
+  # * julia_proj_activate()
+  if (!is.null(JULIA_PROJ)) {
+    JULIA_PROJ <- normalizePath(JULIA_PROJ, winslash = "/", mustWork = FALSE)
+  }
   JULIA_PROJ
 }
 
@@ -104,6 +111,7 @@ julia_packages_dev_Patter.jl <- function() {
   Patter.jl_path <- Sys.getenv("PATTER.JL_DEV")
   if (Patter.jl_path != "") {
     check_dir_exists(Patter.jl_path)
+    Patter.jl_path <- normalizePath(Patter.jl_path, winslash = "/", mustWork = TRUE)
     julia_command(glue('Pkg.develop(path = "{Patter.jl_path}")'))
     return(TRUE)
   }
@@ -204,6 +212,7 @@ julia_summary <- function(.x) {
 
 # Save an object from Julia
 julia_save <- function(.x, .file = .x) {
+  .file <- normalizePath(.file, winslash = "/", mustWork = FALSE)
   .file <- glue("{tools::file_path_sans_ext(.file)}.jld2")
   julia_command(glue('@save "{.file}" {.x};'))
   tools::file_path_as_absolute(.file)
@@ -214,6 +223,7 @@ julia_save <- function(.x, .file = .x) {
 
 # Load an object into Julia
 julia_load <- function(.file, .x = basename(tools::file_path_sans_ext(.file))) {
+  .file <- normalizePath(.file, winslash = "/", mustWork = TRUE)
   julia_command(glue('@load "{.file}" {.x};'))
   nothing()
 }

tests/testthat/test-assemble-data.R

@@ -2,24 +2,28 @@ test_that("assemble_timeline() works", {
 
   # Define data.tables
   dt1 <- data.table(timestamp = as.POSIXct(c("2016-01-01",
-                                             "2016-02-01")))
+                                             "2016-02-01"), tz = "UTC"))
   dt2 <- data.table(timestamp = as.POSIXct(c("2016-01-01 00:02:00",
                                              "2016-02-01 00:00:00",
-                                             "2016-04-01 00:00:00")))
+                                             "2016-04-01 00:00:00"), tz = "UTC"))
 
   # Test with 2 minutes
   output   <- assemble_timeline(list(dt1, dt2), .step = "2 mins")
-  expected <- seq(as.POSIXct("2016-01-01"), as.POSIXct("2016-04-01 00:00:00"), "2 mins")
+  expected <- seq(as.POSIXct("2016-01-01", tz = "UTC"),
+                  as.POSIXct("2016-04-01 00:00:00", tz = "UTC"),
+                  "2 mins")
   expect_equal(output, expected)
 
   # Test with 1 hour
   output   <- assemble_timeline(list(dt1, dt2), .step = "1 hour")
-  expected <- seq(as.POSIXct("2016-01-01"), as.POSIXct("2016-04-01 00:00:00"), "1 hour")
+  expected <- seq(as.POSIXct("2016-01-01", tz = "UTC"),
+                  as.POSIXct("2016-04-01 00:00:00", tz = "UTC"), "1 hour")
   expect_equal(output, expected)
 
   # Test with 1 hour and .trim = TRUE
   output <- assemble_timeline(list(dt1, dt2), .step = "1 hour", .trim = TRUE)
-  expected <- seq(as.POSIXct("2016-01-01 00:00:00"), as.POSIXct("2016-02-01 00:00:00"), "1 hour")
+  expected <- seq(as.POSIXct("2016-01-01 00:00:00", tz = "UTC"),
+                  as.POSIXct("2016-02-01 00:00:00", tz = "UTC"), "1 hour")
   expect_equal(output, expected)
 
   # Test check on NAs
@@ -31,9 +35,9 @@ test_that("assemble_timeline() works", {
 
   # Test check on time overlap with .trim = TRUE
   dt1 <- data.table(timestamp = as.POSIXct(c("2016-01-01",
-                                             "2016-02-01")))
+                                             "2016-02-01"), tz = "UTC"))
   dt2 <- data.table(timestamp = as.POSIXct(c("2016-04-01",
-                                             "2016-05-01")))
+                                             "2016-05-01"), tz = "UTC"))
   assemble_timeline(list(dt1, dt2), .step = "1 hour", .trim = TRUE) |>
     expect_error("Dataset timelines do not overlap.")
 
@@ -195,8 +199,3 @@ test_that("assemble_archival() works", {
   expect_equal(output, expected)
 
 })
-
-
-
-
-

tests/testthat/test-cl_lapply-internal.R

@@ -1,50 +1,62 @@
 test_that("cl_*() helpers work", {
 
+  is_unix <- .Platform$OS.type == "unix"
+  is_win  <- .Platform$OS.type == "windows"
+
   # Check cl_check()
   cl_check(.cl = NULL, .varlist = "blah") |>
     expect_warning("`.cl` is NULL: input to `.varlist` ignored.",
                    fixed = TRUE)
-  cl_check(.cl = 2L, .varlist = "blah") |>
-    expect_warning("`.cl` is an integer: input to `.varlist` ignored.",
-                   fixed = TRUE)
-  if (.Platform$OS.type == "windows") {
+  if (is_unix) {
+    cl_check(.cl = 2L, .varlist = "blah") |>
+      expect_warning("`.cl` is an integer: input to `.varlist` ignored.",
+                     fixed = TRUE)
+  }
+  if (is_win) {
     cl_check(.cl = 2L) |>
       expect_warning("Integer specifications for `.cl` (i.e., forking) on Windows are not supported.",
                      fixed = TRUE)
   }
 
   # Check cl_check_chunk()
-  cl_check_chunk(function() 1,
-                 .cl = 1L,
-                 .chunk = TRUE,
-                 .chunk_fun = function() 1) |>
-    expect_warning("cores = 1L: `.chunk = TRUE` is inefficient on one core.",
-                   fixed = TRUE) |>
-    expect_error("`.fun` should include a `.chunkargs` argument when `.chunk = TRUE` and `.chunk_fun` is supplied.",
-                 fixed = TRUE)
-  cl_check_chunk(function(.chunkargs) 1,
-                 .cl = 1L,
-                 .chunk = FALSE,
-                 .chunk_fun = function() 1) |>
-    expect_warning(".chunk = FALSE`: `.chunk_fun` ignored.",
+  if (is_unix) {
+    cl_check_chunk(function() 1,
+                   .cl = 1L,
+                   .chunk = TRUE,
+                   .chunk_fun = function() 1) |>
+      expect_warning("cores = 1L: `.chunk = TRUE` is inefficient on one core.",
+                     fixed = TRUE) |>
+      expect_error("`.fun` should include a `.chunkargs` argument when `.chunk = TRUE` and `.chunk_fun` is supplied.",
                    fixed = TRUE)
+    cl_check_chunk(function(.chunkargs) 1,
+                   .cl = 1L,
+                   .chunk = FALSE,
+                   .chunk_fun = function() 1) |>
+      expect_warning(".chunk = FALSE`: `.chunk_fun` ignored.",
+                     fixed = TRUE)
+  }
+
 
   # Check cl_cores()
-  cl_cores(NULL) |> expect_equal(1L)
-  cl_cores(1L) |> expect_equal(1L)
-  cl_cores(2L) |> expect_equal(2L)
-  cl_cores(Inf) |>
-    expect_warning("The number of CPU cores exceeds the number of detected cores.",
-                   fixed = TRUE)
+  if (is_unix) {
+    cl_cores(NULL) |> expect_equal(1L)
+    cl_cores(1L) |> expect_equal(1L)
+    cl_cores(2L) |> expect_equal(2L)
+    cl_cores(Inf) |>
+      expect_warning("The number of CPU cores exceeds the number of detected cores.",
+                     fixed = TRUE)
+  }
   cl <- parallel::makeCluster(2L)
   cl_cores(parallel::makeCluster(2L)) |> expect_equal(2L)
   cl_stop(cl)
   cl <- parallel::makePSOCKcluster(2L)
   cl_cores(cl) |> expect_equal(2L)
   cl_stop(cl)
-  cl <- parallel::makeForkCluster(2L)
-  cl_cores(cl) |> expect_equal(2L)
-  cl_stop(cl)
+  if (is_unix) {
+    cl <- parallel::makeForkCluster(2L)
+    cl_cores(cl) |> expect_equal(2L)
+    cl_stop(cl)
+  }
 
   # Check cl_chunks()
   # * .nout is essentially the number of chunks on each core

tests/testthat/test-cl_lapply.R

@@ -1,5 +1,8 @@
 test_that("cl_lapply() works", {
 
+  is_unix <- .Platform$OS.type == "unix"
+  is_win  <- .Platform$OS.type == "windows"
+
   # cl_chunk()
   expect_false(cl_chunk(1))
   expect_true(cl_chunk(2))
@@ -18,7 +21,7 @@ test_that("cl_lapply() works", {
   # cl_lapply() basic parallel implementation
   cl_lapply(1:10, \(x) x + 0, .cl = 2L) |>
     expect_equal(as.list(1:10L))
-  if (.Platform$OS.type == "unix") {
+  if (is_unix) {
     cl_lapply(1:10, \(x) x + 0, .cl = 2L, .chunk = TRUE, .combine = unlist) |>
       expect_equal(c(1:10L))
   }
@@ -48,17 +51,19 @@ test_that("cl_lapply() works", {
   expect_equal(unname(unlist(output)), 1:10)
 
   # As above (parallel)
-  output <- cl_lapply(1:10,
-                      .fun = function(.i, .chunkargs) {
-                        out <- .chunkargs$map + .i
-                        out[1]
-                      },
-                      .chunk_fun = function(.chunkargs) {
-                        list(map = terra::unwrap(mapw))
-                      },
-                      .chunk = TRUE,
-                      .cl = 2L)
-  expect_equal(unname(unlist(output)), 1:10)
+  if (is_unix) {
+    output <- cl_lapply(1:10,
+                        .fun = function(.i, .chunkargs) {
+                          out <- .chunkargs$map + .i
+                          out[1]
+                        },
+                        .chunk_fun = function(.chunkargs) {
+                          list(map = terra::unwrap(mapw))
+                        },
+                        .chunk = TRUE,
+                        .cl = 2L)
+    expect_equal(unname(unlist(output)), 1:10)
+  }
 
 })
 

tests/testthat/test-julia-helpers.R

@@ -23,7 +23,7 @@ test_that("Julia helpers work", {
   expect_equal(julia_proj_path(JULIA_PROJ = jproj), jproj)
   Sys.unsetenv("JULIA_PROJ")
   julia_proj_path() |>
-    expect_warning("`JULIA_PROJ` not found in global options or environmental variables: using `JULIA_PROJ = NULL`.", fixed = TRUE)
+    expect_message("`JULIA_PROJ` not found in global options or environmental variables: using `JULIA_PROJ = NULL`.", fixed = TRUE)
   Sys.setenv("JULIA_PROJ" = JULIA_PROJ)
 
   # julia_proj_generate()