Merge pull request #621 from RcppCore/feature/update_date_code

Feature/update date code

Author: eddelbuettel

ChangeLog

@@ -1,3 +1,8 @@
+2017-01-01  Dirk Eddelbuettel  <edd@debian.org>
+
+        * inst/unitTests/runit.Date.R (test.mktime, test.gmtime): New tests
+        * inst/unitTests/cpp/dates.cpp (test_mktime, test_gmtime): Idem
+
 2016-12-31  Dirk Eddelbuettel  <edd@debian.org>
 
         * inst/include/Rcpp/vector/Matrix.h: Minor simplification
@@ -10,6 +15,13 @@
         filling matrices.
         * inst/unitTests/cpp/Matrix.cpp: Idem
 
+2016-12-30  Dirk Eddelbuettel  <edd@debian.org>
+
+        * src/Date.cpp: Synchronized internal code with R
+
+        * inst/unitTests/cpp/dates.cpp (gmtime_mktime): New test
+        * inst/unitTests/runit.Date.R (test.mktime_gmtime): Idem
+
 2016-12-26  Dirk Eddelbuettel  <edd@debian.org>
 
         * R/Attributes.R: Added #nocov markers

inst/unitTests/cpp/dates.cpp

@@ -196,3 +196,41 @@ std::string Datetime_ostream(Datetime d) {
     os << d;
     return os.str();
 }
+
+// [[Rcpp::export]]
+Date gmtime_mktime(Date d) {
+    const int baseYear = 1900;
+    struct tm tm;
+    tm.tm_sec = tm.tm_min = tm.tm_hour = tm.tm_isdst = 0;
+
+    tm.tm_mday  = d.getDay();
+    tm.tm_mon   = d.getMonth() - 1;    // range 0 to 11
+    tm.tm_year  = d.getYear() - baseYear;
+    time_t tmp = mktime00(tm);    // use mktime() replacement borrowed from R
+
+    struct tm chk = *gmtime_(&tmp);
+    Date newd(chk.tm_year, chk.tm_mon + 1, chk.tm_mday);
+    return newd;
+}
+
+// [[Rcpp::export]]
+double test_mktime(Date d) {
+    const int baseYear = 1900;
+    struct tm tm;
+    tm.tm_sec = tm.tm_min = tm.tm_hour = tm.tm_isdst = 0;
+
+    tm.tm_mday  = d.getDay();
+    tm.tm_mon   = d.getMonth() - 1;    // range 0 to 11
+    tm.tm_year  = d.getYear() - baseYear;
+    time_t t = mktime00(tm);    // use mktime() replacement borrowed from R
+    return static_cast<double>(t);
+}
+
+// [[Rcpp::export]]
+Date test_gmtime(double d) {
+    time_t t = static_cast<time_t>(d);
+    struct tm tm = *gmtime_(&t);
+    tm.tm_sec = tm.tm_min = tm.tm_hour = tm.tm_isdst = 0;
+    Date nd(tm.tm_year, tm.tm_mon + 1, tm.tm_mday);
+    return nd;
+}

inst/unitTests/runit.Date.R

@@ -239,4 +239,33 @@ if (.runThisTest) {
     }
 
 
+    test.mktime_gmtime <- function() {
+        d <- as.Date("2015-12-31")
+        checkEquals(d, gmtime_mktime(d), msg="Date.mktime_gmtime.2015")
+
+        d <- as.Date("1965-12-31")
+        checkEquals(d, gmtime_mktime(d), msg="Date.mktime_gmtime.1965")
+    }
+
+    test.mktime <- function() {
+        d <- as.Date("2015-12-31")
+        checkEquals(test_mktime(d), as.numeric(as.POSIXct(d)), msg="Date.test_mktime.2015")
+
+        d <- as.Date("1970-01-01")
+        checkEquals(test_mktime(d), as.numeric(as.POSIXct(d)), msg="Date.test_mktime.1970")
+
+        d <- as.Date("1954-07-04")
+        checkEquals(test_mktime(d), as.numeric(as.POSIXct(d)), msg="Date.test_mktime.1954")
+    }
+
+    test.gmtime <- function() {
+        oldTZ <- Sys.getenv("TZ")
+        Sys.setenv(TZ="UTC")
+        checkEquals(test_gmtime(1441065600), as.Date("2015-09-01"), msg="Date.test_gmtime.2015")
+
+        checkEquals(test_gmtime(0),          as.Date("1970-01-01"), msg="Date.test_gmtime.1970")
+
+        checkEquals(test_gmtime(-489024000), as.Date("1954-07-04"), msg="Date.test_gmtime.1954")
+        Sys.setenv(TZ=oldTZ)
+    }
 }