From b084603e3a902a7904a563b8ce0599e6c7a75496 Mon Sep 17 00:00:00 2001 From: Daniel Martinez Date: Tue, 30 Mar 2021 17:07:02 +0300 Subject: [PATCH] bundled tmc-r-testrunner for tests to speed up CI --- .github/workflows/test.yml | 4 +- plugins/r/tests/tmcRtestrunner/.Rbuildignore | 2 + plugins/r/tests/tmcRtestrunner/.lintr | 9 + plugins/r/tests/tmcRtestrunner/DESCRIPTION | 27 +++ plugins/r/tests/tmcRtestrunner/NAMESPACE | 4 + .../tmcRtestrunner/R/GetAvailablePoints.R | 59 +++++++ .../r/tests/tmcRtestrunner/R/ResultsCreator.R | 109 ++++++++++++ .../tmcRtestrunner/R/ResultsJsonParser.R | 47 +++++ plugins/r/tests/tmcRtestrunner/R/RunTests.R | 75 ++++++++ .../tests/tmcRtestrunner/R/TestEnvironment.R | 60 +++++++ plugins/r/tests/tmcRtestrunner/man/hello.Rd | 12 ++ .../r/tests/tmcRtestrunner/tests/testthat.R | 5 + .../tests/testthat/helperFunctions.R | 30 ++++ .../resources/simple_all_tests_fail/R/main.R | 15 ++ .../simple_all_tests_fail.Rproj | 13 ++ .../tests/testthat/testMain.R | 18 ++ .../resources/simple_all_tests_pass/R/main.R | 11 ++ .../simple_all_tests_pass/R/second.R | 3 + .../simple_all_tests_pass.Rproj | 13 ++ .../tests/testthat/testMain.R | 18 ++ .../tests/testthat/testSecond.R | 7 + .../simple_all_tests_pass_with_plot/R/main.R | 4 + .../simple_sourcing_fail.Rproj | 13 ++ .../tests/testthat/mock.R | 30 ++++ .../tests/testthat/testMain.R | 13 ++ .../resources/simple_run_fail/R/main.R | 11 ++ .../simple_run_fail/simple_run_fail.Rproj | 13 ++ .../simple_run_fail/tests/testthat/testMain.R | 22 +++ .../resources/simple_some_tests_fail/R/main.R | 15 ++ .../simple_some_tests_fail.Rproj | 13 ++ .../tests/testthat/testMain.R | 26 +++ .../resources/simple_sourcing_fail/R/main.R | 12 ++ .../simple_sourcing_fail.Rproj | 13 ++ .../tests/testthat/testMain.R | 20 +++ .../tests/testthat/testGetAvailablePoints.R | 72 ++++++++ .../tests/testthat/testResultsCreator.R | 78 ++++++++ .../tests/testthat/testRunTests.R | 167 ++++++++++++++++++ .../tests/testthat/testTestEnvironment.R | 34 ++++ .../tests/tmcRtestrunner/tmcRtestrunner.Rproj | 20 +++ 39 files changed, 1115 insertions(+), 2 deletions(-) create mode 100644 plugins/r/tests/tmcRtestrunner/.Rbuildignore create mode 100644 plugins/r/tests/tmcRtestrunner/.lintr create mode 100644 plugins/r/tests/tmcRtestrunner/DESCRIPTION create mode 100644 plugins/r/tests/tmcRtestrunner/NAMESPACE create mode 100644 plugins/r/tests/tmcRtestrunner/R/GetAvailablePoints.R create mode 100644 plugins/r/tests/tmcRtestrunner/R/ResultsCreator.R create mode 100644 plugins/r/tests/tmcRtestrunner/R/ResultsJsonParser.R create mode 100644 plugins/r/tests/tmcRtestrunner/R/RunTests.R create mode 100644 plugins/r/tests/tmcRtestrunner/R/TestEnvironment.R create mode 100644 plugins/r/tests/tmcRtestrunner/man/hello.Rd create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/helperFunctions.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_fail/R/main.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_fail/simple_all_tests_fail.Rproj create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_fail/tests/testthat/testMain.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/R/main.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/R/second.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/simple_all_tests_pass.Rproj create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/tests/testthat/testMain.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/tests/testthat/testSecond.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/R/main.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/simple_sourcing_fail.Rproj create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/tests/testthat/mock.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/tests/testthat/testMain.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_run_fail/R/main.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_run_fail/simple_run_fail.Rproj create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_run_fail/tests/testthat/testMain.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_some_tests_fail/R/main.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_some_tests_fail/simple_some_tests_fail.Rproj create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_some_tests_fail/tests/testthat/testMain.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_sourcing_fail/R/main.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_sourcing_fail/simple_sourcing_fail.Rproj create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_sourcing_fail/tests/testthat/testMain.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/testGetAvailablePoints.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/testResultsCreator.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/testRunTests.R create mode 100644 plugins/r/tests/tmcRtestrunner/tests/testthat/testTestEnvironment.R create mode 100644 plugins/r/tests/tmcRtestrunner/tmcRtestrunner.Rproj diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index ee99fc77e71..ad8a9a4fa3a 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -27,8 +27,8 @@ jobs: dotnet-version: "5.0.x" - name: Install tmc-r-tester run: | - Rscript -e 'install.packages(c("devtools","testthat", "httr", "curl"),repos="https://ftp.eenet.ee/pub/cran/")' - Rscript -e 'devtools::install_github("RTMC/tmc-r-tester/tmcRtestrunner")' + Rscript -e 'install.packages(c("testthat", "jsonlite", "R.utils"))' + Rscript -e 'install.packages("plugins/r/tests/tmcRtestrunner", repos=NULL, type="source")' - name: Build test binary run: cargo test --no-run --verbose - name: Run tests diff --git a/plugins/r/tests/tmcRtestrunner/.Rbuildignore b/plugins/r/tests/tmcRtestrunner/.Rbuildignore new file mode 100644 index 00000000000..91114bf2f2b --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/.Rbuildignore @@ -0,0 +1,2 @@ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/plugins/r/tests/tmcRtestrunner/.lintr b/plugins/r/tests/tmcRtestrunner/.lintr new file mode 100644 index 00000000000..24a2f302e31 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/.lintr @@ -0,0 +1,9 @@ +linters: with_defaults( + absolute_paths_linter = NULL, # 21 + closed_curly_linter = NULL, # 2 + open_curly_linter = NULL, # 2 + single_quotes_linter = NULL, # 1 + NULL, + line_length_linter(120), + object_length_linter(80) + ) diff --git a/plugins/r/tests/tmcRtestrunner/DESCRIPTION b/plugins/r/tests/tmcRtestrunner/DESCRIPTION new file mode 100644 index 00000000000..c9ae1da44d6 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/DESCRIPTION @@ -0,0 +1,27 @@ +Package: tmcRtestrunner +Type: Package +Title: Runs TMC R projects +Version: 0.1.0 +Author: RTMC +Maintainer: The package maintainer +Description: More about what it does (maybe more than one line) + Use four spaces when indenting paragraphs within the Description. +License: What license is it under? +Encoding: UTF-8 +LazyData: true +Depends: + testthat, + jsonlite, + R.utils +Imports: + testthat, + jsonlite, + R.utils +Suggests: + lintr +Collate: + 'ResultsJsonParser.R' + 'ResultsCreator.R' + 'RunTests.R' + 'GetAvailablePoints.R' + 'TestEnvironment.R' diff --git a/plugins/r/tests/tmcRtestrunner/NAMESPACE b/plugins/r/tests/tmcRtestrunner/NAMESPACE new file mode 100644 index 00000000000..1151677c2ef --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/NAMESPACE @@ -0,0 +1,4 @@ +exportPattern("^[[:alpha:]]+") +import(testthat) +import(jsonlite) +import(R.utils) diff --git a/plugins/r/tests/tmcRtestrunner/R/GetAvailablePoints.R b/plugins/r/tests/tmcRtestrunner/R/GetAvailablePoints.R new file mode 100644 index 00000000000..121fa107ebd --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/R/GetAvailablePoints.R @@ -0,0 +1,59 @@ + +.get_available_points <- function(project_path) { + .init_global_vars() + test_files <- list.files(path = paste0(project_path, "/tests/testthat"), pattern = "test.*\\.R", + full.names = T, recursive = FALSE) + for (test_file in test_files) { + .GlobalEnv$map_to_desc[[.GlobalEnv$counter]] <- list() + .GlobalEnv$file_points[[.GlobalEnv$counter]] <- list() + test_file(test_file, reporter = "silent", env = .create_counter_env(project_path)) + .GlobalEnv$counter <- .GlobalEnv$counter + 1 + } + return (.add_points(.GlobalEnv$test_available_points, .GlobalEnv$file_points, .GlobalEnv$map_to_desc)) +} + +.init_global_vars <- function() { + .GlobalEnv$test_available_points <- list() + .GlobalEnv$file_points <- list() + .GlobalEnv$map_to_desc <- list() + .GlobalEnv$counter <- 1 +} + +.add_points <- function(test_available_points, file_points, map_to_desc) { + all_available_points <- list() + for (i in (1:unlist(.GlobalEnv$counter - 1))) { + for (desc in map_to_desc[[i]]) { + all_available_points[[desc]] <- c(file_points[[i]], test_available_points[[desc]]) + } + } + return (all_available_points) +} + +.create_counter_env <- function(project_path) { + test_env <- new.env() + .define_counter_functions(test_env, project_path) + return (test_env) +} + +.define_counter_functions <- function(test_env, project_path) { + .source_files(test_env, project_path) + test_env$test <- function(desc, point, code){ + if (!(desc %in% .GlobalEnv$test_available_points)) { + .GlobalEnv$test_available_points[[desc]] <- list() + } + .GlobalEnv$test_available_points[[desc]] <- c(point) + .GlobalEnv$map_to_desc[[.GlobalEnv$counter]] <- c(.GlobalEnv$map_to_desc[[.GlobalEnv$counter]], desc) + } + test_env$points_for_all_tests <- function(points){ + .GlobalEnv$file_points[[.GlobalEnv$counter]] <- c(points) + } +} + +# Checks the available points for all test in the project without running test. Creates +# file .available_points.json in the project root. +run_available_points <- function(project_path = getwd()) { + available_points <- .get_available_points(project_path) + + json_results <- .create_available_points_json_results(available_points) + .write_json(json_results, paste0(project_path, "/.available_points.json")) +} diff --git a/plugins/r/tests/tmcRtestrunner/R/ResultsCreator.R b/plugins/r/tests/tmcRtestrunner/R/ResultsCreator.R new file mode 100644 index 00000000000..9f1c6e3df83 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/R/ResultsCreator.R @@ -0,0 +1,109 @@ +.create_file_results <- function(testthat_file_output, + tests_points, + file_points) { + + results <- list() + for (test in testthat_file_output) { + name <- test$test + status <- .get_status_for_test(test) + message <- .create_message_for_test(test, status) + backtrace <- .create_backtrace_for_test(test, status) + points <- .get_points_for_test(name, + tests_points, + file_points) + + test_result <- list("name" = name, + "status" = status, + "points" = points, + "message" = message, + "backtrace" = backtrace) + + results[[length(results) + 1]] <- test_result + } + return(results) +} + +.get_points_for_test <- function(test_name, tests_points, file_points) { + if (is.null(tests_points[[test_name]])) { + test_points <- vector() + } else { + test_points <- tests_points[[test_name]] + } + test_points <- c(file_points, test_points) + return(test_points) +} + +.get_status_for_test <- function(test) { + if (.check_if_test_passed(test)) { + status <- "pass" + } else { + status <- "fail" + } + return(status) +} + +#Checks if a single test passed +.check_if_test_passed <- function(test) { + ret <- TRUE + for (result in test$results) { + if (!.check_if_result_passed(result)) { + ret <- FALSE + break + } + } + return(ret) +} + +#Check if a single result passed +.check_if_result_passed <- function(result) { + return(format(result) == "As expected") +} + +.message_from_failed_result <- function(result) { + message_rows <- strsplit(result$message, "\n")[[1]] + return(paste(message_rows, collapse = "\n")) +} + +.create_message_for_test <- function(test, status) { + if (status == "pass") return("") + + for (result in test$results) { + if (format(result) != "As expected") { + return(.message_from_failed_result(result)) + } + } + return("") +} + +.create_backtrace_for_test <- function(testthat_test_result, status) { + if (status == "pass") return(list()) + + for (result in testthat_test_result$results) { + if (format(result) != "As expected") { + backtrace <- list() + i <- 1; + for (call in result$call) { + backtrace <- append(backtrace, paste0(i, ": ", .create_call_message(call))) + i <- i + 1 + } + return(backtrace) + } + } + return(list()) + +} + +.create_call_message <- function(call) { + call_str <- format(call) + call_srcref <- attributes(call)$srcref + srcref_data <- c(call_srcref) + srcfile_filename <- attributes(call_srcref)$srcfile$filename + + if (is.null(call_srcref)) { + message <- paste0(call_str) + } else { + message <- paste0(call_str, " in ", srcfile_filename, "#", srcref_data[[1]]) + } + + return(message) +} diff --git a/plugins/r/tests/tmcRtestrunner/R/ResultsJsonParser.R b/plugins/r/tests/tmcRtestrunner/R/ResultsJsonParser.R new file mode 100644 index 00000000000..89432347d2a --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/R/ResultsJsonParser.R @@ -0,0 +1,47 @@ +#Creates JSON containing test names and points availble from them, based on the test file. +.create_available_points_json_results <- function(available_points) { + results <- list() + for (desc in names(available_points)) { + results[[desc]] <- available_points[[desc]] + } + return (results) +} + +.create_json_run_results <- function(run_results) { + json_test_results <- list() + for (test_result in run_results$test_results) { + json_test_results[[length(json_test_results) + 1]] <- .create_json_test_result(test_result) + } + json_run_results <- list("runStatus" = unbox(run_results$run_status), + "backtrace" = lapply(run_results$backtrace, unbox), "testResults" = json_test_results) + return(json_run_results) +} + +#Creates JSON for each different test case. +.create_json_test_result <- function(test_result) { + test_result <- list(status = unbox(test_result$status), + name = unbox(format(test_result$name)), + message = unbox(test_result$message), + backtrace = lapply(test_result$backtrace, unbox), + points = test_result$points) + return(test_result) +} + +#Writes JSON based on the whole test result. +.write_json <- function(results, file) { + #json utf-8 coded: + json <- enc2utf8(toJSON(results, pretty = FALSE)) + json <- prettify(json) + #encode json to utf-8 and write file + write(json, file) +} + +#Prints results. +.print_results_from_json <- function(json_result) { + for (test in json_result$testResults) { + cat(sep = "", test$name, ": ", test$status, "\n") + if (test$message != "") { + cat(sep = "", "\n", test$message, "\n") + } + } +} diff --git a/plugins/r/tests/tmcRtestrunner/R/RunTests.R b/plugins/r/tests/tmcRtestrunner/R/RunTests.R new file mode 100644 index 00000000000..870d948d2c2 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/R/RunTests.R @@ -0,0 +1,75 @@ +# Runs the tests from project directory and writes results JSON to the root of the project +# as .results.json. +# +# Args: +# project_path: The absolute path to the root of the project being tested. +# print: If TRUE, prints results; if not, not. DEFAULT is FALSE. +# +# Returns: +# Run results list containing: runStatus (string), backtrace (list), test_results (list) +run_tests <- function(project_path = getwd(), print = FALSE) { + #Runs tests for project and returns the results. + #If sourcing_error occurs, .sourcing_error_run_results returns the results. + run_results <- tryCatch({.run_tests_project(project_path)}, + sourcing_error = .sourcing_error_run_result, + run_error = .run_error_run_result) + + json_run_results <- .create_json_run_results(run_results) + .write_json(json_run_results, file.path(project_path, ".results.json")) + + if (print) { + .print_results_from_json(json_run_results) + } + + invisible(run_results) +} + +.run_tests_project <- function(project_path) { + test_results <- list() + #Lists all the files in the path beginning with "test" and ending in ".R" + test_files <- list.files(path = file.path(project_path, "tests", "testthat"), pattern = "test.*\\.R", + full.names = TRUE, recursive = FALSE) + + for (test_file in test_files) { + file_results <- .run_tests_file(test_file, project_path) + test_results <- c(test_results, file_results) + } + return(list("run_status" = "success", "backtrace" = list(), "test_results" = test_results)) +} + +.run_tests_file <- function(file_path, project_path) { + .GlobalEnv$points <- list() + .GlobalEnv$points_for_all_tests <- list() + + test_env = .create_test_env(project_path) + test_file_output <- tryCatch({test_file(file_path, reporter = "silent", env = test_env)}, + error = .signal_run_error) + + test_file_results <- .create_file_results(test_file_output, points, .GlobalEnv$points_for_all_tests) + + return(test_file_results) +} + +.signal_sourcing_error <- function(error) { + sourcing_error <- simpleError(message = error$message, call = error$call) + class(sourcing_error) <- c("sourcing_error", class(sourcing_error)) + signalCondition(sourcing_error) +} + +.sourcing_error_run_result <- function(sourcing_error) { + split_message <- strsplit(sourcing_error$message, split = "\n") + backtrace <- lapply(split_message[[1]], unbox) + return(list("run_status" = "sourcing_failed", "backtrace" = backtrace, "test_results" = list())) +} + +.signal_run_error <- function(error) { + run_error <- simpleError(message = error$message, call = error$call) + class(run_error) <- c("run_error", class(run_error)) + signalCondition(run_error) +} + +.run_error_run_result <- function(run_error) { + split_message <- strsplit(run_error$message, split = "\n") + backtrace <- lapply(split_message[[1]], unbox) + return(list("run_status" = "run_failed", "backtrace" = backtrace, "test_results" = list())) +} diff --git a/plugins/r/tests/tmcRtestrunner/R/TestEnvironment.R b/plugins/r/tests/tmcRtestrunner/R/TestEnvironment.R new file mode 100644 index 00000000000..ff1ef14e3d3 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/R/TestEnvironment.R @@ -0,0 +1,60 @@ +.create_test_env <- function(project_path) { + test_env <- new.env() + .define_tester_functions(test_env) + tryCatch({.override_functions(test_env, project_path)}, + error = .signal_sourcing_error) + tryCatch({.source_files(test_env, project_path)}, + error = .signal_sourcing_error) + return (test_env) +} + +.source_files <- function(test_env, project_path) { + for (file in list.files(pattern = "[.]R$", path = paste0(project_path, "/R/"), full.names = TRUE)) { + source(file, test_env, keep.source = getOption("keep.source")) + } +} + +.define_tester_functions <- function(test_env) { + assign("points_for_all_tests",function(points) { + .GlobalEnv$points_for_all_tests <- points + },envir=test_env) + lockBinding("points_for_all_tests",test_env) + #The test that wraps around test_that()-method and stores the points + #to global environment. + assign("test",function(desc, points, code,timeout = 30) { + .GlobalEnv$points[[desc]] <- points + withTimeout({ + test_that(desc, code); + }, + timeout = timeout); + },envir=test_env) + lockBinding("test",test_env) +} + + +.override_functions <- function(test_env, project_path) { + mock_path <- paste(sep = .Platform$file.sep, project_path, "tests", + "testthat", "mock.R") + if (file.exists(mock_path)) { + sys.source(mock_path, test_env) + } +} + +# .source_from_test_file <- function(test_location, test_env) { +# script_name <- basename(test_location) +# script_name <- substr(script_name, 5, nchar(script_name)) +# source_folder <- "R/" +# # Checks whether list is empty and if it is, modifies the first letter of the script to lower case. +# if (length(list.files(path = source_folder, pattern = script_name, full.names = T, recursive = FALSE)) == 0) { +# substr(script_name, 1, 1) <- tolower(substr(script_name, 1, 1)) +# } +# sys.source(paste0(source_folder, script_name), test_env) +# } +# +# .create_test_env_file <- function(test_file) { +# test_env <- new.env() +# .define_tester_functions(test_env) +# tryCatch({.source_from_test_file(test_file, test_env)}, +# error = .signal_sourcing_error) +# return (test_env) +# } diff --git a/plugins/r/tests/tmcRtestrunner/man/hello.Rd b/plugins/r/tests/tmcRtestrunner/man/hello.Rd new file mode 100644 index 00000000000..8b7e601a9d2 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/man/hello.Rd @@ -0,0 +1,12 @@ +\name{hello} +\alias{hello} +\title{Hello, World!} +\usage{ +hello() +} +\description{ +Prints 'Hello, world!'. +} +\examples{ + +} diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat.R b/plugins/r/tests/tmcRtestrunner/tests/testthat.R new file mode 100644 index 00000000000..c6269bd4567 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat.R @@ -0,0 +1,5 @@ +library(testthat) +library(jsonlite) +library(tmcRtestrunner) + +test_check("tmcRtestrunner") diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/helperFunctions.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/helperFunctions.R new file mode 100644 index 00000000000..038900f8a28 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/helperFunctions.R @@ -0,0 +1,30 @@ +.run_create_file_result_for_files <- function(project_path) { + test_results <- list() + + test_files <- list.files(path = file.path(project_path, "tests", "testthat"), pattern = "test.*\\.R", + full.names = T, recursive = FALSE) + for (test_file in test_files) { + .GlobalEnv$points <- list() + .GlobalEnv$points_for_all_tests <- list() + test_env <- .create_test_env(project_path) + test_results<- c(test_results, .create_file_results(test_file(test_file, reporter = "silent", env = test_env), + .GlobalEnv$points, + .GlobalEnv$points_for_all_tests)) + } + + return(test_results) +} + +remove_old_results_json <- function(project_path) { + results_json_path <- paste(sep = "", project_path, "/.results.json") + if (file.exists(results_json_path)) { + file.remove(results_json_path) + } +} + +remove_old_available_points_json <- function(project_path) { + available_points_json_path <- paste(sep = "", project_path, "/.available_points.json") + if (file.exists(available_points_json_path)) { + file.remove(available_points_json_path) + } +} diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_fail/R/main.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_fail/R/main.R new file mode 100644 index 00000000000..72c95629ab2 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_fail/R/main.R @@ -0,0 +1,15 @@ +ret_true <- function() { + return(TRUE) +} + +ret_one <- function() { + return(1) +} + +add <- function(a, b) { + return(a + b) +} + +ret_false <- function() { + return(FALSE) +} diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_fail/simple_all_tests_fail.Rproj b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_fail/simple_all_tests_fail.Rproj new file mode 100644 index 00000000000..8e3c2ebc99e --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_fail/simple_all_tests_fail.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_fail/tests/testthat/testMain.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_fail/tests/testthat/testMain.R new file mode 100644 index 00000000000..03aa4eebec8 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_fail/tests/testthat/testMain.R @@ -0,0 +1,18 @@ +library("testthat") + +points_for_all_tests(c("r1")) + +test("ret_true works", c("r1.1"), { + expect_true(ret_false()) +}) + +test("ret_one works", c("r1.2"), { + expect_equal(ret_one(), 2) +}) + +test("add works", c("r1.3", "r1.4"), { + expect_equal(add(1, 1), 3) + expect_equal(add(0, 1), 0) + expect_equal(add(0, 0), 1) + expect_equal(add(5, 5), 11) +}) diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/R/main.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/R/main.R new file mode 100644 index 00000000000..8ead5c0b41f --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/R/main.R @@ -0,0 +1,11 @@ +ret_true <- function() { + return(TRUE) +} + +ret_one <- function() { + return(1) +} + +add <- function(a, b) { + return(a + b) +} diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/R/second.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/R/second.R new file mode 100644 index 00000000000..e15c0d77713 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/R/second.R @@ -0,0 +1,3 @@ +minus <- function(a, b) { + return(a - b) +} diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/simple_all_tests_pass.Rproj b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/simple_all_tests_pass.Rproj new file mode 100644 index 00000000000..8e3c2ebc99e --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/simple_all_tests_pass.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/tests/testthat/testMain.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/tests/testthat/testMain.R new file mode 100644 index 00000000000..63594dc79ac --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/tests/testthat/testMain.R @@ -0,0 +1,18 @@ +library("testthat") + +points_for_all_tests(c("r1")) + +test("ret_true works.", c("r1.1"), { + expect_true(ret_true()) +}) + +test("ret_one works.", c("r1.2"), { + expect_equal(ret_one(), 1) +}) + +test("add works.", c("r1.3", "r1.4"), { + expect_equal(add(1, 1), 2) + expect_equal(add(0, 1), 1) + expect_equal(add(0, 0), 0) + expect_equal(add(5, 5), 10) +}) diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/tests/testthat/testSecond.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/tests/testthat/testSecond.R new file mode 100644 index 00000000000..9397aac2420 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/tests/testthat/testSecond.R @@ -0,0 +1,7 @@ +library("testthat") + +points_for_all_tests(c("r2")) + +test("minus works", c("r2.1"), { + expect_equal(minus(5, 2), 3) +}) diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/R/main.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/R/main.R new file mode 100644 index 00000000000..8be743bc9a4 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/R/main.R @@ -0,0 +1,4 @@ + +x <- seq(0,10, by = .1) +y <- sin(x) +plot(x, y, main = "sin x") diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/simple_sourcing_fail.Rproj b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/simple_sourcing_fail.Rproj new file mode 100644 index 00000000000..8e3c2ebc99e --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/simple_sourcing_fail.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/tests/testthat/mock.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/tests/testthat/mock.R new file mode 100644 index 00000000000..7bad7986bff --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/tests/testthat/mock.R @@ -0,0 +1,30 @@ +#In this file, the teacher can override R functions so that she/he can +#test whether the student has used some function (and maybe with the correct +#arguments) + +used_plot_args <- list() +used_paste_args <- list() + +plot <- function(x, y, ...) { + params <- list(x = x, y = y, ...) + + # Assigning to environment before this function call: + env_parent <- parent.frame() + env_parent$used_plot_args[[length(used_plot_args) + 1]] <- params + + graphics::plot(x = x,y = y, ...) + + if (file.exists("Rplots.pdf")) { + file.remove("Rplots.pdf") + } +} + +paste0 <- function(...) { + params <- list(...) + + # Assigning to environment before this function call: + env_parent <- parent.frame() + env_parent$used_paste_args[[length(used_paste_args) + 1]] <- params + + base::paste0(...) +} diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/tests/testthat/testMain.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/tests/testthat/testMain.R new file mode 100644 index 00000000000..6f89720ca34 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass_with_plot/tests/testthat/testMain.R @@ -0,0 +1,13 @@ +library('testthat') + +points_for_all_tests(c("r1")) + +test("sin(x) plot called", c("r1.1"), { + expect_true(exists("used_plot_args")) + expect_false(is.null(used_plot_args[[1]]$x)) + expect_false(is.null(used_plot_args[[1]]$y)) + expect_false(is.null(used_plot_args[[1]]$main)) + expect_equal(used_plot_args[[1]]$x, seq(0,10, by = .1)) + expect_equal(used_plot_args[[1]]$y, sin(seq(0,10,by=.1))) + expect_equal(used_plot_args[[1]]$main, "sin x") +}) diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_run_fail/R/main.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_run_fail/R/main.R new file mode 100644 index 00000000000..8ead5c0b41f --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_run_fail/R/main.R @@ -0,0 +1,11 @@ +ret_true <- function() { + return(TRUE) +} + +ret_one <- function() { + return(1) +} + +add <- function(a, b) { + return(a + b) +} diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_run_fail/simple_run_fail.Rproj b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_run_fail/simple_run_fail.Rproj new file mode 100644 index 00000000000..8e3c2ebc99e --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_run_fail/simple_run_fail.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_run_fail/tests/testthat/testMain.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_run_fail/tests/testthat/testMain.R new file mode 100644 index 00000000000..2fc8805b3dd --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_run_fail/tests/testthat/testMain.R @@ -0,0 +1,22 @@ +library('testthat') + +source("../../R/main.R") + +points_for_all_tests(c("r1")) + +test("RetTrue works.", c("r1.1"), { + #Produces run fail: + in error in + expect_true(ret_true()) +}) + +test("RetOne works.", c("r1.2"), { + expect_equal(ret_one(), 1) +}) + +test("Add works.", c("r1.3", "r1.4"), { + expect_equal(add(1, 1), 2) + expect_equal(add(0, 1), 1) + expect_equal(add(0, 0), 0) + expect_equal(add(5, 5), 10) +}) diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_some_tests_fail/R/main.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_some_tests_fail/R/main.R new file mode 100644 index 00000000000..72c95629ab2 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_some_tests_fail/R/main.R @@ -0,0 +1,15 @@ +ret_true <- function() { + return(TRUE) +} + +ret_one <- function() { + return(1) +} + +add <- function(a, b) { + return(a + b) +} + +ret_false <- function() { + return(FALSE) +} diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_some_tests_fail/simple_some_tests_fail.Rproj b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_some_tests_fail/simple_some_tests_fail.Rproj new file mode 100644 index 00000000000..8e3c2ebc99e --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_some_tests_fail/simple_some_tests_fail.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_some_tests_fail/tests/testthat/testMain.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_some_tests_fail/tests/testthat/testMain.R new file mode 100644 index 00000000000..cd0bf60e54e --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_some_tests_fail/tests/testthat/testMain.R @@ -0,0 +1,26 @@ +library("testthat") + +points_for_all_tests(c("r1")) + +test("ret_true works.", c("r1.1"), { + expect_true(ret_true()) +}) + +test("ret_one works.", c("r1.2"), { + expect_equal(ret_one(), 1) +}) + +test("add works.", c("r1.3", "r1.4"), { + expect_equal(add(1, 1), 2) + expect_equal(add(0, 1), 1) + expect_equal(add(0, 0), 0) + expect_equal(add(5, 5), 10) +}) + +test("ret_false returns true", c("r1.5"), { + expect_true(ret_false()) +}) + +test("ret_true works but there are no points.", NULL, { + expect_true(ret_true()) +}) diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_sourcing_fail/R/main.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_sourcing_fail/R/main.R new file mode 100644 index 00000000000..e68a99924b1 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_sourcing_fail/R/main.R @@ -0,0 +1,12 @@ +ret_true <- function() { + return(TRUE) +} + +#This function produces an error +ret_one <- function() { + error in source code +} + +add <- function(a, b) { + return(a + b) +} diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_sourcing_fail/simple_sourcing_fail.Rproj b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_sourcing_fail/simple_sourcing_fail.Rproj new file mode 100644 index 00000000000..8e3c2ebc99e --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_sourcing_fail/simple_sourcing_fail.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_sourcing_fail/tests/testthat/testMain.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_sourcing_fail/tests/testthat/testMain.R new file mode 100644 index 00000000000..4cfeb29e5d6 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/resources/simple_sourcing_fail/tests/testthat/testMain.R @@ -0,0 +1,20 @@ +library('testthat') + +source("../../R/main.R") + +points_for_all_tests(c("r1")) + +test("RetTrue works.", c("r1.1"), { + expect_true(ret_true()) +}) + +test("RetOne works.", c("r1.2"), { + expect_equal(ret_one(), 1) +}) + +test("Add works.", c("r1.3", "r1.4"), { + expect_equal(add(1, 1), 2) + expect_equal(add(0, 1), 1) + expect_equal(add(0, 0), 0) + expect_equal(add(5, 5), 10) +}) diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/testGetAvailablePoints.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/testGetAvailablePoints.R new file mode 100644 index 00000000000..14148b13021 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/testGetAvailablePoints.R @@ -0,0 +1,72 @@ +test_resources_dir <- paste(sep = "", getwd(), "/resources") + +#projects for testing: +simple_all_tests_fail_project_path <- paste(sep = "", test_resources_dir, "/simple_all_tests_fail") +simple_all_tests_pass_project_path <- paste(sep = "", test_resources_dir, "/simple_all_tests_pass") +simple_some_tests_fail_project_path <- paste(sep = "", test_resources_dir, "/simple_some_tests_fail") + +test_that("First test in all passing testMain returns correct points", { + #All tests should return true: + test_points <- .get_available_points(simple_all_tests_pass_project_path) + points <- list() + points <- test_points[["ret_true works."]] + expect_true("r1" %in% points) + expect_true("r1.1" %in% points) + expect_true(!("r2" %in% points)) +}) + +test_that("Second test in all passing testMain returns correct points", { + test_points <- .get_available_points(simple_all_tests_pass_project_path) + points <- test_points[["ret_one works."]] + expect_true("r1" %in% points) + expect_true("r1.2" %in% points) + expect_true(!("r2" %in% points)) +}) + +test_that("Third test in all passing testMain returns correct points", { + test_points <- .get_available_points(simple_all_tests_pass_project_path) + points <- test_points[["add works."]] + expect_true("r1" %in% points) + expect_true("r1.3" %in% points) + expect_true("r1.4" %in% points) + expect_true(!("r2" %in% points)) +}) + +test_that("First test in all passing testMain returns correct points", { + test_points <- .get_available_points(simple_all_tests_pass_project_path) + points <- test_points[["minus works"]] + expect_true("r2" %in% points) + expect_true("r2.1" %in% points) + expect_true(!("r1" %in% points)) +}) + + +test_that("run_available_points works and runs available_points", { + remove_old_available_points_json(simple_all_tests_pass_project_path) + + ##Call run_available_points + run_available_points(simple_all_tests_pass_project_path) + + ##Get the path to the supposed file. + available_points_path <- paste(sep = "", simple_all_tests_pass_project_path, "/.available_points.json") + + #Check that the file exists + expect_equal(T, file.exists(available_points_path)) +}) + +test_that("/.available_points.json has correct values", { + remove_old_available_points_json(simple_all_tests_pass_project_path) + + ##Call run_available_points + run_available_points(simple_all_tests_pass_project_path) + + ##Get the path to the supposed file. + available_points_path <- paste(sep = "", simple_all_tests_pass_project_path, "/.available_points.json") + + #Create json-object from .available_points.json. + json <- read_json(available_points_path) + + #Test that json has correct values. + expect_equal(names(json)[[1]], "ret_true works.") + expect_true(length(json[[1]]) > 0) +}) diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/testResultsCreator.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/testResultsCreator.R new file mode 100644 index 00000000000..0e4fd3c48b8 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/testResultsCreator.R @@ -0,0 +1,78 @@ +test_resources_dir <- paste(sep = "", getwd(), "/resources") + +#projects for testing: +simple_all_tests_fail_project_path <- paste(sep = "", test_resources_dir, "/simple_all_tests_fail") +simple_all_tests_pass_project_path <- paste(sep = "", test_resources_dir, "/simple_all_tests_pass") +simple_some_tests_fail_project_path <- paste(sep = "", test_resources_dir, "/simple_some_tests_fail") + +test_that("Test is reported to pass correctly", { + test_output <- .run_create_file_result_for_files(simple_all_tests_pass_project_path) + #All tests should return true: + for (test in test_output) { + expect_equal(test$status, "pass") + } +}) + +test_that("Test is reported to fail correctly", { + test_output <- .run_create_file_result_for_files(simple_all_tests_fail_project_path) + #All tests should return false + for (test in test_output) { + expect_equal(test$status, "fail") + } +}) + +test_that("Points are added correctly", { + expected_result <- c("r1.1", "r1.2", "r1") + name <- "point_testing" + points <- list() + points[[name]] <- c("r1.1", "r1.2") + file_point <- c("r1") + added_points <- .get_points_for_test(name, points, file_point) + for (point in expected_result) { + expect_equal(point %in% added_points, TRUE) + } + expect_equal(length(expected_result), length(added_points)) +}) + +test_that("Status is added correctly for passing tests", { + test_output <- .run_create_file_result_for_files(simple_all_tests_pass_project_path) + #All tests should be given pass: + for (test in test_output) { + expect_equal(test$status, "pass") + } +}) + +test_that("Status is added correctly for failing tests", { + test_output <- .run_create_file_result_for_files(simple_all_tests_fail_project_path) + for (test in test_output) { + expect_equal(test$status, "fail") + } +}) + +test_that("A message is given if the test fails", { + test_output <- .run_create_file_result_for_files(simple_all_tests_fail_project_path) + for (test in test_output) { + expect_true(test$message != "") + } +}) + +test_that("A message is not given if the test passes", { + test_output <- .run_create_file_result_for_files(simple_all_tests_pass_project_path) + for (test in test_output) { + expect_true(test$message == "") + } +}) + +test_that("A result is created correctly with status", { + results <- .run_create_file_result_for_files(simple_all_tests_pass_project_path) + for (result in results) { + expect_equal(result$status, "pass") + } +}) + +test_that("A result is created correctly with name", { + results <- .run_create_file_result_for_files(simple_all_tests_pass_project_path) + expect_equal(results[[1]]$name, "ret_true works.") + expect_equal(results[[2]]$name, "ret_one works.") + expect_equal(results[[3]]$name, "add works.") +}) diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/testRunTests.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/testRunTests.R new file mode 100644 index 00000000000..9b10a98a690 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/testRunTests.R @@ -0,0 +1,167 @@ +test_resources_dir <- paste(sep = "", getwd(), "/resources") + +#projects for testing: +simple_all_tests_pass_project_path <- paste(sep = "", test_resources_dir, "/simple_all_tests_pass") +simple_all_tests_pass_with_plot_project_path <- paste(sep = "", + test_resources_dir, + "/simple_all_tests_pass_with_plot") +simple_some_tests_fail_project_path <- paste(sep = "", test_resources_dir, "/simple_some_tests_fail") +simple_sourcing_fail_project_path <- paste(sep = "", test_resources_dir, "/simple_sourcing_fail") +simple_run_fail_project_path <- paste(sep = "", test_resources_dir, "/simple_run_fail") + +test_that("Test pass in simple_all_tests_pass", { + remove_old_results_json(simple_all_tests_pass_project_path) + test_results <- .run_tests_project(simple_all_tests_pass_project_path)$test_results + + #All tests should pass: + for (i in length(test_results)) { + expect_equal(test_results[[i]]$status, "pass") + } +}) + +#Tests that all exercise entrys store the point for all tests. +test_that("Tests that pass in simple_all_tests_pass all have the point for all tests", { + remove_old_results_json(simple_all_tests_pass_project_path) + test_results <- .run_tests_project(simple_all_tests_pass_project_path)$test_results + point <- "r1" + for (i in 1:3) { + vec1 <- test_results[[i]]$points + expect_true(point %in% vec1) + } +}) + +test_that(".run_tests_project adds points accordingly for simple_all_tests_pass", { + remove_old_results_json(simple_all_tests_pass_project_path) + test_results <- .run_tests_project(simple_all_tests_pass_project_path)$test_results + #"RetTrue works." points + expect_equal(test_results[[1]]$points, c("r1", "r1.1")) + #"RetOne works." points + expect_equal(test_results[[2]]$points, c("r1", "r1.2")) + #"Add works." points + expect_equal(test_results[[3]]$points, c("r1", "r1.3", "r1.4")) +}) + +test_that("run_tests create .results.json", { + remove_old_results_json(simple_all_tests_pass_project_path) + run_tests(simple_all_tests_pass_project_path) + expect_true(file.exists(paste(sep = "", simple_all_tests_pass_project_path, "/.results.json"))) +}) + +test_that("Not all tests pass in simple_some_tests_fail.", { + remove_old_results_json(simple_some_tests_fail_project_path) + test_results <- .run_tests_project(simple_some_tests_fail_project_path)$test_results + + #"RetTrue works." should pass + expect_equal(test_results[[1]]$status, "pass") + #"RetOne works." should pass + expect_equal(test_results[[2]]$status, "pass") + #"Add works." should pass + expect_equal(test_results[[3]]$status, "pass") + #"RetFalse returns true" should FAIL + expect_equal(test_results[[4]]$status, "fail") + #"RetTrue works but there asre no points." should pass + expect_equal(test_results[[5]]$status, "pass") +}) + +test_that("run_results returns and writes.results.json as expected for simple_some_tests_fail", { + remove_old_results_json(simple_some_tests_fail_project_path) + + run_results <- run_tests(simple_some_tests_fail_project_path) + test_results <- run_results$test_results + + results_json <- read_json(paste(sep = "", simple_some_tests_fail_project_path, "/.results.json")) + test_results_json <- results_json$testResults + + #expected results for simple_some_tests_fail + expected_test_result <- list() + expected_test_result[[1]] <- list(status = "pass", name = "ret_true works.", + message = "", backtrace = list(), points = list("r1", "r1.1")) + expected_test_result[[2]] <- list(status = "pass", name = "ret_one works.", + message = "", backtrace = list(), points = list("r1", "r1.2")) + expected_test_result[[3]] <- list(status = "pass", name = "add works.", + message = "", backtrace = list(), points = list("r1", "r1.3", "r1.4")) + #expected backtrace for 4th test: + backtrace_test4 <- list(paste0("1: expect_true(ret_false()) in ", simple_some_tests_fail_project_path, + "/tests/testthat/testMain.R#21")) + expected_test_result[[4]] <- list(status = "fail", name = "ret_false returns true", + message = "ret_false() isn't true.", + backtrace = backtrace_test4, points = list("r1", "r1.5")) + expected_test_result[[5]] <- list(status = "pass", name = "ret_true works but there are no points.", + message = "", backtrace = list(), points = list("r1")) + + #runStatus should be true and backtrace empty for .results.json + expect_equal(results_json$runStatus, "success") + expect_equal(results_json$backtrace, list()) + + #testResults is as expected for .results.json + for (i in 1:5) expect_equal(test_results_json[[i]], expected_test_result + [[i]]) + + #runStatus should be true and backtrace empty + expect_equal("success", run_results$run_status) + expect_equal(list(), run_results$backtrace) + + #test_results returns as expected + for (i in 1:5) { + expect_equal(test_results[[i]]$status, expected_test_result[[i]]$status) + expect_equal(test_results[[i]]$name, expected_test_result[[i]]$name) + expect_equal(test_results[[i]]$message, expected_test_result[[i]]$message) + expect_equal(test_results[[i]]$backtrace, expected_test_result[[i]]$backtrace) + expect_equal(as.list(test_results[[i]]$points), expected_test_result[[i]]$points) + } +}) + +test_that("RunTests does print on print = TRUE", { + remove_old_results_json(simple_all_tests_pass_project_path) + #simple_all_tests_pass prints as expected + expect_output(run_tests(simple_all_tests_pass_project_path, print = TRUE), + "ret_true works.: pass\nret_one works.: pass\nadd works.: pass") +}) + +test_that("RunTests doesn't print on print = FALSE", { + remove_old_results_json(simple_all_tests_pass_project_path) + expect_silent(run_tests(simple_all_tests_pass_project_path, print = FALSE)) +}) + +test_that("Sourcing fail handled accordingly.", { + remove_old_results_json(simple_sourcing_fail_project_path) + + run_tests(simple_sourcing_fail_project_path) + results_json <- read_json(paste(sep = "", simple_sourcing_fail_project_path, "/.results.json")) + + #runStatus whould be "sourcing_failed", backtrace empty and testResults empty + expect_equal(results_json$runStatus, "sourcing_failed") + expect_equal(results_json$testResults, list()) + + #Backtrace should contain correct error: + expect_true(grepl(":7:9: unexpected 'in'",results_json$backtrace[[1]])) + expect_equal("6: ret_one <- function() {", results_json$backtrace[[2]]) + expect_equal("7: error in", results_json$backtrace[[3]]) + expect_equal(" ^", results_json$backtrace[[4]]) +}) + +test_that("Run fail handled accordingly.", { + remove_old_results_json(simple_run_fail_project_path) + + run_tests(simple_run_fail_project_path) + results_json <- read_json(paste(sep = "", simple_run_fail_project_path, "/.results.json")) + + #runStatus whould be "run_fail" and testResults empty + expect_equal(results_json$runStatus, "run_failed") + expect_equal(results_json$testResults, list()) + + #Backtrace should contain correct error: + expect_true(grepl(":9:3: unexpected 'in'",results_json$backtrace[[1]])) + expect_equal("8: #Produces run fail:", results_json$backtrace[[2]]) + expect_equal("9: in", results_json$backtrace[[3]]) + expect_equal(" ^", results_json$backtrace[[4]]) +}) + +test_that("Test pass with overriden functions", { + remove_old_results_json(simple_all_tests_pass_with_plot_project_path) + test_results <- .run_tests_project(simple_all_tests_pass_with_plot_project_path)$test_results + #All tests should pass: + for (i in length(test_results)) { + expect_equal(test_results[[i]]$status, "pass") + } +}) diff --git a/plugins/r/tests/tmcRtestrunner/tests/testthat/testTestEnvironment.R b/plugins/r/tests/tmcRtestrunner/tests/testthat/testTestEnvironment.R new file mode 100644 index 00000000000..303d43f916b --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tests/testthat/testTestEnvironment.R @@ -0,0 +1,34 @@ +test_resources_dir <- paste(sep = "", getwd(), "/resources") + +#projects for testing: +simple_all_tests_pass_project_path <- paste(sep = "", test_resources_dir, "/simple_all_tests_pass") +simple_all_tests_pass_project_path_with_plot <- paste(sep = "", + test_resources_dir, + "/simple_all_tests_pass_with_plot") + +test_that("test_env is created correctly for simple_all_tests_pass", { + test_env <- .create_test_env(simple_all_tests_pass_project_path) + + #Test functions should exist: + expect_true(exists("test", where = test_env, mode = "function")) + expect_true(exists("points_for_all_tests", where = test_env, mode = "function")) + + #Functions from main.R and second.R should exist: + expect_true(exists("ret_true", where = test_env, mode = "function")) + expect_true(exists("ret_one", where = test_env, mode = "function")) + expect_true(exists("add", where = test_env, mode = "function")) + expect_true(exists("minus", where = test_env, mode = "function")) +}) + +test_that("plot is overwriten in test_env", { + test_env <- .create_test_env(simple_all_tests_pass_project_path_with_plot) + mock_path <- paste(sep = .Platform$file.sep, + simple_all_tests_pass_project_path_with_plot, + "tests", "testthat", "mock.R") + + expect_true(file.exists(mock_path)) + expect_true(exists("plot", where = test_env, mode = "function")) + expect_true(exists("used_plot_args", where = test_env)) + expect_true(exists("paste", where = test_env, mode = "function")) + expect_true(exists("used_paste_args", where = test_env)) +}) diff --git a/plugins/r/tests/tmcRtestrunner/tmcRtestrunner.Rproj b/plugins/r/tests/tmcRtestrunner/tmcRtestrunner.Rproj new file mode 100644 index 00000000000..497f8bfcfb9 --- /dev/null +++ b/plugins/r/tests/tmcRtestrunner/tmcRtestrunner.Rproj @@ -0,0 +1,20 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +AutoAppendNewline: Yes +StripTrailingWhitespace: Yes + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source