improve error messages for scalar checks

mllg · Jun 6, 2016 · 3347f41 · 3347f41
1 parent e68ca32
commit 3347f41
Show file tree

Hide file tree

Showing 3 changed files with 24 additions and 9 deletions.
diff --git a/src/checks.c b/src/checks.c
@@ -479,14 +479,18 @@ SEXP c_check_atomic_vector(SEXP x, SEXP any_missing, SEXP all_missing, SEXP len,
 
 SEXP c_check_flag(SEXP x, SEXP na_ok, SEXP null_ok) {
     handle_na(x, na_ok);
-    handle_type_null(xlength(x) == 1 && isLogical(x), "logical flag", null_ok);
+    handle_type_null(isLogical(x), "logical flag", null_ok);
+    if (xlength(x) != 1)
+        return result("Must have length 1");
     return ScalarLogical(TRUE);
 }
 
 SEXP c_check_count(SEXP x, SEXP na_ok, SEXP positive, SEXP tol, SEXP null_ok) {
     handle_na(x, na_ok)
     double dtol = asNumber(tol, "tol");
-    handle_type_null(xlength(x) == 1 && isIntegerish(x, dtol), "count", null_ok);
+    handle_type_null(isIntegerish(x, dtol), "count", null_ok);
+    if (xlength(x) != 1)
+        return result("Must have length 1");
     const int pos = (int) asFlag(positive, "positive");
     if (asInteger(x) < pos)
         return result("Must be >= %i", pos);
@@ -496,22 +500,28 @@ SEXP c_check_count(SEXP x, SEXP na_ok, SEXP positive, SEXP tol, SEXP null_ok) {
 SEXP c_check_int(SEXP x, SEXP na_ok, SEXP lower, SEXP upper, SEXP tol, SEXP null_ok) {
     double dtol = asNumber(tol, "tol");
     handle_na(x, na_ok);
-    handle_type_null(xlength(x) == 1 && isIntegerish(x, dtol), "single integerish value", null_ok);
+    handle_type_null(isIntegerish(x, dtol), "single integerish value", null_ok);
+    if (xlength(x) != 1)
+        return result("Must have length 1");
     assert(check_bounds(x, lower, upper));
     return ScalarLogical(TRUE);
 }
 
 SEXP c_check_number(SEXP x, SEXP na_ok, SEXP lower, SEXP upper, SEXP finite, SEXP null_ok) {
     handle_na(x, na_ok);
-    handle_type_null(xlength(x) == 1 && isStrictlyNumeric(x), "number", null_ok);
+    handle_type_null(isStrictlyNumeric(x), "number", null_ok);
+    if (xlength(x) != 1)
+        return result("Must have length 1");
     assert(check_vector_finite(x, finite));
     assert(check_bounds(x, lower, upper));
     return ScalarLogical(TRUE);
 }
 
 SEXP c_check_string(SEXP x, SEXP na_ok, SEXP min_chars, SEXP null_ok) {
     handle_na(x, na_ok);
-    handle_type_null(xlength(x) == 1 && isString(x), "string", null_ok);
+    handle_type_null(isString(x), "string", null_ok);
+    if (xlength(x) != 1)
+        return result("Must have length 1");
     if (!isNull(min_chars)) {
         R_xlen_t n = asCount(min_chars, "min.chars");
         if (!all_nchar(x, n))
@@ -523,6 +533,8 @@ SEXP c_check_string(SEXP x, SEXP na_ok, SEXP min_chars, SEXP null_ok) {
 
 SEXP c_check_scalar(SEXP x, SEXP na_ok, SEXP null_ok) {
     handle_na(x, na_ok);
-    handle_type_null(xlength(x) == 1 && isVectorAtomic(x), "atomic scalar", null_ok);
+    handle_type_null(isVectorAtomic(x), "atomic scalar", null_ok);
+    if (xlength(x) != 1)
+        return result("Must have length 1");
     return ScalarLogical(TRUE);
 }
diff --git a/tests/testthat/test_asType.R b/tests/testthat/test_asType.R
@@ -38,7 +38,8 @@ test_that("asInt", {
   expect_equal(names(asInt(xd)), names(xd))
   expect_equal(names(asInt(xc)), names(xc))
 
-  expect_error(asInt(1:2), "integerish")
+  expect_error(asInt(letters[1:2]), "integerish")
+  expect_error(asInt(1:2), "length 1")
   expect_equal(asInt(xi), xi)
   expect_equal(asInt(xd), xi)
   expect_equal(asInt(xc), xi)
@@ -65,7 +66,8 @@ test_that("asCount", {
   expect_equal(names(asCount(xd)), names(xd))
   expect_equal(names(asCount(xc)), names(xc))
 
-  expect_error(asCount(1:2), "count")
+  expect_error(asCount(letters[1:2]), "count")
+  expect_error(asCount(1:2), "length 1")
   expect_equal(asCount(xi), xi)
   expect_equal(asCount(xd), xi)
   expect_equal(asCount(xc), xi)

diff --git a/tests/testthat/test_checkScalar.R b/tests/testthat/test_checkScalar.R
@@ -14,5 +14,6 @@ test_that("checkScalar", {
   expect_false(testScalar(NA, na.ok = FALSE))
   expect_true(testScalar(NA, na.ok = TRUE))
 
-  expect_error(assertScalar(integer(0)), "scalar")
+  expect_error(assertScalar(integer(0)), "length 1")
+  expect_error(assertScalar(iris), "scalar")
 })