[Fix #289] Check for valid day-months combiinations in C parser

inst/tests/test-parsers.R

@@ -263,7 +263,6 @@ test_that("hms functions correctly handle - separators", {
   expect_that(hm("03-3"), equals(hours(3) + minutes(3)))
 })
 
-
 test_that("hms functions correctly handle space separators", {
   expect_that(hms("3 3 3"), equals(hours(3) + minutes(3) +
     seconds(3)))
@@ -275,7 +274,6 @@ test_that("hms functions correctly handle space separators", {
   expect_that(hm("03 3"), equals(hours(3) + minutes(3)))
 })
 
-
 test_that("hms functions correctly handle , separators", {
   expect_that(hms("3,3,3"), equals(hours(3) + minutes(3) +
     seconds(3)))
@@ -287,7 +285,6 @@ test_that("hms functions correctly handle , separators", {
   expect_that(hm("03,3"), equals(hours(3) + minutes(3)))
 })
 
-
 test_that("hms functions correctly handle / separators", {
   expect_that(hms("3/3/3"), equals(hours(3) + minutes(3) +
     seconds(3)))
@@ -299,7 +296,6 @@ test_that("hms functions correctly handle / separators", {
   expect_that(hm("03/3"), equals(hours(3) + minutes(3)))
 })
 
-
 test_that("hms functions return NA on shorter inputs", {
   expect_that(is.na(hms("3:3:3:4", quiet = TRUE)), is_true())
   expect_that(is.na(hms("03:03", quiet = TRUE)), is_true())
@@ -318,7 +314,6 @@ test_that("hms functions give warning on shorter inputs", {
   expect_warning(hm("03"))
 })
 
-
 test_that("heterogeneous formats are correctly parsed", {
   X <- c(20090101, "2009-01-02", "2009 01 03", "2009-1-4", "2009-1, 5", "2009....1--6", "200901-07", "200901-8")
   Y <- c("2009-01-01", "2009-01-02", "2009-01-03", "2009-01-04", "2009-01-05", "2009-01-06", "2009-01-07", "2009-01-08")
@@ -336,7 +331,6 @@ test_that("heterogeneous formats are correctly parsed", {
   cbind(as.character(ymd_hms(X)), as.character(as.POSIXct(Y, tz = "UTC")))
 })
 
-
 test_that("truncated formats are correctly parsed", {
   expect_that({
     x <- c("2011-12-31 12:59:59", "2010-01-01 12:11", "2010-01-01 12", "2010-01-01")
@@ -353,7 +347,6 @@ test_that("truncation on non-dates results in NAs indeed", {
       }))
 })
 
-
 test_that("fractional formats are correctly parsed", {
   expect_that({
     x <- c("2011-12-31 12:59:59.23", "2010-01-01 12:11:10")
@@ -362,7 +355,6 @@ test_that("fractional formats are correctly parsed", {
   expect_that(hms("3:0:3.34"), equals(hours(3) + minutes(0) + seconds(3.34)))
 })
 
-
 test_that( "NA's are parsed as NA's", {
   expect_warning(ymd(NA))
   expect_true(is.na(ymd(NA, quiet = TRUE)))
@@ -540,6 +532,16 @@ test_that("fast_strptime and parse_date_time2 parse correctly verbose formats",
                as.POSIXct(as.POSIXlt(NA, tz = "UTC")))
 })
 
+test_that("fast_strptime and parse_date_time2 deal correctly with leap years", {
+  expect_equal(ymd(c("2000-02-29", "2100-02-29", "2400-02-29"), quiet = T),
+               as.POSIXct(c("2000-02-29 UTC", NA, "2400-02-29 UTC"), tz = "UTC"))
+})
+
+test_that("fast_strptime and parse_date_time2 detect excesive days (#289)", {
+  expect_equal(ymd(c("2000-01-32", "2000-02-30", "2100-03-32", "2400-12-32"), quiet = T),
+               as.POSIXct(c(NA, NA, NA, NA), tz = "UTC"))
+})
+
 test_that("fast_strptime and parse_date_time2 aggree with strptime", {
   date <- "1 7 97"
   expect_equal(fast_strptime(date, "%d %m %y"),

src/tparse.c

@@ -233,6 +233,8 @@ SEXP parse_dt(SEXP str, SEXP ord, SEXP formats) {
 
     if ( succeed ){
 
+      // 1) process year
+
       // leap year every 400 years; no leap every 100 years
       int leap = (y % 4 == 0) && !(y % 100 == 0 && y % 400 != 0);
 
@@ -256,6 +258,20 @@ SEXP parse_dt(SEXP str, SEXP ord, SEXP formats) {
           secs += daylen;
       }
 
+      // 2) check month
+
+      if ( m == 2 ){
+	// no check for d > 0 because we allow missing days in parsing
+	if ( leap )
+	  succeed = d < 30;
+	else
+	  succeed = d < 29;
+      } else {
+	succeed = d <= mdays[m];
+      }
+    }
+
+    if (succeed ) {
       data[i] = secs + d30;
     } else {
       data[i] = NA_REAL;