Merge pull request #704 from DyfanJones/main

Fix cran issue

paws.common/R/cache.R

@@ -3,10 +3,12 @@ ini_cache <- new.env(parent = emptyenv())
 os_env_cache <- new.env(parent = emptyenv())
 
 set_os_env_cache <- function() {
-  env <- system("printenv", intern = T)
+  env <- system("printenv", intern = TRUE)
   # exit if no environment variables can be found
-  if (length(env) == 0) return()
-  env <- strsplit(env, "=", fixed = T)
+  if (length(env) == 0) {
+    return()
+  }
+  env <- strsplit(sub("=", "U+003D", env, fixed = TRUE), "U+003D", fixed = TRUE)
   found <- lengths(env) == 1
   env <- trimws(do.call(rbind, env))
   env[found, 2] <- ""

paws.common/R/iniutil.R

@@ -19,7 +19,7 @@ read_ini <- function(file_name) {
 
   content <- sub(
     "[ \t\r\n]+$", "",
-    scan(file_name, what = "", sep = "\n", quiet = T),
+    scan(file_name, what = "", sep = "\n", quiet = TRUE),
     perl = TRUE
   )
   # Return empty list for empty files
@@ -46,9 +46,9 @@ read_ini <- function(file_name) {
   split_content <- strsplit(sub("=", "\n", content, fixed = T), "\n", fixed = T)
   nested_contents <- lengths(split_content) == 1
 
-  split_content <- sub("[ \t\r\n]+$", "", do.call(rbind, split_content), perl = T)
+  split_content <- sub("[ \t\r\n]+$", "", do.call(rbind, split_content), perl = TRUE)
   sub_grps <- !grepl("^[ ]+", split_content[, 1])
-  split_content <- sub("^[ \t\r]+", "", split_content, perl = T)
+  split_content <- sub("^[ \t\r]+", "", split_content, perl = TRUE)
   for (i in which(start <= end)) {
     items <- seq.int(start[i], end[i])
     found_nested_content <- nested_contents[items]

paws.common/R/retry.R

@@ -48,27 +48,30 @@ standard_retry_handler <- function(request) {
 
   # retry api call
   for (i in seq.int(2, exit_retries)) {
-    tryCatch({
-      request <- sign(request)
-      if (!is.null(request[["error"]])) {
-        stop(aws_error(request[["error"]]))
-      }
-      request <- send(request)
-      request <- unmarshal_meta(request)
-      request <- validate_response(request)
+    tryCatch(
+      {
+        request <- sign(request)
+        if (!is.null(request[["error"]])) {
+          stop(aws_error(request[["error"]]))
+        }
+        request <- send(request)
+        request <- unmarshal_meta(request)
+        request <- validate_response(request)
 
-      if (!is.null(request[["error"]])) {
-        request <- unmarshal_error(request)
-        stop(aws_error(request[["error"]]))
-      }
-      return(request)
-    }, paws_error = function(error) {
-      if (check_if_retryable(error)) {
-        exp_back_off(error, i, exit_retries)
-      } else {
-        stop(error)
+        if (!is.null(request[["error"]])) {
+          request <- unmarshal_error(request)
+          stop(aws_error(request[["error"]]))
+        }
+        return(request)
+      },
+      paws_error = function(error) {
+        if (check_if_retryable(error)) {
+          exp_back_off(error, i, exit_retries)
+        } else {
+          stop(error)
+        }
       }
-    })
+    )
   }
 }
 
@@ -79,7 +82,7 @@ check_if_retryable <- function(error) {
 
   if (!is_empty(error_code) && error_code %in% retryable_codes) {
     retryable <- TRUE
-  # Retry attempts on nondescriptive, transient error codes. Specifically, these HTTP status codes: 500, 502, 503, 504.
+    # Retry attempts on nondescriptive, transient error codes. Specifically, these HTTP status codes: 500, 502, 503, 504.
   } else if (!is_empty(status_code) && status_code %in% c(500, 502, 503, 504)) {
     retryable <- TRUE
   }

paws.common/R/xmlutil.R

@@ -260,8 +260,7 @@ xml_parse <- function(data, interface, data_nms, flattened = NULL) {
         parse_xml_elt(xml_elts, interface_i, tags_i, flattened)
       } else {
         default_parse_xml(interface_i, tags_i)
-      }
-    )
+      })
   }
   names(result) <- nms
   return(result)
@@ -487,8 +486,7 @@ transpose <- function(x) {
           list(rep_len(x[[col]], n_row)[[row]])
         } else {
           list(x[[col]][[row]])
-        }
-      )
+        })
     }
     out[[row]] <- vals
   }

