Nothing
# Test olink_class S3 class --------------------------------------------------
# Test data ----
npx_data1_check_log <- check_npx(df = npx_data1) |>
suppressWarnings() |>
suppressMessages()
# Test new_olink_class ----
test_that(
"new_olink_class - works - creates an olink_class from tibble and check_log",
{
result <- new_olink_class(
df = npx_data1,
check_log = npx_data1_check_log
)
expect_s3_class(object = result, class = "olink_class")
expect_s3_class(object = result, class = "tbl_df")
expect_identical(object = dim(result), expected = dim(npx_data1))
expect_identical(
object = attr(x = result, which = "check_log", exact = TRUE),
expected = npx_data1_check_log
)
}
)
test_that(
"new_olink_class - warning - df is already an olink_class",
{
result <- new_olink_class(
df = npx_data1,
check_log = npx_data1_check_log
)
expect_s3_class(object = result, class = "olink_class")
expect_warning(
object = result_new <- new_olink_class(
df = result,
check_log = npx_data1_check_log
),
regexp = "`df` is already an <olink_class> object!"
)
expect_s3_class(object = result_new, class = "olink_class")
expect_s3_class(object = result_new, class = "tbl_df")
expect_identical(object = dim(result_new), expected = dim(npx_data1))
expect_identical(
object = attr(x = result_new, which = "check_log", exact = TRUE),
expected = npx_data1_check_log
)
}
)
test_that(
"new_olink_class - error - non-tibble input",
{
expect_error(
object = new_olink_class(
df = as.data.frame(npx_data1),
check_log = npx_data1_check_log
),
regexp = "`df` is not a tibble dataset!"
)
}
)
test_that(
"new_olink_class - error - invalid check_log",
{
expect_error(
object = new_olink_class(
df = npx_data1,
check_log = list(a = 1L)
),
regexp = paste("Elements \"col_names\", \"oid_invalid\", \"assay_na\",",
"\"sample_id_dups\", \"sample_id_na\", \"col_class\",",
"\"assay_qc\", \"non_unique_uniprot\", and",
"\"darid_invalid\" are missing from `check_log`!")
)
expect_error(
object = new_olink_class(
df = npx_data1,
check_log = list("col_names" = 1L)
),
regexp = paste("Elements \"oid_invalid\", \"assay_na\",",
"\"sample_id_dups\", \"sample_id_na\", \"col_class\",",
"\"assay_qc\", \"non_unique_uniprot\", and",
"\"darid_invalid\" are missing from `check_log`!")
)
expect_error(
object = new_olink_class(
df = npx_data1,
check_log = "not_a_list"
),
regexp = "`check_log` is not a list!"
)
}
)
# Test extract_check_log ----
test_that(
"extract_check_log - works - extracts check_log from olink_class",
{
obj <- new_olink_class(
df = npx_data1,
check_log = npx_data1_check_log
)
result <- extract_check_log(df = obj)
expect_identical(object = result, expected = npx_data1_check_log)
}
)
test_that(
"extract_check_log - works - returns NULL for plain tibble",
{
result <- extract_check_log(df = npx_data1)
expect_null(object = result)
}
)
test_that(
"extract_check_log - works - returns NULL for non-data objects",
{
expect_null(object = extract_check_log(df = "string"))
expect_null(object = extract_check_log(df = 42L))
expect_null(object = extract_check_log(df = list(a = 1L)))
}
)
# Test Arrow metadata round-trip ----
test_that(
"attach_check_log_arrow / olink_check_log - round-trip",
{
arrow_tbl <- arrow::as_arrow_table(
x = npx_data1
)
result <- attach_check_log_arrow(
df = arrow_tbl,
check_log = npx_data1_check_log
)
# metadata should be set
expect_true(object = "olink_check_log" %in% names(result$metadata))
# round-trip extraction
extracted <- extract_check_log(df = result)
expect_identical(object = extracted, expected = npx_data1_check_log)
}
)
test_that(
"extract_check_log - works - returns NULL for ArrowObject w/o metadata",
{
arrow_tbl <- arrow::as_arrow_table(x = npx_data1)
expect_warning(
object = result <- extract_check_log(df = arrow_tbl),
regexp = "No `olink_check_log` metadata found in the ArrowObject"
)
expect_null(object = result)
}
)
# Test attach_check_log ----
test_that(
"attach_check_log - works - tibble path returns olink_class with check_log",
{
expect_no_error(
object = expect_no_message(
object = expect_warning(
object = result <- attach_check_log(
df = npx_data1,
out_df = "tibble"
),
regexp = paste("Duplicate SampleIDs detected:",
"\"CONTROL_SAMPLE_AS 1\" and \"CONTROL_SAMPLE_AS 2\"")
)
)
)
expect_s3_class(object = result, class = "olink_class")
expect_false(object = is.null(extract_check_log(df = result)))
}
)
test_that(
"attach_check_log - works - arrow path returns ArrowObject with check_log",
{
expect_no_error(
object = expect_no_message(
object = expect_warning(
object = result <- attach_check_log(
df = npx_data1,
out_df = "arrow"
),
regexp = paste("Duplicate SampleIDs detected:",
"\"CONTROL_SAMPLE_AS 1\" and \"CONTROL_SAMPLE_AS 2\"")
)
)
)
expect_true(object = inherits(x = result, what = "ArrowObject"))
expect_false(object = is.null(extract_check_log(df = result)))
}
)
test_that(
"attach_check_log - works - forwards preferred_names to check_npx",
{
# preferred_names allows renaming columns; passing a valid mapping should
# not cause an error and the result should still carry a check_log
expect_no_error(
object = expect_no_message(
object = expect_warning(
object = result <- attach_check_log(
df = npx_data1,
out_df = "tibble",
preferred_names = NULL
),
regexp = paste("Duplicate SampleIDs detected:",
"\"CONTROL_SAMPLE_AS 1\" and \"CONTROL_SAMPLE_AS 2\"")
)
)
)
expect_s3_class(object = result, class = "olink_class")
expect_false(object = is.null(extract_check_log(df = result)))
}
)
# Test validate_check_log ----
test_that(
"validate_check_log - works - valid check_log",
{
expect_no_error(
object = expect_no_warning(
object = expect_no_message(
object = expect_true(
object = validate_check_log(
df = npx_data1,
check_log = npx_data1_check_log
)
)
)
)
)
}
)
test_that(
"validate_check_log - error - unnamed list",
{
expect_error(
object = validate_check_log(
df = npx_data1,
check_log = list(1L, 2L, 3L)
),
regexp = "`check_log` is a list with no names!"
)
}
)
test_that(
"validate_check_log - error - missing elements",
{
expect_error(
object = validate_check_log(
df = npx_data1,
check_log = list(col_names = list())
),
regexp = paste("Elements \"oid_invalid\", \"assay_na\",",
"\"sample_id_dups\", \"sample_id_na\", \"col_class\",",
"\"assay_qc\", \"non_unique_uniprot\", and",
"\"darid_invalid\" are missing from `check_log`!")
)
}
)
test_that(
"validate_check_log - error - check_log has additional unexpected names",
{
test_check_log <- append(
x = npx_data1_check_log,
values = list("i_am_a_new_element" = c(1L, 2L, 3L))
)
expect_error(
object = validate_check_log(
df = npx_data1,
check_log = test_check_log
),
regexp = paste("Additional element \"i_am_a_new_element\" detected in",
"`check_log`!")
)
}
)
test_that(
"validate_check_log - error - check_log misses required keys for col names",
{
test_check_log <- npx_data1_check_log
test_check_log$col_names <- test_check_log$col_names[utils::head(x = names(test_check_log$col_names), n = 4L)] # nolint: indentation_linter
expect_error(
object = validate_check_log(
df = npx_data1,
check_log = test_check_log
),
regexp = "There are no column names associated with the following keys:"
)
}
)
test_that(
"validate_check_log - error - check_log has additional keys for column names",
{
test_check_log <- npx_data1_check_log
test_check_log$col_names <- append(
x = test_check_log$col_names,
values = list("i_am_a_new_element" = "Site")
)
expect_error(
object = validate_check_log(
df = npx_data1,
check_log = test_check_log
),
regexp = "Unexpected key \"i_am_a_new_element\" corresponding to column"
)
}
)
test_that(
"validate_check_log - error - check_log contains column names not in df",
{
# check_log contains non-character values v1 ----
test_check_log_v1 <- npx_data1_check_log
test_check_log_v1$col_names$sample_id <- FALSE
expect_error(
object = validate_check_log(
df = npx_data1,
check_log = test_check_log_v1
),
regexp = paste("Column name \"FALSE\" from `check_log` is missing from",
"the dataset `df`!")
)
# check_log contains non-character values v2 ----
test_check_log_v2 <- npx_data1_check_log
test_check_log_v2$col_names$sample_id <- FALSE
test_check_log_v2$col_names$olink_id <- 1L
test_check_log_v2$col_names$uniprot <- 1.1
test_check_log_v2$col_names$plate_id <- TRUE
expect_error(
object = validate_check_log(
df = npx_data1,
check_log = test_check_log_v2
),
regexp = paste("Column names \"FALSE\", \"1\", \"1.1\", and \"TRUE\"",
"from `check_log` are missing from the dataset `df`!")
)
# check_log contains values not in df v1 ----
test_check_log_v3 <- npx_data1_check_log
test_check_log_v3$col_names$sample_id <- "SampleID2"
expect_error(
object = validate_check_log(
df = npx_data1,
check_log = test_check_log_v3
),
regexp = paste("Column name \"SampleID2\" from `check_log` is missing",
"from the dataset `df`!")
)
}
)
# Test dplyr_reconstruct ----
test_that(
"dplyr_reconstruct.olink_class - works - preserves class through filter",
{
obj <- new_olink_class(
df = npx_data1,
check_log = npx_data1_check_log
)
# dplyr::filter
result <- dplyr::filter(obj, .data[["SampleID"]] == "A1")
expect_s3_class(object = result, class = "olink_class")
expect_identical(
object = extract_check_log(df = result),
expected = npx_data1_check_log
)
expect_equal(object = nrow(result), expected = 184L)
}
)
test_that(
"dplyr_reconstruct.olink_class - works - preserves class through mutate",
{
obj <- new_olink_class(
df = npx_data1,
check_log = npx_data1_check_log
)
result <- dplyr::mutate(obj, new_col = 1L)
expect_s3_class(object = result, class = "olink_class")
expect_identical(
object = extract_check_log(df = result),
expected = npx_data1_check_log
)
expect_true(object = "new_col" %in% names(result))
expect_equal(
object = dim(result),
expected = c(nrow(obj), ncol(obj) + 1L)
)
}
)
test_that(
"dplyr_reconstruct.olink_class - works - preserves class through select",
{
obj <- new_olink_class(
df = npx_data1,
check_log = npx_data1_check_log
)
result <- dplyr::select(obj, dplyr::all_of(c("SampleID", "OlinkID")))
expect_s3_class(object = result, class = "olink_class")
expect_identical(
object = extract_check_log(df = result),
expected = npx_data1_check_log
)
expect_equal(
object = names(result),
expected = c("SampleID", "OlinkID")
)
expect_equal(
object = nrow(result),
expected = nrow(npx_data1)
)
}
)
test_that(
"dplyr_reconstruct.olink_class - works - preserves class through arrange",
{
obj <- new_olink_class(
df = npx_data1,
check_log = npx_data1_check_log
)
result <- dplyr::arrange(obj, dplyr::desc(.data[["SampleID"]]))
expect_s3_class(object = result, class = "olink_class")
expect_identical(
object = extract_check_log(df = result),
expected = npx_data1_check_log
)
expect_identical(
object = unique(result$SampleID),
expected = unique(sort(x = npx_data1$SampleID, decreasing = TRUE))
)
}
)
# Test tbl_sum ----
test_that(
"tbl_sum.olink_class - works - shows check log status",
{
obj <- new_olink_class(
df = npx_data1,
check_log = npx_data1_check_log
)
header <- tbl_sum(obj)
expect_true(object = "olink_check_log" %in% names(header))
expect_equal(object = header[["olink_check_log"]],
expected = "attached")
}
)
test_that(
"tbl_sum.olink_class - works - shows 'missing' when check_log is NULL",
{
obj <- new_olink_class(
df = npx_data1,
check_log = npx_data1_check_log
)
# forcibly remove the check_log attribute to exercise the 'missing' branch
attr(obj, "check_log") <- NULL
header <- tbl_sum(obj)
expect_true(object = "olink_check_log" %in% names(header))
expect_equal(object = header[["olink_check_log"]],
expected = "missing")
}
)
# Test rm_check_log ----
test_that(
"rm_check_log - works - strips check_log from olink_class tibble",
{
obj <- new_olink_class(
df = npx_data1,
check_log = npx_data1_check_log
)
result <- rm_check_log(df = obj)
expect_false(object = inherits(x = result, what = "olink_class"))
expect_s3_class(object = result, class = "tbl_df")
expect_null(object = extract_check_log(df = result))
}
)
test_that(
"rm_check_log - works - strips check_log from ArrowObject",
{
arrow_tbl <- arrow::as_arrow_table(x = npx_data1)
arrow_with_log <- attach_check_log_arrow(
df = arrow_tbl,
check_log = npx_data1_check_log
)
result <- rm_check_log(df = arrow_with_log)
expect_true(object = inherits(x = result, what = "ArrowObject"))
expect_warning(
object = expect_null(
object = extract_check_log(df = result)
),
regexp = "No `olink_check_log` metadata found in the ArrowObject"
)
}
)
test_that(
"rm_check_log - works - returns plain tibble unchanged",
{
result <- rm_check_log(df = npx_data1)
expect_s3_class(object = result, class = "tbl_df")
expect_identical(object = result, expected = npx_data1)
expect_false(object = inherits(x = result, what = "olink_class"))
}
)
test_that(
"rm_check_log - works - returns ArrowObject without metadata unchanged",
{
arrow_tbl <- arrow::as_arrow_table(x = npx_data1)
result <- rm_check_log(df = arrow_tbl)
expect_true(object = inherits(x = result, what = "ArrowObject"))
expect_warning(
object = expect_null(
object = extract_check_log(df = result)
),
regexp = "No `olink_check_log` metadata found in the ArrowObject"
)
}
)
# Test update_check_log ----
test_that(
"update_check_log - works - refreshes olink_class check log",
{
df <- dplyr::tibble(
SampleID = LETTERS[1L:4L],
OlinkID = paste0("OID1234", seq(1L:4L)),
UniProt = LETTERS[1L:4L],
Assay = LETTERS[1L:4L],
Panel = LETTERS[1L:4L],
Panel_Lot_Nr = LETTERS[1L:4L],
NPX = rnorm(4L),
PlateID = rep("plate1", 4L),
QC_Warning = rep("Pass", 4L)
)
df_obj <- attach_check_log(df = df, out_df = "tibble")
expect_identical(
object = extract_check_log(df = df_obj)$sample_id_dups,
expected = character(0L)
)
df_obj_mod <- df_obj |>
dplyr::mutate(
SampleID = c("A", "A", "C", "D"),
OlinkID = c("OID12341", "OID12341", "OID12343", "OID12344"),
UniProt = c("A", "A", "C", "D"),
Assay = c("A", "A", "C", "D")
)
expect_warning(
object = df_obj_updated <- update_check_log(df = df_obj_mod),
regexp = "Duplicate SampleID detected: \"A\""
)
expect_s3_class(object = df_obj_updated, class = "olink_class")
expect_identical(
object = extract_check_log(df = df_obj_updated)$sample_id_dups,
expected = "A"
)
}
)
test_that(
"update_check_log - works - refreshes ArrowObject check log",
{
df <- dplyr::tibble(
SampleID = LETTERS[1L:4L],
OlinkID = paste0("OID1234", seq(1L:4L)),
UniProt = LETTERS[1L:4L],
Assay = LETTERS[1L:4L],
Panel = LETTERS[1L:4L],
Panel_Lot_Nr = LETTERS[1L:4L],
NPX = rnorm(4L),
PlateID = rep("plate1", 4L),
QC_Warning = rep("Pass", 4L)
)
df_arrow <- attach_check_log(df = df, out_df = "arrow")
expect_identical(
object = extract_check_log(df = df_arrow)$sample_id_dups,
expected = character(0L)
)
df_arrow_mod <- df_arrow |>
dplyr::collect() |>
dplyr::mutate(
SampleID = c("A", "A", "C", "D"),
OlinkID = c("OID12341", "OID12341", "OID12343", "OID12344"),
UniProt = c("A", "A", "C", "D"),
Assay = c("A", "A", "C", "D")
) |>
arrow::as_arrow_table()
df_arrow_mod <- attach_check_log_arrow(
df = df_arrow_mod,
check_log = extract_check_log(df = df_arrow)
)
expect_warning(
object = df_arrow_updated <- update_check_log(df = df_arrow_mod),
regexp = "Duplicate SampleID detected: \"A\""
)
expect_r6_class(object = df_arrow_updated, class = "ArrowObject")
expect_identical(
object = extract_check_log(df = df_arrow_updated)$sample_id_dups,
expected = "A"
)
}
)
test_that(
"update_check_log - works - preserves preferred names",
{
df <- npx_data1 |>
dplyr::mutate(
SampleID2 = .data[["SampleID"]]
)
df_obj <- attach_check_log(
df = df,
out_df = "tibble",
preferred_names = c("sample_id" = "SampleID2")
) |>
suppressWarnings() |>
suppressMessages()
expect_warning(
object = expect_no_message(
object = df_obj_updated <- update_check_log(df = df_obj)
),
regexp = paste("Duplicate SampleIDs detected: \"CONTROL_SAMPLE_AS 1\"",
"and \"CONTROL_SAMPLE_AS 2\"")
)
expect_identical(
object = extract_check_log(df = df_obj_updated)$col_names$sample_id,
expected = "SampleID2"
)
}
)
test_that(
"update_check_log - works - updates preferred names",
{
df <- npx_data1 |>
dplyr::mutate(
SampleID2 = .data[["SampleID"]],
PCNormalizedNPX = .data[["NPX"]]
)
df_obj <- attach_check_log(
df = df,
out_df = "tibble",
preferred_names = c("sample_id" = "SampleID2")
) |>
suppressWarnings() |>
suppressMessages()
expect_warning(
object = expect_no_message(
object = df_obj_updated <- update_check_log(
df = df_obj,
preferred_names = c("quant" = "PCNormalizedNPX")
)
),
regexp = paste("Duplicate SampleIDs detected: \"CONTROL_SAMPLE_AS",
"1\" and \"CONTROL_SAMPLE_AS 2\"")
)
expect_identical(
object = extract_check_log(df = df_obj_updated)$col_names$sample_id,
expected = "SampleID2"
)
expect_identical(
object = extract_check_log(df = df_obj_updated)$col_names$quant,
expected = "PCNormalizedNPX"
)
}
)
test_that(
"update_check_log - works - overwrites preferred names",
{
df <- npx_data1 |>
dplyr::mutate(
SampleID2 = .data[["SampleID"]],
SampleID3 = .data[["SampleID"]]
)
df_obj <- attach_check_log(
df = df,
out_df = "tibble",
preferred_names = c("sample_id" = "SampleID2")
) |>
suppressWarnings() |>
suppressMessages()
expect_warning(
object = expect_no_message(
object = df_obj_updated <- update_check_log(
df = df_obj,
preferred_names = c("sample_id" = "SampleID3")
)
),
regexp = paste("Duplicate SampleIDs detected: \"CONTROL_SAMPLE_AS",
"1\" and \"CONTROL_SAMPLE_AS 2\"")
)
expect_identical(
object = extract_check_log(df = df_obj)$col_names$sample_id,
expected = "SampleID2"
)
expect_identical(
object = extract_check_log(df = df_obj_updated)$col_names$sample_id,
expected = "SampleID3"
)
}
)
test_that(
"update_check_log - error - preferred names must exist",
{
df_obj <- attach_check_log(
df = npx_data1,
out_df = "tibble"
) |>
suppressWarnings() |>
suppressMessages()
expect_error(
object = update_check_log(
df = df_obj,
preferred_names = c("quant" = "NotAColumn")
),
regexp = paste("Value \"NotAColumn\" from `preferred_names`",
"corresponding to key \"quant\" is missing from the input",
"dataset `df`")
)
}
)
test_that(
"update_check_log - error - preferred name keys must be unique",
{
df <- npx_data1 |>
dplyr::mutate(
SampleID2 = .data[["SampleID"]],
SampleID3 = .data[["SampleID"]]
)
df_obj <- attach_check_log(
df = df,
out_df = "tibble",
preferred_names = c("sample_id" = "SampleID2")
) |>
suppressWarnings() |>
suppressMessages()
expect_error(
object = update_check_log(
df = df_obj,
preferred_names = c("sample_id" = "SampleID",
"sample_id" = "SampleID3")
),
regexp = "Duplicated name in"
)
}
)
test_that(
"update_check_log - works - attaches check log to plain tibble",
{
df <- dplyr::tibble(
SampleID = LETTERS[1L:4L],
OlinkID = paste0("OID1234", seq(1L:4L)),
UniProt = LETTERS[1L:4L],
Assay = LETTERS[1L:4L],
Panel = LETTERS[1L:4L],
Panel_Lot_Nr = LETTERS[1L:4L],
NPX = rnorm(4L),
PlateID = rep("plate1", 4L),
QC_Warning = rep("Pass", 4L)
)
check_log <- check_npx(df = df)
expect_no_error(
object = df_obj <- update_check_log(df = df, check_log = check_log)
)
expect_s3_class(object = df_obj, class = "olink_class")
expect_identical(
object = extract_check_log(df = df_obj),
expected = check_log
)
}
)
test_that(
"update_check_log - works - attaches check log to ArrowObject",
{
df <- dplyr::tibble(
SampleID = LETTERS[1L:4L],
OlinkID = paste0("OID1234", seq(1L:4L)),
UniProt = LETTERS[1L:4L],
Assay = LETTERS[1L:4L],
Panel = LETTERS[1L:4L],
Panel_Lot_Nr = LETTERS[1L:4L],
NPX = rnorm(4L),
PlateID = rep("plate1", 4L),
QC_Warning = rep("Pass", 4L)
)
check_log <- check_npx(df = df)
df_arrow <- arrow::as_arrow_table(df)
expect_no_error(
object = expect_no_warning(
object = expect_no_message(
object = df_arrow_obj <- update_check_log(
df = df_arrow,
check_log = check_log
)
)
)
)
expect_r6_class(object = df_arrow_obj, class = "ArrowObject")
expect_identical(
object = extract_check_log(df = df_arrow_obj),
expected = check_log
)
}
)
test_that(
"update_check_log - works - consistent results for plain tibble",
{
df <- dplyr::tibble(
SampleID = LETTERS[1L:4L],
OlinkID = paste0("OID1234", seq(1L:4L)),
UniProt = LETTERS[1L:4L],
Assay = LETTERS[1L:4L],
Panel = LETTERS[1L:4L],
Panel_Lot_Nr = LETTERS[1L:4L],
NPX = rnorm(4L),
PlateID = rep("plate1", 4L),
QC_Warning = rep("Pass", 4L)
)
check_log <- check_npx(df = df)
expect_no_error(
df_obj_attach <- attach_check_log(df = df)
)
expect_no_error(
object = df_obj_update <- update_check_log(df = df, check_log = check_log)
)
expect_s3_class(object = df_obj_attach, class = "olink_class")
expect_s3_class(object = df_obj_update, class = "olink_class")
expect_identical(
object = extract_check_log(df = df_obj_update),
expected = extract_check_log(df = df_obj_attach)
)
}
)
test_that(
"update_check_log - works - consistent results for ArrowObject",
{
df <- dplyr::tibble(
SampleID = LETTERS[1L:4L],
OlinkID = paste0("OID1234", seq(1L:4L)),
UniProt = LETTERS[1L:4L],
Assay = LETTERS[1L:4L],
Panel = LETTERS[1L:4L],
Panel_Lot_Nr = LETTERS[1L:4L],
NPX = rnorm(4L),
PlateID = rep("plate1", 4L),
QC_Warning = rep("Pass", 4L)
)
check_log <- check_npx(df = df)
df_arrow <- arrow::as_arrow_table(df)
expect_no_error(
df_arrow_obj_attach <- attach_check_log_arrow(df = df_arrow,
check_log = check_log)
)
expect_no_error(
object = df_arrow_obj_update <- update_check_log(
df = df_arrow,
check_log = check_log
)
)
expect_r6_class(object = df_arrow_obj_attach, class = "ArrowObject")
expect_r6_class(object = df_arrow_obj_update, class = "ArrowObject")
expect_identical(
object = extract_check_log(df = df_arrow_obj_update),
expected = extract_check_log(df = df_arrow_obj_attach)
)
}
)
# Test base64 round-trip ----
test_that(
"base64_encode / base64_decode - round-trip",
{
# Simple string
raw_input <- charToRaw("Hello, World!")
encoded <- base64_encode(raw_bytes = raw_input)
decoded <- base64_decode(encoded_str = encoded)
expect_identical(object = decoded, expected = raw_input)
# Empty input
raw_empty <- raw(0L)
encoded_empty <- base64_encode(raw_bytes = raw_empty)
decoded_empty <- base64_decode(encoded_str = encoded_empty)
expect_identical(object = decoded_empty, expected = raw_empty)
# Complex R object
complex_obj <- list(a = 1L:10L, b = "test", c = list(d = TRUE))
raw_complex <- serialize(object = complex_obj, connection = NULL)
encoded_complex <- base64_encode(raw_bytes = raw_complex)
decoded_complex <- base64_decode(encoded_str = encoded_complex)
expect_identical(
object = unserialize(connection = decoded_complex),
expected = complex_obj
)
}
)
# Test serialize_check_log / deserialize_check_log ----
test_that(
"serialize_check_log / deserialize_check_log - round-trip",
{
encoded <- serialize_check_log(check_log = npx_data1_check_log)
expect_type(object = encoded, type = "character")
expect_length(object = encoded, n = 1L)
decoded <- deserialize_check_log(encoded_str = encoded)
expect_identical(object = decoded, expected = npx_data1_check_log)
}
)
test_that(
"deserialize_check_log - warns and returns NULL for corrupted input",
{
# A string that is valid base64 but not a serialized R object
corrupted <- base64_encode(raw_bytes = charToRaw("not_an_R_object"))
expect_warning(
object = {
result <- deserialize_check_log(encoded_str = corrupted)
},
regexp = "Could not deserialize"
)
expect_null(object = result)
}
)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.