From 7a35d91407d24e59c196ac9d50664ee04b05293f Mon Sep 17 00:00:00 2001 From: Diego H Date: Sat, 20 Jan 2024 10:41:39 +0100 Subject: [PATCH] Start testing suite --- .imgbotconfig | 1 + CITATION.cff | 3 - R/resmush_file.R | 11 ++- R/utils.R | 9 ++ codemeta.json | 2 +- tests/testthat/_snaps/resmush_file.md | 33 +++++++ tests/testthat/test-resmush_file.R | 122 +++++++++++++++++++++++++- 7 files changed, 173 insertions(+), 8 deletions(-) create mode 100644 tests/testthat/_snaps/resmush_file.md diff --git a/.imgbotconfig b/.imgbotconfig index 930d614..6377ebe 100644 --- a/.imgbotconfig +++ b/.imgbotconfig @@ -1,6 +1,7 @@ { "ignoredFiles": [ "/tests/testthat/_snaps/*", + "/tests/testthat/*", "/man/figures/lifecycle*", "inst/*" ], diff --git a/CITATION.cff b/CITATION.cff index 5180820..0b210e4 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -58,9 +58,6 @@ references: email: jeroen@berkeley.edu orcid: https://orcid.org/0000-0002-4035-0289 year: '2024' - identifiers: - - type: url - value: https://curl.se/libcurl/ - type: software title: httr abstract: 'httr: Tools for Working with URLs and HTTP' diff --git a/R/resmush_file.R b/R/resmush_file.R index 6b13e76..0fe1130 100644 --- a/R/resmush_file.R +++ b/R/resmush_file.R @@ -59,7 +59,9 @@ resmush_file <- function(file, outfile = file, qlty = 92, verbose = FALSE) { ) # Check access - if (!curl::has_internet()) { + # Internal option, for checking purposes only + test <- getOption("resmush_test_offline", FALSE) + if (any(isFALSE(curl::has_internet()), test)) { cli::cli_alert_warning("Offline") res$notes <- "Offline" return(invisible(res)) @@ -101,6 +103,7 @@ resmush_file <- function(file, outfile = file, qlty = 92, verbose = FALSE) { return(invisible(res)) } + # nocov start if (!"dest" %in% names(res_post)) { cli::cli_alert_warning( "API Not responding, check {.href https://resmush.it/status}" @@ -108,6 +111,7 @@ resmush_file <- function(file, outfile = file, qlty = 92, verbose = FALSE) { res$notes <- "API Not responding, check https://resmush.it/status}" return(invisible(res)) } + # nocov end ## 2. Download from dest ---- dwn_opt <- httr::GET( @@ -115,6 +119,8 @@ resmush_file <- function(file, outfile = file, qlty = 92, verbose = FALSE) { httr::write_disk(outfile, overwrite = TRUE) ) + # Corner case + # nocov start if (httr::status_code(dwn_opt) != 200) { cli::cli_alert_warning( "API Not responding, check {.href https://resmush.it/status}" @@ -122,7 +128,7 @@ resmush_file <- function(file, outfile = file, qlty = 92, verbose = FALSE) { res$notes <- "API Not responding, check https://resmush.it/status}" return(invisible(res)) } - + # nocov end # Finally res$dest_img <- outfile @@ -141,6 +147,7 @@ resmush_file <- function(file, outfile = file, qlty = 92, verbose = FALSE) { "{.file {file}} optimized: {res$src_size}", " => {res$dest_size} ({res$compress_ratio})" )) + cli::cli_alert_info("Check output: {.file {outfile}}") } return(invisible(res)) } diff --git a/R/utils.R b/R/utils.R index 300ab0b..78377a1 100644 --- a/R/utils.R +++ b/R/utils.R @@ -4,3 +4,12 @@ make_object_size <- function(x) { class(x) <- class(classob) x } + +# Utils for testing +load_inst_to_temp <- function(file) { + f <- system.file(paste0("extimg/", file), package = "resmush") + tmp <- file.path(tempdir(), basename(f)) + if (file.exists(tmp)) unlink(tmp, force = TRUE) + file.copy(f, tempdir(), overwrite = TRUE) + tmp +} diff --git a/codemeta.json b/codemeta.json index 178c628..104ee7d 100644 --- a/codemeta.json +++ b/codemeta.json @@ -107,7 +107,7 @@ }, "SystemRequirements": null }, - "fileSize": "359.423KB", + "fileSize": "363.208KB", "releaseNotes": "https://github.com/dieghernan/resmush/blob/master/NEWS.md", "readme": "https://github.com/dieghernan/resmush/blob/main/README.md", "contIntegration": ["https://github.com/dieghernan/resmush/actions/workflows/check-full.yaml", "https://app.codecov.io/gh/dieghernan/resmush"], diff --git a/tests/testthat/_snaps/resmush_file.md b/tests/testthat/_snaps/resmush_file.md new file mode 100644 index 0000000..fe68ad6 --- /dev/null +++ b/tests/testthat/_snaps/resmush_file.md @@ -0,0 +1,33 @@ +# Test offline + + Code + dm <- resmush_file(test_png) + Message + ! Offline + +--- + + Code + dm[, -1] + Output + dest_img src_size dest_size compress_ratio notes + 1 NA NA NA NA Offline + +# Test not provided file + + Code + dm[, -1] + Output + dest_img src_size dest_size compress_ratio notes + 1 NA NA NA NA local file does not exists + +# Not valid file + + Code + dm[, -c(1, 2)] + Output + src_size dest_size compress_ratio + 1 21 bytes NA NA + notes + 1 403: Unauthorized extension. Allowed are : JPG, PNG, GIF, BMP, TIFF, WEBP + diff --git a/tests/testthat/test-resmush_file.R b/tests/testthat/test-resmush_file.R index 8849056..3c2977c 100644 --- a/tests/testthat/test-resmush_file.R +++ b/tests/testthat/test-resmush_file.R @@ -1,3 +1,121 @@ -test_that("multiplication works", { - expect_equal(2 * 2, 4) +test_that("Test offline", { + skip_on_cran() + test_png <- load_inst_to_temp("example.png") + expect_true(file.exists(test_png)) + + # Options for testing + ops <- options() + options(resmush_test_offline = TRUE) + + expect_true("resmush_test_offline" %in% names(options())) + + expect_snapshot(dm <- resmush_file(test_png)) + + expect_s3_class(dm, "data.frame") + expect_snapshot(dm[, -1]) + + expect_equal(dm$src_img, test_png) + + # Reset ops + options(resmush_test_offline = NULL) + expect_false("resmush_test_offline" %in% names(options())) +}) + +test_that("Test not provided file", { + skip_on_cran() + skip_if_offline() + + # tempfile + fl <- tempfile() + + expect_false(file.exists(fl)) + + expect_message( + dm <- resmush_file(fl), + "not found on disk" + ) + + expect_s3_class(dm, "data.frame") + expect_snapshot(dm[, -1]) + + expect_equal(dm$src_img, fl) +}) + +test_that("Not valid file", { + skip_on_cran() + skip_if_offline() + + # tempfile + fl <- tempfile(, fileext = "txt") + + writeLines("testing a fake file", con = fl) + expect_true(file.exists(fl)) + + expect_message( + dm <- resmush_file(fl), + "API Error" + ) + + expect_s3_class(dm, "data.frame") + expect_snapshot(dm[, -c(1, 2)]) + expect_false(is.na(dm$src_img)) + expect_equal(dm$src_img, fl) +}) + +test_that("Test default opts with png", { + skip_on_cran() + skip_if_offline() + test_png <- load_inst_to_temp("example.png") + expect_true(file.exists(test_png)) + + expect_silent(dm <- resmush_file(test_png)) + + expect_s3_class(dm, "data.frame") + expect_false(any(is.na(dm))) + expect_equal(dm$src_img, test_png) + expect_equal(dm$dest_img, test_png) + + ratio <- as.double(gsub("%", "", dm$compress_ratio)) + expect_lt(ratio, 100) +}) + + +test_that("Test opts with png", { + skip_on_cran() + skip_if_offline() + test_png <- load_inst_to_temp("example.png") + expect_true(file.exists(test_png)) + outf <- tempfile(fileext = ".png") + expect_false(file.exists(outf)) + expect_message( + dm <- resmush_file(test_png, + outf, + verbose = TRUE + ), + "optimized:" + ) + + expect_true(file.exists(outf)) + expect_s3_class(dm, "data.frame") + expect_false(any(is.na(dm))) + expect_equal(dm$src_img, test_png) + expect_equal(dm$dest_img, outf) + + ins <- file.size(test_png) + outs <- file.size(outf) + expect_lt(outs, ins) + + # Check units + unts <- make_object_size(ins) + anobj <- object.size(unts) + expect_s3_class(unts, class(unts)) + fmrted <- format(unts, "auto") + + expect_identical(dm$src_size, fmrted) +}) + +test_that("Test qlty par with jpg", { + skip_on_cran() + skip_if_offline() + skip("TODO: Finish tests") })