Add tests

Author: jimhester

inst/unitTests/cpp/exceptions.cpp

@@ -0,0 +1,56 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// dates.cpp: Rcpp R/C++ interface class library -- Date + Datetime tests
+//
+// Copyright (C) 2010 - 2013   Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#include <Rcpp.h>
+using namespace Rcpp;
+
+// [[Rcpp::export]]
+double takeLog(double val) {
+    if (val <= 0.0) {
+        throw std::range_error("Inadmissible value");
+    }
+    return log(val);
+}
+
+// [[Rcpp::export]]
+double takeLogRcpp(double val) {
+    if (val <= 0.0) {
+        throw Rcpp::exception("Inadmissible value");
+    }
+    return log(val);
+}
+
+// [[Rcpp::export]]
+double takeLogRcppLocation(double val) {
+    if (val <= 0.0) {
+        throw Rcpp::exception("Inadmissible value", "exceptions.cpp", 44);
+    }
+    return log(val);
+}
+
+double f1(double val) {
+    return takeLogRcppLocation(val);
+}
+
+// [[Rcpp::export]]
+double takeLogNested(double val) {
+    return f1(val);
+}

inst/unitTests/runit.exceptions.R

@@ -0,0 +1,95 @@
+#!/usr/bin/env r
+# -*- mode: R; tab-width: 4; -*-
+#
+# Copyright (C) 2010 - 2013  Dirk Eddelbuettel and Romain Francois
+#
+# This file is part of Rcpp.
+#
+# Rcpp is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# Rcpp is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+    .setUp <- Rcpp:::unitTestSetup("exceptions.cpp")
+
+test.stdException <- function() {
+
+  # Code works normally without an exception
+  checkIdentical(takeLog(1L), log(1L))
+
+  # C++ exceptions are converted to R conditions
+  condition <- tryCatch(takeLog(-1L), error = identity)
+
+  checkIdentical(condition$message, "Inadmissible value")
+  checkIdentical(class(condition), c("std::range_error", "C++Error", "error", "condition"))
+
+  # C++ stack only available for Rcpp::exceptions
+  checkTrue(is.null(condition$cppstack))
+
+  checkIdentical(condition$call, quote(takeLog(-1L)))
+}
+
+
+test.rcppException <- function() {
+
+  # Code works normally without an exception
+  checkIdentical(takeLog(1L), log(1L))
+
+  # C++ exceptions are converted to R conditions
+  condition <- tryCatch(takeLogRcpp(-1L), error = identity)
+
+  checkIdentical(condition$message, "Inadmissible value")
+  checkIdentical(class(condition), c("Rcpp::exception", "C++Error", "error", "condition"))
+
+  checkTrue(!is.null(condition$cppstack))
+
+  checkIdentical(class(condition$cppstack), "Rcpp_stack_trace")
+
+  checkEquals(condition$call, quote(takeLogRcpp(-1L)))
+}
+
+test.rcppExceptionLocation <- function() {
+
+  # Code works normally without an exception
+  checkIdentical(takeLog(1L), log(1L))
+
+  # C++ exceptions are converted to R conditions
+  condition <- tryCatch(takeLogRcppLocation(-1L), error = identity)
+
+  checkIdentical(condition$message, "Inadmissible value")
+  checkIdentical(class(condition), c("Rcpp::exception", "C++Error", "error", "condition"))
+
+  checkTrue(!is.null(condition$cppstack))
+  checkIdentical(class(condition$cppstack), "Rcpp_stack_trace")
+
+  checkIdentical(condition$cppstack$file, "exceptions.cpp")
+  checkIdentical(condition$cppstack$line, 44L)
+
+  checkEquals(condition$call, quote(takeLogRcppLocation(-1L)))
+}
+
+test.rcppExceptionLocation <- function() {
+
+  # Nested exceptions work the same way
+  normal <- tryCatch(takeLogRcppLocation(-1L), error = identity)
+  f1 <- function(x) takeLogNested(x)
+
+  nested <- tryCatch(f1(-1), error = identity)
+
+  # Message the same
+  checkIdentical(normal$message, nested$message)
+
+  checkEquals(nested$call, quote(takeLogNested(x)))
+}
+
+}