From ab858d7d12173f594dd1cf5b924d9c1669f0797d Mon Sep 17 00:00:00 2001
From: Joshua Ulrich <josh.m.ulrich@gmail.com>
Date: Mon, 26 Jun 2017 09:57:40 -0500
Subject: [PATCH] Check numeric index for non-finite index values

The check for finite index values was very early in the xts
constructor, which could cause problems if order.by wasn't strictly
a numeric vector (e.g. if it was POSIXlt--a list). This was to ensure
the index doesn't contain +/-Inf, NA, or NaN (see #173).

Move the check until after the index has been converted to
POSIXct/numeric, so we can be certain it is a numeric vector.

Fixes #194.
---
 R/xts.R                           |  7 ++++---
 inst/unitTests/runit.data.frame.R | 32 ++++++++++++++++++++++++++-----
 2 files changed, 31 insertions(+), 8 deletions(-)

diff --git a/R/xts.R b/R/xts.R
index b009228f..1f02cb1f 100644
--- a/R/xts.R
+++ b/R/xts.R
@@ -62,9 +62,6 @@ function(x=NULL,
     order.by <- .POSIXct(unclass(order.by)*86400, tz=tzone)
   }
 
-  if(any(!is.finite(order.by)))
-    stop("'order.by' cannot contain 'NA', 'NaN', or 'Inf'")
-
   if(!isOrdered(order.by, strictly=!unique)) {
     indx <- order(order.by)
     if(!is.null(x)) {
@@ -88,6 +85,10 @@ function(x=NULL,
     index <- as.numeric(as.POSIXct(strptime(as.character(order.by),"(%m/%d/%y %H:%M:%S)"))) #$format
   else
   index <- as.numeric(as.POSIXct(order.by))
+
+  if(any(!is.finite(index)))
+    stop("'order.by' cannot contain 'NA', 'NaN', or 'Inf'")
+
   x <- structure(.Data=x,
             index=structure(index,tzone=tzone,tclass=orderBy),
             class=c('xts','zoo'),
diff --git a/inst/unitTests/runit.data.frame.R b/inst/unitTests/runit.data.frame.R
index 74d795f0..405c8dec 100644
--- a/inst/unitTests/runit.data.frame.R
+++ b/inst/unitTests/runit.data.frame.R
@@ -1,10 +1,15 @@
 data(sample_matrix)
 
-sysTZ <- Sys.getenv('TZ')
-Sys.setenv(TZ='GMT')
+.setUp <- function() {
+  sysTZ <<- Sys.getenv("TZ")
+  Sys.setenv(TZ = "GMT")
 
-sample.data.frame <- data.frame(sample_matrix)
-sample.xts <- as.xts(sample.data.frame)
+  sample.data.frame <<- data.frame(sample_matrix)
+  sample.xts <<- as.xts(sample.data.frame)
+}
+.tearDown <- function() {
+  Sys.setenv(TZ = sysTZ)
+}
 
 test.convert_data.frame_to_xts <- function() {
   checkIdentical(sample.xts,as.xts(sample.data.frame))
@@ -36,4 +41,21 @@ test.data.frame_reclass_subset_data.frame_j1 <- function() {
   checkException(try.xts(sample.data.frame[,1]))
 }
 
-Sys.setenv(TZ=sysTZ)
+# check for as.xts.data.frame when order.by is specified
+test.convert_data.frame_to_xts_order.by_POSIXlt <- function() {
+  orderby = as.POSIXlt(rownames(sample.data.frame))
+  x <- as.xts(sample.data.frame, order.by = orderby)
+  y <- xts(coredata(sample.xts), as.POSIXlt(index(sample.xts)))
+  checkIdentical(y, x)
+}
+test.convert_data.frame_to_xts_order.by_POSIXct <- function() {
+  orderby = as.POSIXct(rownames(sample.data.frame))
+  x <- as.xts(sample.data.frame, order.by = orderby)
+  checkIdentical(sample.xts, x)
+}
+test.convert_data.frame_to_xts_order.by_Date <- function() {
+  orderby = as.Date(rownames(sample.data.frame))
+  x <- as.xts(sample.data.frame, order.by = orderby)
+  y <- xts(coredata(sample.xts), as.Date(index(sample.xts)))
+  checkIdentical(y, x)
+}