# The any-to-any losslessness matrix — the acceptance test of the flagship # promise. Every ordered pair of full-metadata formats (json, parquet, rds) # must round-trip the torture frame (all 10 dataTypes, non-ASCII, special # missings on plain and temporal columns) with data, tags, and meta identical. # xpt joins on its documented honesty contract (C3/C4): values, labels, # formats, informats, and tags survive; dataType narrows to what NAMESTR can # record (boolean/integer/decimal come back numeric, "" comes back NA). .full_formats <- function() { fmts <- c("json", "ndjson", "rds") if (requireNamespace("nanoparquet", quietly = TRUE)) { fmts <- c(fmts, "parquet") } fmts } .write_read <- function(df, fmt) { p <- withr::local_tempfile( fileext = paste0(".", fmt), .local_envir = parent.frame() ) write_dataset(df, p, format = fmt) read_dataset(p, format = fmt) } test_that("every full-metadata format round-trips the torture frame", { src <- .torture_frame() for (fmt in .full_formats()) { back <- .write_read(src, fmt) expect_lossless(src, back, via = fmt) } }) test_that("every ordered pair of full-metadata formats chains losslessly", { src <- .torture_frame() fmts <- .full_formats() for (f in fmts) { a <- .write_read(src, f) for (g in setdiff(fmts, f)) { b <- .write_read(a, g) expect_lossless(src, b, via = paste(f, "->", g)) } } }) test_that("the conformed demo datasets chain through every format pair", { specs <- list( DM = artoo_spec( cdisc_sdtm_datasets, cdisc_sdtm_variables, codelists = cdisc_codelists ), ADSL = artoo_spec( cdisc_adam_datasets, cdisc_adam_variables, codelists = cdisc_codelists ) ) fmts <- .full_formats() for (ds in c("DM", "ADSL")) { src <- apply_spec( if (ds == "DM") cdisc_dm else cdisc_adsl, specs[[ds]], ds, conformance = "off" ) for (f in fmts) { a <- .write_read(src, f) for (g in setdiff(fmts, f)) { expect_lossless(src, .write_read(a, g), via = paste(ds, f, "->", g)) } } } }) test_that("xpt legs preserve values, tags, and the carried metadata", { # The xpt-representable slice of the torture frame (boolean/integer/decimal # narrow to numeric in NAMESTR — the documented C3 contract — so they are # exercised in the value comparison but not the meta-identity one). src <- .torture_frame() xpt_cols <- c("USUBJID", "AVAL", "DVAL", "ADT", "ADTM", "ATM", "REFURI") src <- set_meta( src[xpt_cols], artoo:::.meta_select_columns(get_meta(src), xpt_cols) ) for (mid in .full_formats()) { p1 <- withr::local_tempfile(fileext = ".xpt") write_xpt(src, p1, version = 8) a <- read_xpt(p1) b <- .write_read(a, mid) p2 <- withr::local_tempfile(fileext = ".xpt") write_xpt(b, p2, version = 8) c2 <- read_xpt(p2) # Frame-level identity between the two xpt reads: nothing decayed on the # way through the middle format. expect_lossless(a, c2, via = paste("xpt ->", mid, "-> xpt")) # And the xpt read itself preserved the source values and tags. for (nm in names(src)) { av <- a[[nm]] sv <- src[[nm]] attributes(av) <- NULL attributes(sv) <- NULL expect_identical(av, sv, label = paste("xpt values for", nm)) } expect_identical( get_meta(a)@columns$ADT$informat, "YYMMDD10." ) } }) # ---- design-quality edge matrix (7b): 0-row + all-NA across every format ---- test_that("a 0-row conformed frame round-trips every full-metadata format", { empty <- .torture_frame()[0, , drop = FALSE] empty <- sync_meta(empty, get_meta(.torture_frame())) for (ext in c(".json", ".ndjson", ".rds", ".parquet")) { if (ext == ".parquet") { skip_if_not_installed("nanoparquet") } p <- withr::local_tempfile(fileext = ext) write_dataset(empty, p) back <- read_dataset(p) expect_identical(nrow(back), 0L, info = ext) expect_identical(names(back), names(empty), info = ext) expect_identical( names(get_meta(back)@columns), names(get_meta(empty)@columns), info = ext ) } }) test_that("an all-NA column survives every full-metadata format", { df <- .torture_frame() df$AVAL <- NA_real_ attr(df$AVAL, "label") <- "Analysis Value" df <- sync_meta(df, get_meta(.torture_frame())) for (ext in c(".json", ".ndjson", ".rds", ".parquet", ".xpt")) { if (ext == ".parquet") { skip_if_not_installed("nanoparquet") } p <- withr::local_tempfile(fileext = ext) write_dataset(df, p) back <- read_dataset(p) expect_true(all(is.na(back$AVAL)), info = ext) expect_identical(length(back$AVAL), nrow(df), info = ext) } })