From 49bc983185a069946bb673117afc3ef26f7e9525 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 2 Sep 2024 05:30:27 +0000 Subject: [PATCH 1/2] More descriptive variable names for fcase counting variables --- src/fifelse.c | 48 ++++++++++++++++++++++++------------------------ 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/src/fifelse.c b/src/fifelse.c index bd28e88ad0..875c307558 100644 --- a/src/fifelse.c +++ b/src/fifelse.c @@ -209,12 +209,12 @@ SEXP fcaseR(SEXP rho, SEXP args) { "Note that the default argument must be named explicitly, e.g., default=0"), narg - 2); } int nprotect=0, l; - int64_t len0=0, len1=0, len2=0; + int64_t n_ans=0, n_this_arg=0, n_undecided=0; SEXP ans=R_NilValue, value0=R_NilValue, tracker=R_NilValue, whens=R_NilValue, thens=R_NilValue; PROTECT_INDEX Iwhens, Ithens; PROTECT_WITH_INDEX(whens, &Iwhens); nprotect++; PROTECT_WITH_INDEX(thens, &Ithens); nprotect++; - SEXPTYPE type0=NILSXP; + SEXPTYPE ans_type=NILSXP; // naout means if the output is scalar logic na bool imask = true, naout = false, idefault = false; int *restrict p = NULL; @@ -232,31 +232,31 @@ SEXP fcaseR(SEXP rho, SEXP args) { const int *restrict pwhens = LOGICAL(whens); l = 0; if (i == 0) { - len0 = xlength(whens); - len2 = len0; - type0 = TYPEOF(thens); + n_ans = xlength(whens); + n_undecided = n_ans; + ans_type = TYPEOF(thens); value0 = thens; - ans = PROTECT(allocVector(type0, len0)); nprotect++; + ans = PROTECT(allocVector(ans_type, n_ans)); nprotect++; copyMostAttrib(thens, ans); - tracker = PROTECT(allocVector(INTSXP, len0)); nprotect++; + tracker = PROTECT(allocVector(INTSXP, n_ans)); nprotect++; p = INTEGER(tracker); } else { imask = false; naout = xlength(thens) == 1 && TYPEOF(thens) == LGLSXP && LOGICAL(thens)[0]==NA_LOGICAL; - if (xlength(whens) != len0) { + if (xlength(whens) != n_ans) { // no need to check `idefault` here because the con for default is always `TRUE` error(_("Argument #%d has length %lld which differs from that of argument #1 (%lld). " "Please make sure all logical conditions have the same length."), - i*2+1, (long long)xlength(whens), (long long)len0); + i*2+1, (long long)xlength(whens), (long long)n_ans); } - if (!naout && TYPEOF(thens) != type0) { + if (!naout && TYPEOF(thens) != ans_type) { if (idefault) { error(_("Resulting value is of type %s but 'default' is of type %s. " - "Please make sure that both arguments have the same type."), type2char(type0), type2char(TYPEOF(thens))); + "Please make sure that both arguments have the same type."), type2char(ans_type), type2char(TYPEOF(thens))); } else { error(_("Argument #%d is of type %s, however argument #2 is of type %s. " "Please make sure all output values have the same type."), - i*2+2, type2char(TYPEOF(thens)), type2char(type0)); + i*2+2, type2char(TYPEOF(thens)), type2char(ans_type)); } } if (!naout) { @@ -282,22 +282,22 @@ SEXP fcaseR(SEXP rho, SEXP args) { UNPROTECT(2); // levels(value0), levels(thens) } } - len1 = xlength(thens); - if (len1 != len0 && len1 != 1) { + n_this_arg = xlength(thens); + if (n_this_arg != n_ans && n_this_arg != 1) { if (idefault) { - error(_("Length of 'default' must be 1 or %lld."), (long long)len0); + error(_("Length of 'default' must be 1 or %lld."), (long long)n_ans); } else { - error(_("Length of output value #%d (%lld) must either be 1 or match the length of the logical condition (%lld)."), i*2+2, (long long)len1, (long long)len0); + error(_("Length of output value #%d (%lld) must either be 1 or match the length of the logical condition (%lld)."), i*2+2, (long long)n_this_arg, (long long)n_ans); } } - int64_t thenMask = len1>1 ? INT64_MAX : 0; + int64_t thenMask = n_this_arg>1 ? INT64_MAX : 0; switch(TYPEOF(ans)) { case LGLSXP: { const int *restrict pthens; if (!naout) pthens = LOGICAL(thens); // the content is not useful if out is NA_LOGICAL scalar int *restrict pans = LOGICAL(ans); const int pna = NA_LOGICAL; - for (int64_t j=0; j Date: Sat, 7 Sep 2024 08:11:32 -0700 Subject: [PATCH 2/2] Fix fcase() segfault (#6452) --- NEWS.md | 2 ++ inst/tests/tests.Rraw | 11 +++++++++++ src/fifelse.c | 20 +++++++++++++------- 3 files changed, 26 insertions(+), 7 deletions(-) diff --git a/NEWS.md b/NEWS.md index a215469038..5ed203f4d7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,8 @@ 1. Using `print.data.table()` with character truncation using `datatable.prettyprint.char` no longer errors with `NA` entries, [#6441](https://github.com/Rdatatable/data.table/issues/6441). Thanks to @r2evans for the bug report, and @joshhwuu for the fix. +2. Fixed a segfault in `fcase()`, [#6448](https://github.com/Rdatatable/data.table/issues/6448). Thanks @ethanbsmith for reporting with reprex, @aitap for finding the root cause, and @MichaelChirico for the PR. + ## NOTES 1. Tests run again when some Suggests packages are missing, [#6411](https://github.com/Rdatatable/data.table/issues/6411). Thanks @aadler for the note and @MichaelChirico for the fix. diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index bc06b45172..06599e379b 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -19059,3 +19059,14 @@ test(2280.1, internal_error("broken"), error="Internal error.*broken") test(2280.2, internal_error("broken %d%s", 1, "2"), error="Internal error.*broken 12") foo = function(...) internal_error("broken") test(2280.3, foo(), error="Internal error in foo: broken") + +# ensure proper PROTECT() within fcase, #6448 +x <- 1:3 +test(2281, + fcase( + x<2, structure(list(1), class = "foo"), + x<3, structure(list(2), class = "foo"), + # Force gc() and some allocations which have a good chance at landing in the region that was earlier left unprotected + { gc(full = TRUE); replicate(10, FALSE); x<4 }, + `attr<-`(list(3), "class", "foo")), + structure(list(1, 2, 3), class = "foo")) diff --git a/src/fifelse.c b/src/fifelse.c index 875c307558..f117214d1d 100644 --- a/src/fifelse.c +++ b/src/fifelse.c @@ -210,13 +210,15 @@ SEXP fcaseR(SEXP rho, SEXP args) { } int nprotect=0, l; int64_t n_ans=0, n_this_arg=0, n_undecided=0; - SEXP ans=R_NilValue, value0=R_NilValue, tracker=R_NilValue, whens=R_NilValue, thens=R_NilValue; + SEXP ans=R_NilValue, tracker=R_NilValue, whens=R_NilValue, thens=R_NilValue; + SEXP ans_class, ans_levels; PROTECT_INDEX Iwhens, Ithens; PROTECT_WITH_INDEX(whens, &Iwhens); nprotect++; PROTECT_WITH_INDEX(thens, &Ithens); nprotect++; SEXPTYPE ans_type=NILSXP; // naout means if the output is scalar logic na bool imask = true, naout = false, idefault = false; + bool ans_is_factor; int *restrict p = NULL; const int n = narg/2; for (int i=0; i