diff --git a/R/generic_metric_coerce.R b/R/generic_metric_coerce.R index eb5317e..3df6751 100644 --- a/R/generic_metric_coerce.R +++ b/R/generic_metric_coerce.R @@ -41,3 +41,36 @@ method( function(from, to, ...) { as.integer(from, ...) } + +method( + metric_coerce, + list( + new_union(class_character, class_integer, class_logical), + new_S3_class(class_desc(class_double)) + ) +) <- + function(from, to, ...) { + as.double(from, ...) + } + +method( + metric_coerce, + list( + new_union(class_character, class_double, class_integer), + new_S3_class(class_desc(class_logical)) + ) +) <- + function(from, to, ...) { + as.logical(from, ...) + } + +method( + metric_coerce, + list( + new_union(class_double, class_integer, class_logical), + new_S3_class(class_desc(class_character)) + ) +) <- + function(from, to, ...) { + as.character(from, ...) + } diff --git a/tests/testthat/test-metric_coerce.R b/tests/testthat/test-metric_coerce.R new file mode 100644 index 0000000..e246ead --- /dev/null +++ b/tests/testthat/test-metric_coerce.R @@ -0,0 +1,66 @@ +test_that("metric_coerce coerces character metrics to each atomic type", { + ms <- metrics() + + # integer metric + expect_identical( + metric_coerce("3", ms[["r_cmd_check_error_count"]]@data_class), + 3L + ) + + # logical metric + expect_identical( + metric_coerce("TRUE", ms[["has_website"]]@data_class), + TRUE + ) + expect_identical( + metric_coerce("FALSE", ms[["has_website"]]@data_class), + FALSE + ) + + # double metric + expect_identical( + metric_coerce("0.5", ms[["test_line_coverage_fraction"]]@data_class), + 0.5 + ) +}) + +test_that("metric_coerce coerces atomic values to character", { + expect_identical(metric_coerce(3L, class_character), "3") + expect_identical(metric_coerce(0.5, class_character), "0.5") + expect_identical(metric_coerce(TRUE, class_character), "TRUE") +}) + +test_that("convert package_matrix to metric_data_frame handles atomic types", { + set.seed(1) + repo <- suppressWarnings(random_repo(n = 4)) + on.exit(unlink(sub("^file://", "", repo), recursive = TRUE)) + + # metric fields are non-standard, so discover them from the PACKAGES DCF + packages_url <- file.path( + sub("^file://", "", repo), + "src", "contrib", "PACKAGES" + ) + dcf <- paste(readLines(packages_url), collapse = "\n") + metric_fields <- grep( + "^Metric/", + colnames(read.dcf(textConnection(dcf))), + value = TRUE + ) + + db <- available.packages( + repos = repo, + fields = metric_fields, + filters = list() + ) + db <- db[!is.na(db[, "Package"]), , drop = FALSE] + + expect_no_error( + met <- convert(class_package_matrix(db), class_metric_data_frame) + ) + + # logical, double and integer metrics should have been coerced away from + # their character storage representation + expect_type(met[["has_website"]], "logical") + expect_type(met[["test_line_coverage_fraction"]], "double") + expect_type(met[["r_cmd_check_error_count"]], "integer") +})