Merge pull request #79 from MansMeg/testthat_0_12_fix

Testthat 1.0.0 fixes

DESCRIPTION

@@ -1,22 +1,31 @@
 Package: markmyassignment
 Type: Package
 Title: Automatic Marking of R Assignments
-Version: 0.5.0
-Date: 2016-03-16
+Version: 0.6.0
+Date: 2016-04-15
 Author: Mans Magnusson, Oscar Pettersson
 Maintainer: Mans Magnusson <mons.magnusson@gmail.com>
 Description: Automatic marking of R assignments for students and teachers based
     on 'testthat' test suites.
 License: BSD_2_clause + file LICENSE
-Depends: 
-    R (>= 3.1.0),
+Depends:
+    R (>= 3.2.0),
     methods,
     yaml,
-    testthat (>= 0.11.0),
+    testthat (>= 1.0.0),
     httr (>= 1.0.0)
-Imports: 
-    codetools
+Imports:
+    codetools,
+    lazyeval
 RoxygenNote: 5.0.1
-Suggests: knitr,
+Suggests:
+    knitr,
     rmarkdown
 VignetteBuilder: knitr
+Collate:
+    'assertion_funcions.R'
+    'expectations.R'
+    'mark_my_assignment.R'
+    'mark_my_file.R'
+    'markmyassignment.R'
+    'set_assignment.R'

NAMESPACE

@@ -1,20 +1,16 @@
 # Generated by roxygen2: do not edit by hand
 
-export(StudentReporter)
+export(expect_attached_package)
 export(expect_function_arguments)
 export(expect_function_code)
+export(expect_function_self_contained)
 export(expect_package)
 export(expect_self_contained)
-export(function_code)
-export(has_function_arguments)
-export(is_self_contained)
 export(mark_my_assignment)
 export(mark_my_dir)
 export(mark_my_file)
 export(set_assignment)
 export(show_tasks)
-export(use_package)
-exportClasses(StudentReporter)
 import(httr)
 import(methods)
 import(testthat)

R/expectations.R

@@ -17,40 +17,31 @@
 #' @keywords internal
 #' 
 #' @export
