tests/testthat/helper.R

In io: A Unified Framework for Input-Output Operations in R

# binary formats cannot be compared line-by-line
binary.formats <- c("hdf5", "rds");

# use print-output-based object comparison tests for noncomparable objects
noncomparable.formats <- c("xml");

# exempt some of the externally implemented formats from connection tests
conn.exempt.formats <- union(c("xml", "json"), binary.formats);

suggested.packages <- list(xml="XML", hdf5="rhdf5", yaml="yaml", lst="yaml", json="jsonlite");
suggested.package.versions <- list(
	xml = list(name = "XML", op = ">=", version = package_version("3.98-1.1")),
	hdf5 = list(name = "rhdf5", op = ">=", version = package_version("2.10.0")),
	yaml = list(name = "yaml", op = ">=", version = package_version("2.1.13")),
	jsonlite = list(name = "jsonlite", op = ">=", version = package_version("0.9.14"))
);

.requireNamespace <- function(x, versionCheck) {
	x <- try(loadNamespace(x, versionCheck=versionCheck), silent=TRUE);
	if (class(x) == "try-error") {
		FALSE
	} else {
		TRUE
	}
}

# read an input file, write it to a temporary file
# and test that the files are the same;
# write a data object to file, read it back in
# and test that the data objects are the same
test_read_write_read <- function(infile) {

	ext <- tolower(as.filename(infile)$ext);

	if (ext %in% names(suggested.packages)) {
		if (!.requireNamespace(
			suggested.packages[[ext]], suggested.package.versions[[ext]]
		)) {
			# optional depedency is missing: skip test
			return(invisible());
		}
	}

	outfile <- tempfile("test-out", fileext=paste(".", ext, sep=""));

	# read-write-read cycle
	x <- qread(infile);
	qwrite(x, outfile);
	y <- qread(outfile);

	if (! ext %in% binary.formats) {

		inlines <- readLines(infile);

		test_that("read-and-write does not change file", {
			outlines <- readLines(outfile);
			expect_equal(inlines, outlines);
		});

	}

	if (ext %in% noncomparable.formats) {

		test_that("write-and-read does not change data (printed)", {
			expect_equal(capture.output(print(x)), capture.output(print(y)));
		});

	} else {

		test_that("write-and-read does not change data", {
			expect_equal(x, y);
		});

	}

	if (! ext %in% conn.exempt.formats) {

		test_that(sprintf("read from text connection does not change content, ext = %s", ext), {
			conn <- textConnection(inlines, "rt");
			z <- qread(conn, type=ext);
			close(conn);
			expect_equal(x, z);
		});

		test_that(sprintf("write to text connection does not change content, ext = %s", ext), {
			textlines <- character();
			conn <- textConnection("textlines", "wt", local=TRUE);
			# type has to be specified since c2 is a connection (no file extension!)
			qwrite(x, conn, type=ext);
			close(conn);
			expect_equal(inlines, textlines);
		});

	}

	file.remove(outfile);
}