working reporter with payload like ipython_nose

Author: machow

R-projects-test-example.ipynb

@@ -26,16 +26,12 @@
   },
   {
    "cell_type": "code",
-   "execution_count": 93,
+   "execution_count": null,
    "metadata": {},
    "outputs": [],
    "source": [
     "library(testthat)\n",
     "\n",
-    "comm <- IRkernel::comm_manager()$new_comm('dc_project')\n",
-    "comm$open()\n",
-    "comm$send(list(a = 'hey'))\n",
-    "\n",
     "ProjectReporter <- R6::R6Class(\"ProjectReporter\", inherit = testthat::ListReporter,\n",
     "  public = list(\n",
     "    all_tests = NULL,\n",
@@ -45,45 +41,89 @@
     "      self$comm <- comm\n",
     "      self$all_tests = testthat:::Stack$new()\n",
     "    },\n",
-    "    end_test = function(context, test) {\n",
-    "      out_env <- super$end_test(context, test)\n",
-    "      jsonable <- lapply(out_env$as_list(), `[`, c('message', 'test'))\n",
-    "      self$comm$send(jsonable)\n",
-    "      out_env\n",
-    "      #assign('output', out, envir=globalenv())\n",
-    "      \n",
+    "    get_results = function() {\n",
+    "        test_res <- lapply(self$results$as_list(),\n",
+    "                           self$dump_test)\n",
+    "        test_df <- data.frame(do.call(rbind, test_res))\n",
+    "        \n",
+    "        # summarize number of tests, etc..\n",
+    "        summary <- list(\n",
+    "                tests = length(test_res),\n",
+    "                failures = sum(test_df$outcome == 'fail'),\n",
+    "                errors = sum(test_df$outcome == 'error')\n",
+    "                )\n",
+    "\n",
+    "        payload <- list(\n",
+    "                success = all(as.logical(test_df$success)),\n",
+    "                summary = summary,\n",
+    "                tests = test_res\n",
+    "                )\n",
+    "        \n",
+    "        self$comm$send(payload)\n",
+    "\n",
+    "        payload\n",
+    "    },\n",
+    "    dump_test = function(test) {\n",
+    "        message <- paste(\n",
+    "            lapply(test$results, `[[`, 'message'),\n",
+    "            collapse = '\\n')\n",
+    "\n",
+    "        res <- testthat:::sumarize_one_test_results(test)\n",
+    "        success <- !any(res$failed, res$error)\n",
+    "        # figure out outcome, e.g. for counting errors later\n",
+    "        if (!success) {\n",
+    "            outcome <- if (res$failed) 'fail' else 'error'\n",
+    "        } else outcome <- 'success'\n",
+    "\n",
+    "        list(name = test$test,\n",
+    "             message = message,\n",
+    "             success = !any(res$failed, res$error),\n",
+    "             outcome = outcome)\n",
     "    }\n",
     "  ),\n",
     "  private = list(\n",
     "  )\n",
-    ")"
+    ")\n",
+    "\n",
+    ".run_tests <- function(test_expr) {\n",
+    "    comm <- IRkernel::comm_manager()$new_comm('dc_project')\n",
+    "    comm$open()\n",
+    "\n",
+    "    reporter <- ProjectReporter$new(comm = comm)\n",
+    "    reporter$start_file('some name')\n",
+    "    env = test_env()\n",
+    "    tests <- substitute(test_expr)\n",
+    "    with_reporter(\n",
+    "        reporter = reporter, start_end_reporter = TRUE,\n",
+    "        eval(tests, envir = env)\n",
+    "        )\n",
+    "    reporter\n",
+    "}"
    ]
   },
   {
    "cell_type": "code",
-   "execution_count": 94,
+   "execution_count": null,
    "metadata": {},
    "outputs": [],
    "source": [
-    "reporter <- ProjectReporter$new(comm = comm)\n",
-    "env = test_env()\n",
-    "reporter$start_file('some name')\n",
-    "with_reporter(reporter = reporter, start_end_reporter = TRUE,\n",
-    "    eval(\n",
-    "        {\n",
-    "            test_that(\"a passing test\", {\n",
-    "                expect_equal(2, 2)\n",
-    "                expect_equal(3, 3)\n",
-    "            })\n",
-    "        \n",
-    "            test_that(\"a failing test\", {\n",
-    "                expect_equal(2, 3)\n",
-    "                expect_equal(3, 4)\n",
-    "            })\n",
-    "        },\n",
-    "        envir = env\n",
-    "    )\n",
-    ")\n"
+    "out <- .run_tests({\n",
+    "    test_that(\"a passing test\", {\n",
+    "        expect_equal(2, 2)\n",
+    "        expect_equal(3, 3)\n",
+    "    })\n",
+    "\n",
+    "    test_that(\"a failing test\", {\n",
+    "        expect_equal(2, 3)\n",
+    "        expect_equal(3, 4)\n",
+    "    })\n",
+    "    \n",
+    "    test_that(\"an erroring test\", {\n",
+    "        stopifnot(FALSE)\n",
+    "        expect_equat(2, 2)\n",
+    "    })\n",
+    "})\n",
+    "out$get_results()"
    ]
   }
  ],