Handle index class attribute in .xts()

Check for .indexCLASS and tclass passed to the constructor via '...'.
Warn that .indexCLASS is deprecated, but still use it. We will raise
this to an error in a later version.

Also warn if the tclass attribute on the index is not the same as the
tclass argument default value ("POSIXct", "POSIXt"). Current behavior
over-rides the index tclass attribute with the default argument value.
This seems like a bug, but it may break existing code, so warn before
changing or converting to an error.

Remove these two elements from '...' before attaching the remaining
elements to the result (as user attributes).

Remove the indexClass() call from the checkXtsClass() test function,
since indexClass() is deprecated.

See #245.

R/xts.R

@@ -158,6 +158,20 @@ function(x=NULL, index, tclass=c("POSIXct","POSIXt"),
     tformat <- attr(index, "tformat")
   }
 
+  if(hasArg(".indexCLASS")) {
+    warning(sQuote(".indexCLASS"), " is deprecated, use tclass instead.")
+    tclass <- eval.parent(ctor.call$.indexCLASS)
+  } else if(missing("tclass")) {
+    # compare tclass on the index with tclass argument because the
+    # tclass argument will override the index attribute, but it shouldn't...
+    index.class <- attr(index, 'tclass')
+    default.class <- c("POSIXct", "POSIXt")
+    if(!is.null(index.class) && !all(index.class %in% default.class)) {
+      warning("the index tclass attribute is ", index.class,
+              " but will be changed to (POSIXct, POSIXt)")
+    }
+  }
+
   # don't overwrite index tzone if tzone arg is missing
   if(missing(tzone)) {
     if(!is.null(index.tz <- attr(index,'tzone')))
@@ -166,19 +180,15 @@ function(x=NULL, index, tclass=c("POSIXct","POSIXt"),
   # xts' tzone must only contain one element (POSIXlt tzone has 3)
   tzone <- tzone[1L]
 
-  ## restore behaviour from v0.10-2
-  if(hasArg(".indexCLASS")) {
-    ctor.call <- match.call(expand.dots = TRUE)
-    tclass <- eval.parent(ctor.call$.indexCLASS)
-  }
-
   xx <- .Call("add_xtsCoreAttributes", x, index, tzone, tclass,
               c('xts','zoo'), tformat, PACKAGE='xts')
 
   # remove any index attributes that came through '...'
   dots.names <- eval(substitute(alist(...)))
   dots.names$.indexFORMAT <- NULL
   dots.names$tformat <- NULL
+  dots.names$.indexCLASS <- NULL
+  dots.names$tclass <- NULL
   # set any user attributes
   if(length(dots.names))
     attributes(xx) <- c(attributes(xx), list(...))

inst/unitTests/runit.xts.R

@@ -83,6 +83,7 @@ test.xts_ctor_warns_for_indexCLASS_arg <- function() {
   op <- options(warn = 2)
   on.exit(options(warn = op$warn))
   checkException(x <- xts(1, as.Date("2018-05-02"), .indexCLASS = "Date"))
+  checkException(x <- .xts(1, as.Date("2018-05-02"), .indexCLASS = "Date"))
 }
 
 test.xts_ctor_warns_for_indexTZ_arg <- function() {
@@ -105,6 +106,23 @@ test..xts_dimnames_in_dots <- function() {
   checkEquals(x, y)
 }
 
+test..xts_ctor_warns_if_index_tclass_not_NULL_or_POSIXct <- function() {
+  op <- options(warn = 2)
+  on.exit(options(warn = op$warn))
+
+  idx <- 1:3
+  x <- .xts(1:3, idx)  # no error, NULL
+  idx <- .POSIXct(idx)
+  x <- .xts(1:3, idx)  # no error, POSIXct
+
+  idx <- structure(1:3, tclass = "Date", tzone = "UTC")
+  checkException(.xts(1:3, idx), msg = "tclass = Date")
+  idx <- structure(idx, tclass = "yearmon", tzone = "UTC")
+  checkException(.xts(1:3, idx), msg = "tclass = yearmon")
+  idx <- structure(idx, tclass = "timeDate", tzone = "UTC")
+  checkException(.xts(1:3, idx), msg = "tclass = timeDate")
+}
+
 checkXtsFormat <- function(xts, format) {
   checkIdentical(tformat(xts), format)
   checkIdentical(attr(attr(xts, "index"), "tformat"), format)
@@ -130,22 +148,23 @@ test..xts_index_format_precedence <- function() {
 
 checkXtsClass <- function(xts, class) {
   checkEquals(tclass(xts), class)
-  checkEquals(indexClass(xts), class)
   checkEquals(attr(attr(xts, "index"), "tclass"), class)
 }
 
-### Check that .indexCLASS takes precedence over tclass when both specified
-test..xts_class <- function() {
+### Check that index class attribute precedence is:
+### .indexCLASS argument > tclass argument > tclass index attribute
+test..xts_index_class_precedence <- function() {
   checkXtsClass(.xts(1, 1), c("POSIXct", "POSIXt"))
   checkXtsClass(.xts(1, 1, tclass="timeDate"), "timeDate")
   checkXtsClass(.xts(1, 1, .indexCLASS="Date"), "Date")
   checkXtsClass(.xts(1, 1, tclass="timeDate", .indexCLASS="Date"), "Date")
 
   ## also check that tclass is ignored if specified as part of index
-  checkXtsClass(.xts(1, structure(1, tzone="",tclass="yearmon")), c("POSIXct", "POSIXt"))
-  checkXtsClass(.xts(1, structure(1, tzone="",tclass="yearmon"), tclass="timeDate"), "timeDate")
-  checkXtsClass(.xts(1, structure(1, tzone="",tclass="yearmon"), .indexCLASS="Date"), "Date")
-  checkXtsClass(.xts(1, structure(1, tzone="",tclass="yearmon"), tclass="timeDate", .indexCLASS="Date"), "Date")
+  idx <- structure(1, tzone="",tclass="yearmon")
+  checkXtsClass(.xts(1, idx), c("POSIXct", "POSIXt"))
+  checkXtsClass(.xts(1, idx, tclass="timeDate"), "timeDate")
+  checkXtsClass(.xts(1, idx, .indexCLASS="Date"), "Date")
+  checkXtsClass(.xts(1, idx, tclass="timeDate", .indexCLASS="Date"), "Date")
 }
 
 checkXtsTz <- function(xts, tzone) {