+expect_function_self_contained <- function(object, info = NULL, label = NULL) {
+  lab <- make_label(object, label)
 
-expect_self_contained <- function(object, info = NULL, label = NULL) {
-  if (is.null(label)) {
-    label <- find_expr("object")
+  global_vars <- codetools::findGlobals(object, merge = F)$variables
+
+  if(length(global_vars)==0){
+    testthat::succeed()
+  } else {
+    msg <- sprintf("%s contain global variable(s): %s.", lab, paste(global_vars, collapse = " "))
+    testthat::fail(paste0(msg, info))
   }
-  expect_that(object, is_self_contained() , info = info, label = label)
+
+  invisible(object)
 }
 
-#' @title
-#' Function is self contained test
+#' @title Depricated function: expect_self_contained
 #' 
-#' @description
-#' Tests if a function is self contained (no global variables)
-#' 
-#' @param expected
-#'   Function to test if it is self contained.
+#' @description Function has been depricated and will be removed. Please use \code{\link{expect_function_self_contained}} instead.
 #' 
 #' @keywords internal
-#' 
 #' @export
-is_self_contained <- 
-  function (expected) 
-  {
-    function(actual) {
-      self <- list()
-      self$global_vars <- codetools::findGlobals(actual, merge = F)$variables
-      self$self_contained <- length(self$global_vars) == 0
-      expectation(self$self_contained, 
-                  paste0("contains global variable(s): ", 
-                         paste(self$global_vars, collapse = ", ")), 
-                  "is self contained.")
-    }
-  }
-
+expect_self_contained <- function(object, info = NULL, label = NULL){
+  .Deprecated("expect_function_self_contained")
+  expect_function_self_contained(object, info, label)
+}
 
 
 #' @title
@@ -61,48 +52,43 @@ is_self_contained <-
 #' 
 #' @param object
 #'   Package to check for.
-#' @param label
-#'   For full form, label of expected object used in error messages. 
-#'   Useful to override default (deparsed expected expression) when doing 
-#'   tests in a loop. For short cut form, object label. When NULL, computed from 
-#'   deparsed object.
 #' @param info 
 #'   Extra information to be included in the message (useful when writing tests in loops).
 #' 
 #' @keywords internal
 #' 
 #' @export
-expect_package <- function(object, info = NULL, label = NULL){
-  if (is.null(label)) {
-    label <- find_expr("object")
+expect_attached_package <- function(object, info = NULL){
+
+  if(any(grepl(object, search()))){
+    testthat::succeed()
+  } else {
+    msg <- sprintf("%s is not used.", object)
+    testthat::fail(paste0(msg, info))
   }
-  expect_that(object, use_package() , info = info, label = label)
+
+  invisible(object)
 }
 
-#' @title
-#' Package is used test
+#' @title Depricated function: expect_package
 #' 
-#' @description
-#'    test if a packages is loaded.
+#' @description Function has been depricated and will be removed. Please use \code{\link{expect_attached_package}} instead.
 #' 
 #' @keywords internal
-#' 
 #' @export
-use_package <- 
-  function(){
-    function(pkg) {
-      expectation(any(grepl(pkg, search())), 
-                  paste0("package '", pkg,"' is not used"), 
-                  paste0("package '", pkg,"' is used"))
-    }
-  }
+expect_package <- function(object, info = NULL, label = NULL){
+  .Deprecated("expect_attached_package")
+  expect_attached_package(object, info)
+}
+
+
 
 
 #' @title
 #' Expect function arguments
 #' 
 #' @description
-#'  Test that an object with a given name exist in the environment.
+#'  Test that an function object has a function with given arguments.
 #' 
 #' @param object
 #'   Function to check the arguments of.
@@ -120,45 +106,28 @@ use_package <-
 #' @keywords internal
 #' 
 #' @export
-expect_function_arguments <- 
-  function(object, expected, info = NULL, label = NULL, expected.label = NULL) 
-{
-  if (is.null(label)) {
-    label <- find_expr("object")
+expect_function_arguments <- function(object, expected, info = NULL, label = NULL, expected.label = NULL) {
+
+  lab_obj <- make_label(object, label)
+  lab_exp <- make_label(expected, expected.label)
+
+  function_arguments <- names(formals(object))
+  missing_arguments <- !function_arguments %in% expected
+  extra_arguments <- !expected %in% function_arguments
+
+  if(!(any(missing_arguments) | any(extra_arguments))){
+    testthat::succeed()
+  } else {
+    msg <- sprintf("%s contain arguments: %s, not %s", 
+                   lab_obj, 
+                   paste(function_arguments, collapse = " "), 
+                   lab_exp)
+    testthat::fail(paste0(msg, info))
   }
-  expect_that(object, 
-              has_function_arguments(expected, label = expected.label), 
-              info = info, label = label)
+
+  invisible(object)
 }
 
-#' @title
-#' Function has argument test
-#' 
-#' @description
-#'  Test if a function has the given arguments
-#' 
-#' @param expected
-#'   Arguments as text vector to test for.
-#' @param label
-#'   Expectation label used by \code{expect_function_arguments()}
-#' 
-#' @keywords internal
-#' 
-#' @export
-has_function_arguments <- 
-  function (expected, label = NULL) 
-  {
-    function(actual) {
-      self <- list()
-      self$formals <- names(formals(actual))
-      self$missing <- !self$formals %in% expected
-      expectation(all(expected %in% self$formals),
-                  failure_msg = paste0(paste(expected[self$missing], collapse = ", "), 
-                                       " is missing"),
-                  success_msg = "all arguments exist")
-    }
-  }
-
 
 #' @title
 #' Expect function contain code
@@ -167,7 +136,7 @@ has_function_arguments <-
 #'  Test that a given code code exists in function
 #' 
 #' @param object
-#'   Function to check the body
+#'   Function to check for mandatory code
 #' @param expected
 #'   Expected arguments in function.
 #' @param label
@@ -185,64 +154,48 @@ has_function_arguments <-
 expect_function_code <- 
   function(object, expected, info = NULL, label = NULL, expected.label = NULL) 
   {
-    if (is.null(label)) {
-      label <- find_expr("object")
+
+    lab_obj <- make_label(object, label)
+    lab_exp <- make_label(expected, expected.label)
+
+    body <- as.character(body(object))
+
+    if(any(grepl(x = body, pattern = expected))){
+      testthat::succeed()
+    } else {
+      paste0("'", expected, "' not found in function body.")
+      msg <- sprintf("%s not found in the body of %s", 
+                     lab_exp, 
+                     lab_obj)
+      testthat::fail(paste0(msg, info))
     }
-    expect_that(object, 
-                function_code(expected, label = expected.label), 
-                info = info, label = label)
+
+    invisible(object)
   }
 
-#' @title
-#' Function contain code test
-#' 
-#' @description
-#'    Test if function code contains a given text string.
-#' @param expected
-#'   Pattern to test for in function code.
-#' @param label
-#'   Expectation label used by \code{expect_function_code()}
-#'   
-#' @keywords internal
-#'   
-#' @export
-function_code <- 
-  function (expected, label = NULL) 
-  {
-    function(actual) {
-      self <- list()
-      self$body <- as.character(body(actual))
-      expectation(any(grepl(x = self$body, pattern = expected)),
-                  failure_msg = paste0("'", expected, "' not found in function body."),
-                  success_msg = paste0("'", expected, "' in function body."))
-    }
-  }
 
+# Functions taken from testthat package (that is not exported)
 
-#' @title
-#' Expect tidy format (to be constructed)
-#' 
-#' @description
-#' Test that the format used in a function is tidy (see formatR)
-#' 
-#' @keywords internal
-#' 
-expect_tidy_code <- function(){}
-
+make_label <- function(object, label = NULL) {
+  label %||% label(object)
+}
 
+label <- function(obj) {
+  x <- lazyeval::lazy(obj)$expr
+
+  if (is.character(x)) {
+    encodeString(x, quote = '"')
+  } else if (is.atomic(x)) {
+    format(x)
+  } else if (is.name(x)) {
+    paste0("`", as.character(x), "`")
+  } else {
+    chr <- deparse(x)
+    if (length(chr) > 1) {
+      chr <- paste(deparse(as.call(list(x[[1]], quote(...)))), collapse = "\n")
+    }
+    chr
+  }
+}
 
-#' @title
-#' Internal function (taken from testthat)
-#' 
-#' @description
-#' Internal function (taken from testthat)
-#' 
-#' @param name See \code{testthat:::find_expr()}.
-#' @param env See \code{testthat:::find_expr()}.
-#' 
-#' @keywords internal
-#' 
-find_expr <- function(name, env = parent.frame()){
-  subs <- do.call("substitute", list(as.name(name), env))
-  paste0(deparse(subs, width.cutoff = 500), collapse = "\n")
-}
+`%||%` <- function(a, b) if (is.null(a)) b else a

R/mark_my_assignment.R

@@ -249,6 +249,13 @@ get_mark_my_reporter <-function(){
   assign_yml <- read_assignment_yml()
   if("reporter" %in% names(assign_yml)){
     reporter <- assign_yml$reporter
+    output <- capture_output(
+      check_reporter <- try(test_file(path = file.path(system.file(package = "markmyassignment"), "extdata/test_reporter_file.R"), reporter = reporter), silent = TRUE)
+    )
+    if(inherits(check_reporter, what = "try-error")) {
+      warning("Reporter '", reporter, "' not found. Summary reporter is used.")
+      reporter <- "summary"
+      }
   } else {
     reporter <- "summary"
   }