diff --git a/.gitignore b/.gitignore index 2b9e9cb..abb70d3 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ yaml_*.tar.gz *.Rproj docs inst/doc +_codeql_detected_source_root diff --git a/NEWS.md b/NEWS.md index bf24868..f624bba 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # yaml (development version) +* Apply handlers also with `column.major = FALSE` (#164, @krlmlr). + +# yaml 2.3.12 + * Fixes for C API compliance. * Switched from `CHANGELOG` to `NEWS.md`. diff --git a/src/r_emit.c b/src/r_emit.c index 4f9b8ea..2f74cf9 100644 --- a/src/r_emit.c +++ b/src/r_emit.c @@ -261,31 +261,18 @@ static yaml_scalar_style_t Ryaml_string_style(SEXP s_obj) /* Take a vector and an index and return another vector of size 1 */ static SEXP Ryaml_yoink(SEXP s_vec, int index) { - SEXP s_tmp = NULL, s_levels = NULL; - int type = 0, factor = 0, level_idx = 0; + SEXP s_tmp = NULL; + int type = 0; type = TYPEOF(s_vec); - factor = type == INTSXP && Ryaml_has_class(s_vec, "factor"); - PROTECT(s_tmp = allocVector(factor ? STRSXP : type, 1)); + PROTECT(s_tmp = allocVector(type, 1)); switch(type) { case LGLSXP: LOGICAL(s_tmp)[0] = LOGICAL(s_vec)[index]; break; case INTSXP: - if (factor) { - s_levels = getAttrib(s_vec, R_LevelsSymbol); - level_idx = INTEGER(s_vec)[index]; - if (level_idx == NA_INTEGER || level_idx < 1 || level_idx > LENGTH(s_levels)) { - SET_STRING_ELT(s_tmp, 0, NA_STRING); - } - else { - SET_STRING_ELT(s_tmp, 0, STRING_ELT(s_levels, level_idx - 1)); - } - } - else { - INTEGER(s_tmp)[0] = INTEGER(s_vec)[index]; - } + INTEGER(s_tmp)[0] = INTEGER(s_vec)[index]; break; case REALSXP: REAL(s_tmp)[0] = REAL(s_vec)[index]; @@ -300,6 +287,7 @@ static SEXP Ryaml_yoink(SEXP s_vec, int index) RAW(s_tmp)[0] = RAW(s_vec)[index]; break; } + copyMostAttrib(s_vec, s_tmp); UNPROTECT(1); return s_tmp; diff --git a/tests/testthat/test-as_yaml.R b/tests/testthat/test-as_yaml.R index f07dadf..2403cf7 100644 --- a/tests/testthat/test-as_yaml.R +++ b/tests/testthat/test-as_yaml.R @@ -479,3 +479,40 @@ test_that("no dots at end", { result <- yaml::as.yaml(list(eol = "\n", a = 1), line.sep = "\n") expect_equal(result, "eol: |2+\n\na: 1.0\n") }) + +test_that("Date handler works with column.major = FALSE", { + x <- data.frame(date = as.Date(c("2012-10-10", "2014-03-28"))) + handler <- list(Date = function(x) as.character(x)) + + result_col <- as.yaml(x, handlers = handler, column.major = TRUE) + result_row <- as.yaml(x, handlers = handler, column.major = FALSE) + + expect_equal(result_col, "date:\n- '2012-10-10'\n- '2014-03-28'\n") + expect_equal(result_row, "- date: '2012-10-10'\n- date: '2014-03-28'\n") +}) + +test_that("POSIXct handler works with column.major = FALSE", { + x <- data.frame( + time = as.POSIXct(c("2012-10-10", "2014-03-28"), tz = "UTC") + ) + handler <- list(POSIXct = function(x) format(x, "%Y-%m-%d")) + + result_col <- as.yaml(x, handlers = handler, column.major = TRUE) + result_row <- as.yaml(x, handlers = handler, column.major = FALSE) + + expect_equal(result_col, "time:\n- '2012-10-10'\n- '2014-03-28'\n") + expect_equal(result_row, "- time: '2012-10-10'\n- time: '2014-03-28'\n") +}) + +test_that("factor column works with column.major = FALSE", { + x <- data.frame(x = factor(c("a", "b", "c"))) + result <- as.yaml(x, column.major = FALSE) + expect_equal(result, "- x: a\n- x: b\n- x: c\n") +}) + +test_that("factor handler works with column.major = FALSE", { + x <- data.frame(x = factor(c("a", "b", "c"))) + handler <- list(factor = function(x) paste0("level_", x)) + result <- as.yaml(x, handlers = handler, column.major = FALSE) + expect_equal(result, "- x: level_a\n- x: level_b\n- x: level_c\n") +})