fix #1760 #1761; of interest to #1666

moves the [.sfc logic to c++; fixes the case where reason=TRUE and exceptions arise

R/valid.R

@@ -23,18 +23,12 @@ st_is_valid.sfc = function(x, ..., NA_on_exception = TRUE, reason = FALSE) {
 		if (NA_on_exception) {
 			ret = rep(NA_character_, length(x))
 			not_na = !is.na(st_is_valid(x, reason = FALSE))
-			ret[not_na] = CPL_geos_is_valid_reason(x)
+			ret[not_na] = CPL_geos_is_valid_reason(x[not_na])
 			ret
 		} else
 			CPL_geos_is_valid_reason(x)
-	} else if (! NA_on_exception) {
+	} else
 		CPL_geos_is_valid(x, as.logical(NA_on_exception))
-	} else {
-		ret = vector("logical", length(x))
-		for (i in seq_along(x))
-			ret[i] = CPL_geos_is_valid(x[i], as.logical(NA_on_exception))
-		ret
-	}
 }
 
 #' @export

src/geos.cpp

@@ -556,6 +556,12 @@ Rcpp::LogicalVector CPL_geos_is_valid(Rcpp::List sfc, bool NA_on_exception = tru
 		Rcpp::List geom_i = Rcpp::List::create(sfc[i]);
 		geom_i.attr("precision") = sfc.attr("precision");
 		geom_i.attr("class") = sfc.attr("class");
+		geom_i.attr("crs") = sfc.attr("crs");
+		SEXP classes = sfc.attr("classes");
+		if (classes != R_NilValue) {
+			Rcpp::CharacterVector cl = sfc.attr("classes");
+			geom_i.attr("classes") = cl[i];
+		}
 		std::vector<GeomPtr> gmv = geometries_from_sfc(hGEOSCtxt, geom_i, NULL); // where notice might be set!
 		int ret = GEOSisValid_r(hGEOSCtxt, gmv[0].get());
 		if (NA_on_exception && (ret == 2 || notice != 0))

tests/testthat/test_valid.R

@@ -4,6 +4,10 @@ context("st_is_valid")
 test_that("st_is_valid", {
   p1 <- st_as_sfc("POLYGON((0 0, 0 10, 10 10, 10 0, 0 0))")
   p2 <- st_as_sfc("POLYGON((0 0, 0 10, 10 0))")
-  set1 <- c(p1, p2)
+  set1 <- c(p1, p2, p1, p2, p1, p2)
   expect_identical(st_is_valid(set1), c(TRUE, NA))
+  expect_identical(st_is_valid(set1, reason = TRUE), 
+    c("Valid Geometry", NA, "Valid Geometry", NA, "Valid Geometry", NA))
 })
+
+