tmcRtestrunner to owntestmethod

.gitignore

@@ -3,3 +3,4 @@
 .RData
 .Ruserdata
 .DS_Store
+tmcRtestrunner.Rcheck/

example_projects/example_project1/tests/testthat/testArithmetics.R

@@ -4,7 +4,7 @@ source("../../R/arithmetics.R")
 
 pointsForAllTests(c("r1"))
 
-test("Addition works", c("r1.1","r1.2"), {
+test("Addition works", c("r1.1", "r1.2"), {
   expect_equal(add(1, 2), 3)
   expect_equal(add(1, 2), 3.0)
   expect_equal(add(1, 4), 5)

example_projects/example_project1/tmc_run_test_example.sh

@@ -1,3 +1,4 @@
 #!/bin/sh
 #Currently this script needs to be run at project root!
-Rscript tmc/result.R
+
+Rscript -e "library(tmcRtestrunner);runTests(\"$PWD\", print=TRUE)"

tmcRtestrunner/DESCRIPTION

@@ -12,3 +12,8 @@ LazyData: true
 Depends:
   testthat,
   jsonlite
+Collate:
+  'ResultsJsonParser.R'
+  'TestthatResultReader.R'
+  'RunTests.R'
+  'getAvailablePoints.R'

tmcRtestrunner/R/ResultsJsonParser.R

@@ -0,0 +1,72 @@
+#Creates JSON based on the test file.
+.CreateJsonResults <- function(testthatOutput) {
+  results = list()
+  for (test in testthatOutput) {
+    testName <- test$test
+    testPoints <- test$points
+    testMessage <- ""
+
+    if (.CheckIfTestPassed(test)) {
+      testStatus <- "pass"
+    } else {
+      testStatus <- "fail"
+      testMessage <- .CreateMessageForTestWithFailures(test)
+    }
+
+    testResult <- .CreateJsonTestResult(testStatus, testName, testMessage,testPoints, "")
+    #Add test result to results
+    results[[length(results)+1]] <- testResult
+  }
+  return (results)
+}
+
+#Creates JSON for each different test case.
+.CreateJsonTestResult <- function(testStatus, testName, testMessage,
+                                  testPoints, backtrace) {
+  testResult <- list(status=unbox(testStatus),
+                     name=unbox(format(testName)),
+                     message=unbox(testMessage),
+                     backtrace=unbox(backtrace),
+                     points=testPoints)
+  return(testResult)
+}
+
+#Returns message from failed results
+#Currently supports only results that used calls
+.MessageFromFailedResult <- function(result) {
+  if (is.null(result$call)) {
+    return("")
+  }
+  #language that failed the test. for example call expect_equal(1,2)
+  language <- toString(result$call[[1]])
+  return (paste(sep="", "Failed with call: ", language,"\n", result$message))
+}
+
+.CreateMessageForTestWithFailures <- function(test) {
+  testMessage <- ""
+  for (result in test$results) {
+    if (format(result) != "As expected") {
+      testMessage <- paste(sep = "", testMessage, .MessageFromFailedResult(result))
+    }
+  }
+  return(testMessage)
+}
+
+#Writes JSON based on the whole test result.
+.WriteJson <- function(results) {
+  #json utf-8 coded:
+  json <- enc2utf8(toJSON(results, pretty = FALSE))
+  json <- prettify(json)
+  #encode json to utf-8 and write file
+  write(json, ".results.json")
+}
+
+#Prints results.
+.PrintResultsFromJson <- function(jsonResult) {
+  for (test in jsonResult) {
+    cat(sep = "", test$name, ": ", test$status, "\n")
+    if (test$message != "") {
+      cat(sep = "", "\n", test$message, "\n")
+    }
+  }
+}

tmcRtestrunner/R/RunTests.R

@@ -1,144 +1,64 @@
-runTests <- function(project_path, print = FALSE) {
-  # Runs the tests from project directory and writes results JSON to the root of the project
-  # as .tmc_results.json.
-  #
-  # Args:
-  #  project_path: The path to the root of the project being tested.
-  #  print: If TRUE, prints results; if not, not. DEFAULT is FALSE.
-  #
-  library('testthat')
-  library('jsonlite')
+# Runs the tests from project directory and writes results JSON to the root of the project
+# as .tmc_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.
+#
+runTests <- function(projectPath, print=FALSE) {
+  tmcrTestRunnerProjectPath <- getwd()
+
+  #runs test for project, returns testthatOuput with added points.
+  testthatOutput <- .RunTestsProject(projectPath)
+
+  jsonResults <- .CreateJsonResults(testthatOutput)
+  .WriteJson(jsonResults)
+
+  if (print) {
+    .PrintResultsFromJson(jsonResults)
+  }
 
-  tmcrtestrunnet_project_path <- getwd()
-  setwd(project_path)
+  setwd(tmcrTestRunnerProjectPath)
+}
 
-  #declaring variables to global environment that for example helperTMC.R can use
-  points <- list()
-  points_for_all_tests <- list()
+.RunTestsProject <- function(projectPath) {
+  setwd(projectPath)
 
   testthatOutput <- list()
 
   #Lists all the files in the path beginning with "test" and ending in ".R"
   testFiles <- list.files(path="tests/testthat", pattern = "test.*\\.R", full.names = T, recursive = FALSE)
+
   for (testFile in testFiles) {
-    testFileOutput <- test_file(testFile, reporter = "silent")
-    #Modifies the points because they were added to all the tests.
-    points <- .AddPointsToAllTests(testFileOutput)
-    #Adds the output from the tests in the file to the list
+    testFileOutput <- .RunTestsFile(testFile)
     testthatOutput <- c(testthatOutput, testFileOutput)
   }
-
-.CreateResults <- function(testthatOutput) {
-    results = list()
-    for (test in testthatOutput) {
-      testName <- test$test
-      testPoints <- .GetTestPoints(testName)
-      testFailed <- FALSE
-      testStatus <- "passed"
-      testMessage <- ""
-      for (result in test$results) {
-        if (format(result) != "As expected") {
-          testFailed <- TRUE
-          testStatus <- "failed"
-          testMessage <- paste(sep = "", testMessage, .MessageFromFailedResult(result))
-        }
-      }
-      .PrintResult(testName, testMessage, testFailed)
-      testResult <- .CreateTestResult(testStatus, testName, testMessage,testPoints, "")
-      #Add test result to results
-      results[[length(results)+1]] <- testResult
-    }
-    return (results)
-  }
-
-
-  results <- .CreateResults(testthatOutput)
-
-  #json utf-8 coded:
-  json <- enc2utf8(toJSON(results, pretty = FALSE))
-  json <- prettify(json)
-
-  #encode json to utf-8 and write file
-  write(json, ".results.json")
-
-  #restore project path:
-  setwd(tmcrtestrunnet_project_path)
+  return(testthatOutput)
 }
 
-#Checks if a single test passed
-.CheckIfResultCorrect <- function(test) {
-  ret <- TRUE
-  for (result in test$results) {
-    if (format(result) != "As expected") {
-      ret <- FALSE
-      break
-    }
-  }
-  return (ret)
-}
+.RunTestsFile <- function(filePath) {
+  .GlobalEnv$points <- list()
+  .GlobalEnv$points_for_all_tests <- list()
 
-#Checks whether all the tests in a single file passed
-.CheckThatAllPassed <- function(test_output) {
-  ret <- TRUE
-  for (test in test_output) {
-    if (!.CheckIfResultCorrect(test)) {
-      ret <- FALSE
-      break
-    }
-  }
-  return (ret)
-}
+  testFileOutput <- test_file(filePath, reporter = "silent")
+  testFileOutput <- .AddPointsToTestOutput(testFileOutput)
 
-#Adds the points from a single test file to all the tests in the file
-#returns points list, so that the modified points list is updated
-.AddPointsToAllTests <- function(test_output) {
-  for (test in test_output) {
-    if (!(points_for_all_tests %in% points[[test$test]])) {
-      points[[test$test]] <- c(points[[test$test]], points_for_all_tests)
-    }
-  }
-  return (points)
+  return(testFileOutput)
 }
 
-.PrintResult <- function(name, message, failed) {
-  if (failed) {
-    print(paste(name, ": FAIL", sep = ""))
-    print(paste("   ", message, sep = ""))
-  } else {
-    print(paste(name, ": PASS", sep = ""))
+.AddPointsToTestOutput <- function(testOutput) {
+  for (i in 1 : length(testOutput)) {
+    testOutput[[i]]$points <- .GetTestPoints(testOutput[[i]]$test)
   }
+  return(testOutput)
 }
 
-#Returns message from failed results
-#Currently supports only results that used calls
-.MessageFromFailedResult <- function(result) {
-  if (is.null(result$call)) {
-    return("")
-  }
-  #language that failed the test. for example call expect_equal(1,2)
-  language <- toString(result$call[[1]])
-  return (paste(sep="", "Failed with call: ", language,"\n", result$message))
-}
-
-#Returns the points of a test or an empty vector if null
 .GetTestPoints <- function(testName) {
   if (is.null(points[[testName]])) {
-    return(vector())
+    testPoints <- vector()
   } else {
-    return(points[[testName]])
+    testPoints <- points[[testName]]
   }
-}
-
-.CreateTestResult <- function(testStatus, testName, testMessage,
-                             testPoints, backtrace) {
-  testResult <- list(status=unbox(testStatus),
-                     name=unbox(format(testName)),
-                     message=unbox(testMessage),
-                     backtrace=unbox(backtrace),
-                     points=testPoints)
-  return(testResult)
-}
-
-DummyFunction <- function() {
-  return(TRUE)
+  testPoints <- c(.GlobalEnv$points_for_all_tests, testPoints)
+  return(testPoints)
 }

tmcRtestrunner/R/TestthatResultReader.R

@@ -0,0 +1,28 @@
+#Checks if all tests pass in testOutput
+.CheckAllTestPassed <- function(testOutput) {
+  ret <- TRUE
+  for (test in testOutput) {
+    if (!.CheckIfTestPassed(test)) {
+      ret <- FALSE
+      break
+    }
+  }
+  return (ret)
+}
+
+#Checks if a single test passed
+.CheckIfTestPassed <- function(test) {
+  ret <- TRUE
+  for (result in test$results) {
+    if (!.CheckIfResultPassed(result)) {
+      ret <- FALSE
+      break
+    }
+  }
+  return (ret)
+}
+
+#Check if a single result passed
+.CheckIfResultPassed <- function(result) {
+  return(format(result) == "As expected")
+}

tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/.results.json

@@ -0,0 +1,34 @@
+[
+    {
+        "status": "pass",
+        "name": "RetTrue works.",
+        "message": "",
+        "backtrace": "",
+        "points": [
+            "r1",
+            "r1.1"
+        ]
+    },
+    {
+        "status": "pass",
+        "name": "RetOne works.",
+        "message": "",
+        "backtrace": "",
+        "points": [
+            "r1",
+            "r1.2"
+        ]
+    },
+    {
+        "status": "pass",
+        "name": "Add works.",
+        "message": "",
+        "backtrace": "",
+        "points": [
+            "r1",
+            "r1.3",
+            "r1.4"
+        ]
+    }
+]
+

tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/R/main.R

@@ -0,0 +1,11 @@
+RetTrue <- function() {
+  return(TRUE)
+}
+
+RetOne <- function() {
+  return(1)
+}
+
+Add <- function(a, b) {
+  return(a + b)
+}

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

tmcRtestrunner/tests/testthat/resources/simple_all_tests_pass/tests/testthat/helperTMC.R

@@ -0,0 +1,13 @@
+
+#Sets the points for all tests to global environment, wherefrom they can
+#be retrieved.
+pointsForAllTests <- function(points) {
+  .GlobalEnv$points_for_all_tests <- points
+}
+
+#The test that wraps around test_that()-method and stores the points
+#to global environment.
+test <- function(desc, points, code) {
+  .GlobalEnv$points[[desc]] <- points
+  test_that(desc, code)
+}