From 48cc21aa51090af5e9cbf0418f739cabe6fd80a6 Mon Sep 17 00:00:00 2001
From: Joshua Ulrich <josh.m.ulrich@gmail.com>
Date: Tue, 6 Feb 2024 17:15:26 -0600
Subject: [PATCH] Warn when 'i' or 'j' is negative non-integer

We need to convert 'i' and 'j' to integer if they're numeric with a
fractional component. This was only being done when 'i' and 'j' were
positive.

Also fix the if-statement. sum() could have returned NA and it's better
to use isTRUE() and any() anyway.

Fixes #415. See #413.
---
 R/xts.methods.R             | 28 +++++++++++++++++-----------
 inst/tinytest/test-subset.R |  4 ++--
 2 files changed, 19 insertions(+), 13 deletions(-)

diff --git a/R/xts.methods.R b/R/xts.methods.R
index 4428a2c..c6f2878 100644
--- a/R/xts.methods.R
+++ b/R/xts.methods.R
@@ -131,6 +131,14 @@ function(x, i, j, drop = FALSE, which.i=FALSE,...)
     if(!missing(i)) {
     # test for negative subscripting in i
     if (is.numeric(i)) {
+
+      # warn and convert if 'i' is not integer-like
+      i_int <- as.integer(i)
+      i_eps <- abs(i) - abs(i_int)
+      if (isTRUE(any(i_eps > sqrt(.Machine$double.eps)))) {
+        warning("converting 'i' to integer because it appears to contain fractions")
+        i <- i_int
+      }
       #if(any(i < 0)) {
       if(.Call(C_any_negative, i)) {
         if(!all(i <= 0))
@@ -143,12 +151,6 @@ function(x, i, j, drop = FALSE, which.i=FALSE,...)
       if(length(i) > 0 && max(i) > nr)
         stop('subscript out of bounds')
       #i <- i[-which(i == 0)]
-
-      # warn and convert if 'i' is not integer-like
-      if(sum(abs(i)-abs(as.integer(i))) > .Machine$double.eps) {
-        warning("converting 'i' to integer because it appears to contain fractions")
-        i <- as.integer(i)
-      }
     } else
     if (timeBased(i) || (inherits(i, "AsIs") && is.character(i)) ) {
       # Fast binary search on set of dates
@@ -237,6 +239,15 @@ function(x, i, j, drop = FALSE, which.i=FALSE,...)
     } else
     # test for negative subscripting in j
     if (is.numeric(j)) {
+
+      # warn and convert if 'j' is not integer-like
+      j_int <- as.integer(j)
+      j_eps <- abs(j) - abs(j_int)
+      if (isTRUE(any(j_eps > sqrt(.Machine$double.eps)))) {
+        warning("converting 'j' to integer because it appears to contain fractions")
+        j <- j_int
+      }
+
       if(min(j,na.rm=TRUE) < 0) {
         if(max(j,na.rm=TRUE) > 0)
           stop('only zeros may be mixed with negative subscripts')
@@ -244,11 +255,6 @@ function(x, i, j, drop = FALSE, which.i=FALSE,...)
       }
       if(max(j,na.rm=TRUE) > nc)
         stop('subscript out of bounds')
-      # warn and convert if 'j' is not integer-like
-      if(sum(abs(j)-abs(as.integer(j))) > .Machine$double.eps) {
-        warning("converting 'j' to integer because it appears to contain fractions")
-        j <- as.integer(j)
-      }
     } else
     if(is.logical(j)) {
       if(length(j) == 1) {
diff --git a/inst/tinytest/test-subset.R b/inst/tinytest/test-subset.R
index b7f7052..3cac9e3 100644
--- a/inst/tinytest/test-subset.R
+++ b/inst/tinytest/test-subset.R
@@ -344,10 +344,10 @@ expect_equal(storage.mode(x[0, tf]), sm, info = paste(info_msg, ": x[0, c(TRUE,
 # non-integer subset
 x <- .xts(matrix(1:20, 10, 2), 1:10)
 # subset by non-integer-like 'i' warns
-#expect_warning(x[-1.5, ])
+expect_warning(x[-1.5, ])
 expect_warning(x[ 0.5, ])
 expect_warning(x[ 1.5, ])
 # subset by non-integer-like 'j' warns
-#expect_warning(x[, -1.5])
+expect_warning(x[, -1.5])
 expect_warning(x[,  0.5])
 expect_warning(x[,  1.5])