From 25a9e3552cb8a8e63d8f1d3e665aef718b824453 Mon Sep 17 00:00:00 2001
From: Richard Beare <richard.beare@monash.edu>
Date: Sat, 31 Aug 2019 17:02:46 +1000
Subject: [PATCH] ENH R abstract_access_runme

Improved the exception handling components of test.
---
 Examples/test-suite/r/abstract_access_runme.R | 30 +++++++++++++++++--
 1 file changed, 27 insertions(+), 3 deletions(-)

diff --git a/Examples/test-suite/r/abstract_access_runme.R b/Examples/test-suite/r/abstract_access_runme.R
index 1e73dcabf..f6fb4099d 100644
--- a/Examples/test-suite/r/abstract_access_runme.R
+++ b/Examples/test-suite/r/abstract_access_runme.R
@@ -11,15 +11,27 @@ unittest(1, dd$do_x())
 ## Original version allowed dd$z <- 2
 tryCatch({
     dd$z <- 2
+    # force an error if the previous line doesn't raise an exception
+    stop("Test Failure A")
 }, error = function(e) {
+    if (e$message == "Test Failure A") {
+      # Raise the error again to cause a failed test
+      stop(e)
+    }
     message("Correct - no dollar assignment method found")
 }
 )
 
 tryCatch({
     dd[["z"]] <- 2
+    # force an error if the previous line doesn't raise an exception
+    stop("Test Failure B")
 }, error = function(e) {
-    message("Correct - no dollar assignment method found")
+  if (e$message == "Test Failure B") {
+    # Raise the error again to cause a failed test
+    stop(e)
+  }
+  message("Correct - no dollar assignment method found")
 }
 )
 
@@ -37,14 +49,26 @@ tryCatch({
 ## to fail above.
 tryCatch({
     m2 <- getMethod('$<-', "_p_A")
+    # force an error if the previous line doesn't raise an exception
+    stop("Test Failure C")
 }, error = function(e) {
-    message("Correct - no dollar assignment method found")
+  if (e$message == "Test Failure C") {
+    # Raise the error again to cause a failed test
+    stop(e)
+  }
+  message("Correct - no dollar assignment method found")
 }
 )
 
 tryCatch({
     m3 <- getMethod('[[<-', "_p_A")
+    # force an error if the previous line doesn't raise an exception
+    stop("Test Failure D")
 }, error = function(e) {
-    message("Correct - no list assignment method found")
+  if (e$message == "Test Failure D") {
+    # Raise the error again to cause a failed test
+    stop(e)
+  }
+  message("Correct - no list assignment method found")
 }
 )