Fix orderfin segfault

NEWS.md

@@ -51,6 +51,7 @@
 1. `as.integer64.integer64` is consistent with `as.integer.integer` in terms or returning a plain integer64 vector (i.e., stripped of attributes; #188). Thanks @hcirellu.
 1. `log(integer64(), base=integer64(1))` no longer warns, consistent with `log(integer(), base=integer())` (#93).
 1. `sortfin(integer64(), 1:10)` no longer segfaults (#164).
+1. `orderfin(as.integer64(10:1), 1:3, 8:11)` enforces that `table` be sorted by `order` instead of segfaulting (#166).
 
 ## NOTES
 

R/sortuse64.R

@@ -164,6 +164,7 @@ orderfin.integer64 <- function(table, order, x, method=NULL, ...) {
       , ret = logical(n)
       )
   } else {
+    x <- as.integer64(x)
     o <- seq_along(x); ramorder(x, o, na.last=FALSE, ...)
     ret <- logical(n)
     ret[o] <- .Call(C_r_ram_integer64_orderfin_asc
@@ -207,6 +208,7 @@ orderpos.integer64 <- function(table, order, x, nomatch=NA, method=NULL, ...) {
       , ret = integer(n)
       )
   } else {
+    x <- as.integer64(x)
     o <- seq_along(x); ramorder(x, o, na.last=FALSE, ...)
     ret <- integer(n)
     ret[o] <- .Call(C_r_ram_integer64_orderpos_asc

src/sortuse64.c

@@ -257,7 +257,7 @@ SEXP r_ram_integer64_orderfin_asc(
 )
 {
   int i,n = LENGTH(x_);
-  int pos,nt = LENGTH(table_);
+  int pos,nt = LENGTH(order_);
   int n1 = nt-1;
   int method = asInteger(method_);
 
@@ -272,6 +272,11 @@ SEXP r_ram_integer64_orderfin_asc(
   R_Busy(1);
   DEBUG_INIT
 
+  for(i=1;i<nt;i++)
+    if (table[index[i]-1] < table[index[i-1]-1]) {
+      error("Invalid input -- 'table' is not sorted by 'order'");
+    }
+
   for(i=0;i<nt;i++)
     index[i]--;
 
@@ -336,7 +341,7 @@ SEXP r_ram_integer64_orderpos_asc(
 )
 {
   int i,n = LENGTH(x_);
-  int pos,nt = LENGTH(table_);
+  int pos,nt = LENGTH(order_);
   int n1 = nt-1;
   int method = asInteger(method_);
   int nomatch = asInteger(nomatch_);
@@ -352,6 +357,11 @@ SEXP r_ram_integer64_orderpos_asc(
   R_Busy(1);
   DEBUG_INIT
 
+  for(i=1;i<nt;i++)
+    if (table[index[i]-1] < table[index[i-1]-1]) {
+      error("Invalid input -- 'table' is not sorted by 'order'");
+    }
+
   for(i=0;i<nt;i++)
     index[i]--;
 

tests/testthat/test-sortuse64.R

@@ -1,10 +1,10 @@
 with_parameters_test_that("sortfin works", method=1:3, {
   x = as.integer64(1:10)
-  r = sample(x) # NB: default method assumes 'sorted' is, well, sorted, so this requires method!=1
+  r = sample(x)
   expect_identical(sortfin(integer64(), 1:10, method=method), rep(FALSE, 10L))
   expect_identical(sortfin(x, integer64(), method=method), logical())
 
-  expect_true(all(sortfin(x, r)))
+  expect_true(all(sortfin(x, r, method=method)))
 
   expect_true(sortfin(x, 1L, method=method))
   expect_true(all(sortfin(x, c(1.0, 4.0), method=method)))
@@ -13,17 +13,46 @@ with_parameters_test_that("sortfin works", method=1:3, {
   expect_identical(sortfin(x, as.integer64(1:0), method=method), c(TRUE, FALSE))
 })
 
-test_that("orderfin and orderpos work", {
+with_parameters_test_that("orderfin and orderpos work", method=1:3, {
   x = as.integer64(1:10)
   idx = seq_along(x)
 
-  expect_identical(orderfin(x, idx, 0:1), c(FALSE, TRUE))
-  expect_identical(orderfin(x, idx, as.integer64(0:1), method=2L), c(FALSE, TRUE))
-  expect_identical(orderfin(x, idx, as.integer64(0:1), method=3L), c(FALSE, TRUE))
+  expect_identical(orderfin(x, idx, 0:1, method=method), c(FALSE, TRUE))
+  expect_identical(orderfin(x, idx, as.integer64(0:1), method=method), c(FALSE, TRUE))
 
-  expect_identical(orderpos(x, idx, 0:1), c(NA_integer_, 1L))
-  expect_identical(orderpos(x, idx, as.integer64(0:1), method=2L), c(NA_integer_, 1L))
-  expect_identical(orderpos(x, idx, as.integer64(0:1), method=3L), c(NA_integer_, 1L))
+  expect_identical(orderpos(x, idx, 0:1, method=method), c(NA_integer_, 1L))
+  expect_identical(orderpos(x, idx, as.integer64(0:1), method=method), c(NA_integer_, 1L))
+
+  # These were segfaulting due to length(order) < length(table)
+  table = as.integer64(c(10L, 20L, 30L, 5L, 15L, 25L))
+  order = c(4L, 1L, 5L, 2L, 6L, 3L) # order of table is 5, 10, 15, 20, 25, 30
+
+  partial_order = c(4L, 1L, 5L, 2L) # order of subset of table is 5, 10, 15, 20
+
+  x_search = as.integer64(c(5L, 10L, 15L, 20L, 25L, 30L, 99L))
+
+  # reference with full order
+  full_fin = c(TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE)
+  full_pos = c(4L, 1L, 5L, 2L, 6L, 3L, NA_integer_)
+  expect_identical(orderfin(table, order, x_search, method=method), full_fin)
+  expect_identical(orderpos(table, order, x_search, method=method), full_pos)
+
+  # with partial order, we search in a subset
+  partial_fin = c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE)
+  partial_pos = c(4L, 1L, 5L, 2L, NA_integer_, NA_integer_, NA_integer_)
+  expect_identical(orderfin(table, partial_order, x_search, method=method), partial_fin)
+  expect_identical(orderpos(table, partial_order, x_search, method=method), partial_pos)
+
+  expect_error(
+    orderfin(as.integer64(10:1), 1:3, 8:11, method=method),
+    "'table' is not sorted by 'order'",
+    fixed = TRUE
+  )
+  expect_error(
+    orderpos(as.integer64(10:1), 1:3, 8:11, method=method),
+    "'table' is not sorted by 'order'",
+    fixed = TRUE
+  )
 })
 
 test_that("ordertab and orderdup work", {
@@ -35,3 +64,4 @@ test_that("ordertab and orderdup work", {
   expect_identical(orderdup(x, idx), rep(c(FALSE, TRUE), c(10L, 14L)))
   expect_identical(orderdup(x, idx, method=2L), rep(c(FALSE, TRUE), c(10L, 14L)))
 })
+