paws.common/tests/testthat/test_cache.R

@@ -20,3 +20,27 @@ test_that("reset os env cache", {
 
   expect_null(os_env_cache[["RANDOM"]])
 })
+
+# skip test if not on unix OS
+test_that("check if environmental variables are parsed correctly", {
+  skip_if(.Platform$OS.type != "unix")
+  expect <- sprintf(
+    "var1=%s var2=%s var2=%s",
+    paste(sample(letters, 10), collapse = ""),
+    paste(sample(letters, 10), collapse = ""),
+    paste(sample(letters, 10), collapse = "")
+  )
+  fake_env <- c(
+    "ENV_VAR1=foo",
+    sprintf("ENV_VAR2=%s",expect),
+    "ENV_VAR3=bar"
+  )
+
+  mock_system <- mock2(fake_env)
+  mockery::stub(set_os_env_cache, "system", mock_system)
+
+  set_os_env_cache()
+  expect_equal(os_env_cache[["ENV_VAR1"]], "foo")
+  expect_equal(os_env_cache[["ENV_VAR2"]], expect)
+  expect_equal(os_env_cache[["ENV_VAR3"]], "bar")
+})

paws.common/tests/testthat/test_config.R

@@ -67,7 +67,7 @@ test_that("set_config", {
 })
 
 test_that("get_profile_name", {
-  withr::with_envvar(list(AWS_PROFILE="bar"), {
+  withr::with_envvar(list(AWS_PROFILE = "bar"), {
     expect_equal(get_profile_name(), "bar")
     expect_equal(get_profile_name(NULL), "bar")
     expect_equal(get_profile_name("foo"), "foo")

paws.common/tests/testthat/test_credential_providers.R

@@ -88,10 +88,14 @@ test_that("config_file_provider", {
     expect_equal(mock_arg(mock_get_assumed_role_creds)[1:3], list(
       "arn:aws:iam::p1_role", "p1_role_session", NULL
     ))
-    expect_equal(mock_arg(mock_get_assumed_role_creds)[[4]]$access_key_id,
-                 creds$env$access_key_id)
-    expect_equal(mock_arg(mock_get_assumed_role_creds)[[4]]$secret_access_key,
-                 creds$env$secret_access_key)
+    expect_equal(
+      mock_arg(mock_get_assumed_role_creds)[[4]]$access_key_id,
+      creds$env$access_key_id
+    )
+    expect_equal(
+      mock_arg(mock_get_assumed_role_creds)[[4]]$secret_access_key,
+      creds$env$secret_access_key
+    )
 
     # Test profile using web_identity_token
     mock_web_identity_creds <- mock2(creds$p2)

paws.common/tests/testthat/test_retry.R

@@ -83,7 +83,7 @@ dummy_req_error <- function(req, code, msg, status) {
 op <- Operation(name = "OperationName")
 svc1 <- Client(config = Config())
 
-op_output <-Structure(
+op_output <- Structure(
   Timestamp = Scalar(type = "timestamp")
 )
 
@@ -287,4 +287,3 @@ test_that("1 retries", {
   expect_equal(mock_call_no(mock_exp_back_off), 2)
   expect_equal(last_args[[2]], last_args[[3]])
 })
-