Potential segfault with saveRDS of list of empty ggplot()

[bersbersbers]

I am investigating the segfaults I see in rstudio/rmarkdown#2229. I have spent a few hours(!) minimizing my code to a few hundred lines which I cannot yet share. I did notice, though, that the stack traces now consistently point towards a chunk at the end of a .Rmd file - specifically, the saveRDS line.

plotlist <- list()
plotlist[[1]] <- ggplot()
names(plotlist) <- c("plot")
saveRDS(c(plotlist), file.path("plot.rds")) # <--

(This is code minimized over and over again - there is much more happening in between in the full code.)

This .Rmd, when run via rmarkdown, shiny and shinytest, segfaults when rendered a second time, after being rendered once and after one renderPlot(plot(NULL)).

While this alone is not enough to repro the segfault, I guess, I do wonder if anyone sees some potential error right away.

[thomasp85]

There is no code in ggplot2 itself that can cause a segfault as it does not contain any compiled code. Which layers do the plot contain - it might be related to some extension geoms or a dependency of ggplot2

[bersbersbers]

There is no code in ggplot2 itself that can cause a segfault as it does not contain any compiled code.

Thanks for confirming - one less package to care about.

Which layers do the plot contain

None - this is the crazy part. While the snippet does not originate as such from the full code, it is part of the minimized example code reproducing the issue, and the stack trace indicates saveRDS as the problematic line. I don't have much experience with segfaults - does this a potential bug has to be in these four lines, or can other code lines play a role as well?

[clauswilke]

ggplot objects contain the current environment and saving that could cause a segfault. In general, we advise against saving ggplot objects with saveRDS(). It is not reliable (though it shouldn't normally crash your session).

[bersbersbers]

ggplot objects contain the current environment

Oh, I see. So ggplot() serves as some kind of canary, but I might/should now look which other variable from the environment (completely unrelated to the above snippet) may be corrupted. Thanks for that, that may help a lot actually.

[bersbersbers]

I have made the problem disappear by changing some unrelated (I thought) code: in fact, I rewrote mean_per_group_and_type using (d)plyr. But I am not 100% sure it may not come back at any time. So to investigate further, I came up with this reprex for now, without rmarkdown, shiny, or shinytest. The infinite loop is not nice, but it usually takes way less than 10 seconds (~15 iterations in the final example) to segfault:

mean_per_group_and_type <- function(df) {
    split_by <- list(df$group, df$type)
    sep <- "x"
    df_split <- split(df$value, split_by, sep = sep)
    as.data.frame(
        tidyr::pivot_wider(
            tidyr::pivot_longer(
                as.data.frame(lapply(df_split, mean)),
                tidyr::everything(),
                names_to = c("group", "type"),
                names_sep = sep,
            ),
            names_from = "group",
        )
    )
}

df <- data.frame(value = 10:49)
df$group <- paste0("Group", df$value %/% 10)
df$type <- paste0("Type", df$value %% 6)

while (TRUE) {
    foobarfoobar <- mean_per_group_and_type(df)

    data.table::as.data.table(1)
    openxlsx::write.xlsx(as.data.frame(1), tempfile())

    g1 <- ggplot2::ggplot()
    g2 <- ggplot2::ggplot()
    g3 <- ggplot2::ggplot()
    g4 <- ggplot2::ggplot()

    tmp <- tempfile()
    saveRDS(ggplot2::ggplot(), tmp)
    g <- readRDS(tmp)

    DT::renderDataTable(data.table::as.data.table(1))

    foobarfoobar <- mean_per_group_and_type(df)

    data.table::as.data.table(1)
    openxlsx::write.xlsx(as.data.frame(1), tempfile())

    saveRDS(ggplot2::ggplot(), tempfile())
}

Here's a couple of outputs:

*** recursive gc invocation

Traceback:
 1: (function (u, so, ml) {    if ((n <- length(so)) == 1L) {        if (is.na(so))             return(NA_character_)        else if (so == -1L)             return(u)    }    beg <- if (n > 1L) {        eo <- so + ml - 1L        if (any(eo[-n] >= so[-1L]))             stop(gettextf("need non-overlapping matches for %s",                 sQuote("invert = TRUE")), domain = NA)        c(1L, eo + 1L)    }    else {        c(1L, so + ml)    }    end <- c(so - 1L, nchar(u, itype))    substring(u, beg, end)})(dots[[1L]][[1L]], dots[[2L]][[1L]], dots[[3L]][[1L]])
 2: mapply(FUN = f, ..., SIMPLIFY = FALSE)
 3: Map(function(u, so, ml) {    if ((n <- length(so)) == 1L) {        if (is.na(so))             return(NA_character_)        else if (so == -1L)             return(u)    }    beg <- if (n > 1L) {        eo <- so + ml - 1L        if (any(eo[-n] >= so[-1L]))             stop(gettextf("need non-overlapping matches for %s",                 sQuote("invert = TRUE")), domain = NA)        c(1L, eo + 1L)    }    else {        c(1L, so + ml)    }    end <- c(so - 1L, nchar(u, itype))    substring(u, beg, end)}, x, m, if (ili) lapply(m, attr, "match.length") else attr(m,     "match.length"), USE.NAMES = FALSE)
 4: regmatches(x, m, invert = TRUE)
 5: str_split_n(value, sep, n_max = n_max)
 6: str_split_fixed(x, sep, length(into), extra = extra, fill = fill)
 7: str_separate(names, names_to, sep = names_sep)
 8: build_longer_spec(data, !!cols, names_to = names_to, values_to = values_to,     names_prefix = names_prefix, names_sep = names_sep, names_pattern = names_pattern,     names_ptypes = names_ptypes, names_transform = names_transform)
 9: pivot_longer.data.frame(as.data.frame(lapply(df_split, mean)),     tidyr::everything(), names_to = c("group", "type"), names_sep = sep,     )
10: tidyr::pivot_longer(as.data.frame(lapply(df_split, mean)), tidyr::everything(),     names_to = c("group", "type"), names_sep = sep, )
11: tidyr::pivot_wider(tidyr::pivot_longer(as.data.frame(lapply(df_split,     mean)), tidyr::everything(), names_to = c("group", "type"),     names_sep = sep, ), names_from = "group", )
12: as.data.frame(tidyr::pivot_wider(tidyr::pivot_longer(as.data.frame(lapply(df_split,     mean)), tidyr::everything(), names_to = c("group", "type"),     names_sep = sep, ), names_from = "group", ))
13: mean_per_group_and_type(df)
An irrecoverable exception occurred. R is aborting now ...
Segmentation fault (core dumped)

*** recursive gc invocation

Traceback:
 1: is(value, fieldClass)
 2: methods:::.setDummyField(.self, ".->colBreaks", "character",     "colBreaks", FALSE, value)
 3: (new("defaultBindingFunction", .Data = function (value) {    if (missing(value))         `.->colBreaks`    else {        methods:::.setDummyField(.self, ".->colBreaks", "character",             "colBreaks", FALSE, value)        value    }}, field = "colBreaks", className = "character"))(base::quote(character(0)))
 4: .Object$initialize(...)
 5: initialize(value, ...)
 6: initialize(value, ...)
 7: methods::new(def, ...)
 8: WorkSheet$new(showGridLines = showGridLines, tabSelected = newSheetIndex ==     1, tabColour = tabColour, zoom = zoom, oddHeader = oddHeader,     oddFooter = oddFooter, evenHeader = evenHeader, evenFooter = evenFooter,     firstHeader = firstHeader, firstFooter = firstFooter, paperSize = paperSize,     orientation = orientation, hdpi = hdpi, vdpi = vdpi)
 9: append(worksheets, WorkSheet$new(showGridLines = showGridLines,     tabSelected = newSheetIndex == 1, tabColour = tabColour,     zoom = zoom, oddHeader = oddHeader, oddFooter = oddFooter,     evenHeader = evenHeader, evenFooter = evenFooter, firstHeader = firstHeader,     firstFooter = firstFooter, paperSize = paperSize, orientation = orientation,     hdpi = hdpi, vdpi = vdpi))
10: wb$addWorksheet(sheetName = sheetName, showGridLines = gridLines,     tabColour = tabColour, zoom = zoom[1], oddHeader = headerFooterSub(header),     oddFooter = headerFooterSub(footer), evenHeader = headerFooterSub(evenHeader),     evenFooter = headerFooterSub(evenFooter), firstHeader = headerFooterSub(firstHeader),     firstFooter = headerFooterSub(firstFooter), visible = visible,     paperSize = paperSize, orientation = orientation, vdpi = vdpi,     hdpi = hdpi)
11: (function (wb, sheetName, gridLines = openxlsx_getOp("gridLines",     TRUE), tabColour = NULL, zoom = 100, header = openxlsx_getOp("header"),     footer = openxlsx_getOp("footer"), evenHeader = openxlsx_getOp("evenHeader"),     evenFooter = openxlsx_getOp("evenFooter"), firstHeader = openxlsx_getOp("firstHeader"),     firstFooter = openxlsx_getOp("firstFooter"), visible = TRUE,     paperSize = openxlsx_getOp("paperSize", 9), orientation = openxlsx_getOp("orientation",         "portrait"), vdpi = openxlsx_getOp("vdpi", 300), hdpi = openxlsx_getOp("hdpi",         300)) {    od <- getOption("OutDec")    options(OutDec = ".")    on.exit(expr = options(OutDec = od), add = TRUE)    if (inherits(wb, "list")) {        wb <- wb[[1]]    }    if (!inherits(wb, "Workbook")) {        stop("wb must be a Workbok", call. = FALSE)    }    gridLines <- gridLines %||% TRUE    paperSize <- paperSize %||% 9    orientation <- orientation %||% "portrait"    vdpi <- vdpi %||% 300    hdpi <- hdpi %||% 300    if (tolower(sheetName) %in% tolower(wb$sheet_names)) {        stop(paste0("A worksheet by the name '", sheetName, "' already exists! Sheet names must be unique case-insensitive."))    }    if (!is.logical(gridLines) | length(gridLines) > 1) {        stop("gridLines must be a logical of length 1.")    }    if (nchar(sheetName) > 31) {        stop(paste0("sheetName '", sheetName, "' too long! Max length is 31 characters."))    }    if (!is.null(tabColour)) {        tabColour <- validateColour(tabColour, "Invalid tabColour in addWorksheet.")    }    if (!is.numeric(zoom)) {        stop("zoom must be numeric")    }    if (!is.character(sheetName)) {        sheetName <- as.character(sheetName)    }    if (!is.null(header) & length(header) != 3) {        stop("header must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(footer) & length(footer) != 3) {        stop("footer must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(evenHeader) & length(evenHeader) != 3) {        stop("evenHeader must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(evenFooter) & length(evenFooter) != 3) {        stop("evenFooter must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(firstHeader) & length(firstHeader) != 3) {        stop("firstHeader must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(firstFooter) & length(firstFooter) != 3) {        stop("firstFooter must have length 3 where elements correspond to positions: left, center, right.")    }    visible <- tolower(visible[1])    if (!visible %in% c("true", "false", "hidden", "visible",         "veryhidden")) {        stop("visible must be one of: TRUE, FALSE, 'hidden', 'visible', 'veryHidden'")    }    orientation <- tolower(orientation)    if (!orientation %in% c("portrait", "landscape")) {        stop("orientation must be 'portrait' or 'landscape'.")    }    vdpi <- as.integer(vdpi)    if (is.na(vdpi)) {        stop("vdpi must be numeric")    }    hdpi <- as.integer(hdpi)    if (is.na(hdpi)) {        stop("hdpi must be numeric")    }    sheetName <- replaceIllegalCharacters(sheetName)    invisible(wb$addWorksheet(sheetName = sheetName, showGridLines = gridLines,         tabColour = tabColour, zoom = zoom[1], oddHeader = headerFooterSub(header),         oddFooter = headerFooterSub(footer), evenHeader = headerFooterSub(evenHeader),         evenFooter = headerFooterSub(evenFooter), firstHeader = headerFooterSub(firstHeader),         firstFooter = headerFooterSub(firstFooter), visible = visible,         paperSize = paperSize, orientation = orientation, vdpi = vdpi,         hdpi = hdpi))})(wb = list(new("Workbook", .xData = <environment>)), sheetName = "Sheet 1")
12: do.call(call_fun, call_params)
13: do_call_params(addWorksheet, params, wb = wb)
14: buildWorkbook(x, asTable = asTable, ...)
15: openxlsx::write.xlsx(as.data.frame(1), tempfile())
An irrecoverable exception occurred. R is aborting now ...
Segmentation fault (core dumped)

 *** caught segfault ***
address 0x559300000001, cause 'memory not mapped'

Traceback:
 1: options(op)
 2: (function (wb, sheet, x, startCol = 1, startRow = 1, array = FALSE,     xy = NULL, colNames = TRUE, rowNames = FALSE, headerStyle = openxlsx_getOp("headerStyle"),     borders = openxlsx_getOp("borders", "none"), borderColour = openxlsx_getOp("borderColour",         "black"), borderStyle = openxlsx_getOp("borderStyle",         "thin"), withFilter = openxlsx_getOp("withFilter", FALSE),     keepNA = openxlsx_getOp("keepNA", FALSE), na.string = openxlsx_getOp("na.string"),     name = NULL, sep = ", ", col.names, row.names) {    op <- get_set_options()    on.exit(options(op), add = TRUE)    if (!missing(row.names)) {        warning("Please use 'rowNames' instead of 'row.names'",             call. = FALSE)        rowNames <- row.names    }    if (!missing(col.names)) {        warning("Please use 'colNames' instead of 'col.names'",             call. = FALSE)        colNames <- col.names    }    borders <- borders %||% "none"    borderColour <- borderColour %||% "black"    borderStyle <- borderStyle %||% "thin"    withFilter <- withFilter %||% FALSE    keepNA <- keepNA %||% FALSE    if (is.null(x)) {        return(invisible(0))    }    if (!is.null(xy)) {        if (length(xy) != 2) {            stop("xy parameter must have length 2")        }        startCol <- xy[[1]]        startRow <- xy[[2]]    }    if (!is.numeric(startCol)) {        startCol <- convertFromExcelRef(startCol)    }    startRow <- as.integer(startRow)    assert_class(wb, "Workbook")    assert_true_false(colNames)    assert_true_false(rowNames)    assert_character1(sep)    assert_class(headerStyle, "Style", or_null = TRUE)    borderColour <- validateColour(borderColour, "Invalid border colour")    borderStyle <- validateBorderStyle(borderStyle)[[1]]    hlinkNames <- NULL    if (inherits(x, "hyperlink")) {        hlinkNames <- names(x)        colNames <- FALSE    }    if (inherits(x, "formula")) {        x <- data.frame(X = x, stringsAsFactors = FALSE)        class(x[[1]]) <- ifelse(array, "array_formula", "formula")        colNames <- FALSE    }    if (!is.null(name)) {        ex_names <- regmatches(wb$workbook$definedNames, regexpr("(?<=name=\")[^\"]+",             wb$workbook$definedNames, perl = TRUE))        ex_names <- replaceXMLEntities(ex_names)        if (name %in% ex_names) {            stop(sprintf("Named region with name '%s' already exists!",                 name))        }        else if (grepl("^[A-Z]{1,3}[0-9]+$", name)) {            stop("name cannot look like a cell reference.")        }    }    if (is.vector(x) | is.factor(x) | inherits(x, "Date")) {        colNames <- FALSE    }    x <- openxlsxCoerce(x = x, rowNames = rowNames)    nCol <- ncol(x)    nRow <- nrow(x)    if (nRow == 0 & !colNames) {        return(invisible(0))    }    if (nCol == 0 & !rowNames) {        return(invisible(0))    }    colClasses <- lapply(x, function(x) tolower(class(x)))    colClasss2 <- colClasses    colClasss2[vapply(colClasses, function(i) inherits(i, "formula") &         inherits(i, "hyperlink"), NA)] <- "formula"    if (is.numeric(sheet)) {        sheetX <- wb$validateSheet(sheet)    }    else {        sheetX <- wb$validateSheet(replaceXMLEntities(sheet))        sheet <- replaceXMLEntities(sheet)    }    if (wb$isChartSheet[[sheetX]]) {        stop("Cannot write to chart sheet.")    }    wb$check_overwrite_tables(sheet = sheet, new_rows = c(startRow,         startRow + nRow - 1L + colNames), new_cols = c(startCol,         startCol + nCol - 1L), check_table_header_only = TRUE,         error_msg = "Cannot overwrite table headers. Avoid writing over the header row or see getTables() & removeTables() to remove the table object.")    if (withFilter) {        coords <- data.frame(x = c(startRow, startRow + nRow +             colNames - 1L), y = c(startCol, startCol + nCol -             1L))        ref <- stri_join(getCellRefs(coords), collapse = ":")        wb$worksheets[[sheetX]]$autoFilter <- sprintf("<autoFilter ref=\"%s\"/>",             ref)        l <- convert_to_excel_ref(cols = unlist(coords[, 2]),             LETTERS = LETTERS)        dfn <- sprintf("'%s'!%s", names(wb)[sheetX], stri_join("$",             l, "$", coords[, 1], collapse = ":"))        dn <- sprintf("<definedName name=\"_xlnm._FilterDatabase\" localSheetId=\"%s\" hidden=\"1\">%s</definedName>",             sheetX - 1L, dfn)        if (length(wb$workbook$definedNames) > 0) {            ind <- grepl("name=\"_xlnm._FilterDatabase\"", wb$workbook$definedNames)            if (length(ind) > 0) {                wb$workbook$definedNames[ind] <- dn            }        }        else {            wb$workbook$definedNames <- dn        }    }    wb$writeData(df = x, colNames = colNames, sheet = sheet,         startCol = startCol, startRow = startRow, colClasses = colClasss2,         hlinkNames = hlinkNames, keepNA = keepNA, na.string = na.string,         list_sep = sep)    if (inherits(headerStyle, "Style") & colNames) {        addStyle(wb = wb, sheet = sheet, style = headerStyle,             rows = startRow, cols = 0:(nCol - 1) + startCol,             gridExpand = TRUE, stack = TRUE)    }    if (nRow == 0) {        return(invisible(0))    }    if (!is.null(name)) {        ref1 <- stri_join("$", convert_to_excel_ref(cols = startCol,             LETTERS = LETTERS), "$", startRow)        ref2 <- stri_join("$", convert_to_excel_ref(cols = startCol +             nCol - 1L, LETTERS = LETTERS), "$", startRow + nRow -             1L + colNames)        wb$createNamedRegion(ref1 = ref1, ref2 = ref2, name = name,             sheet = wb$sheet_names[wb$validateSheet(sheet)])    }    borders <- match.arg(borders, c("none", "surrounding", "rows",         "columns", "all"))    if (borders == "none") {        invisible(classStyles(wb, sheet = sheet, startRow = startRow,             startCol = startCol, colNames = colNames, nRow = nrow(x),             colClasses = colClasses, stack = TRUE))    }    else if (borders == "surrounding") {        wb$surroundingBorders(colClasses, sheet = sheet, startRow = startRow +             colNames, startCol = startCol, nRow = nRow, nCol = nCol,             borderColour = list(rgb = borderColour), borderStyle = borderStyle)    }    else if (borders == "rows") {        wb$rowBorders(colClasses, sheet = sheet, startRow = startRow +             colNames, startCol = startCol, nRow = nRow, nCol = nCol,             borderColour = list(rgb = borderColour), borderStyle = borderStyle)    }    else if (borders == "columns") {        wb$columnBorders(colClasses, sheet = sheet, startRow = startRow +             colNames, startCol = startCol, nRow = nRow, nCol = nCol,             borderColour = list(rgb = borderColour), borderStyle = borderStyle)    }    else if (borders == "all") {        wb$allBorders(colClasses, sheet = sheet, startRow = startRow +             colNames, startCol = startCol, nRow = nRow, nCol = nCol,             borderColour = list(rgb = borderColour), borderStyle = borderStyle)    }    invisible(0)})(x = dots[[1L]][[1L]], wb = dots[[2L]][[1L]], sheet = dots[[3L]][[1L]])
 3: mapply(fun, ..., MoreArgs = NULL, SIMPLIFY = FALSE, USE.NAMES = FALSE)
 4: (function (...) mapply(fun, ..., MoreArgs = NULL, SIMPLIFY = FALSE, USE.NAMES = FALSE))(x = list(    list(`1` = 1)), wb = list(new("Workbook", .xData = <environment>)),     sheet = "Sheet 1")
 5: do.call(call_fun, call_params)
 6: do_call_params(writeData, params, x = x, wb = wb, .map = TRUE)
 7: buildWorkbook(x, asTable = asTable, ...)
 8: openxlsx::write.xlsx(as.data.frame(1), tempfile())
An irrecoverable exception occurred. R is aborting now ...
Segmentation fault (core dumped)

And when I comment out DT::renderDataTable(data.table::as.data.table(1)), reproduction is much faster and the stack trace more consistent:

*** recursive gc invocation

Traceback:
 1: (new("defaultBindingFunction", .Data = function (value) {    if (missing(value))         `.->sheetOrder`    else {        methods:::.setDummyField(.self, ".->sheetOrder", "integer",             "sheetOrder", FALSE, value)        value    }}, field = "sheetOrder", className = "integer"))(base::quote(1L))
 2: wb$addWorksheet(sheetName = sheetName, showGridLines = gridLines,     tabColour = tabColour, zoom = zoom[1], oddHeader = headerFooterSub(header),     oddFooter = headerFooterSub(footer), evenHeader = headerFooterSub(evenHeader),     evenFooter = headerFooterSub(evenFooter), firstHeader = headerFooterSub(firstHeader),     firstFooter = headerFooterSub(firstFooter), visible = visible,     paperSize = paperSize, orientation = orientation, vdpi = vdpi,     hdpi = hdpi)
 3: (function (wb, sheetName, gridLines = openxlsx_getOp("gridLines",     TRUE), tabColour = NULL, zoom = 100, header = openxlsx_getOp("header"),     footer = openxlsx_getOp("footer"), evenHeader = openxlsx_getOp("evenHeader"),     evenFooter = openxlsx_getOp("evenFooter"), firstHeader = openxlsx_getOp("firstHeader"),     firstFooter = openxlsx_getOp("firstFooter"), visible = TRUE,     paperSize = openxlsx_getOp("paperSize", 9), orientation = openxlsx_getOp("orientation",         "portrait"), vdpi = openxlsx_getOp("vdpi", 300), hdpi = openxlsx_getOp("hdpi",         300)) {    od <- getOption("OutDec")    options(OutDec = ".")    on.exit(expr = options(OutDec = od), add = TRUE)    if (inherits(wb, "list")) {        wb <- wb[[1]]    }    if (!inherits(wb, "Workbook")) {        stop("wb must be a Workbok", call. = FALSE)    }    gridLines <- gridLines %||% TRUE    paperSize <- paperSize %||% 9    orientation <- orientation %||% "portrait"    vdpi <- vdpi %||% 300    hdpi <- hdpi %||% 300    if (tolower(sheetName) %in% tolower(wb$sheet_names)) {        stop(paste0("A worksheet by the name '", sheetName, "' already exists! Sheet names must be unique case-insensitive."))    }    if (!is.logical(gridLines) | length(gridLines) > 1) {        stop("gridLines must be a logical of length 1.")    }    if (nchar(sheetName) > 31) {        stop(paste0("sheetName '", sheetName, "' too long! Max length is 31 characters."))    }    if (!is.null(tabColour)) {        tabColour <- validateColour(tabColour, "Invalid tabColour in addWorksheet.")    }    if (!is.numeric(zoom)) {        stop("zoom must be numeric")    }    if (!is.character(sheetName)) {        sheetName <- as.character(sheetName)    }    if (!is.null(header) & length(header) != 3) {        stop("header must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(footer) & length(footer) != 3) {        stop("footer must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(evenHeader) & length(evenHeader) != 3) {        stop("evenHeader must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(evenFooter) & length(evenFooter) != 3) {        stop("evenFooter must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(firstHeader) & length(firstHeader) != 3) {        stop("firstHeader must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(firstFooter) & length(firstFooter) != 3) {        stop("firstFooter must have length 3 where elements correspond to positions: left, center, right.")    }    visible <- tolower(visible[1])    if (!visible %in% c("true", "false", "hidden", "visible",         "veryhidden")) {        stop("visible must be one of: TRUE, FALSE, 'hidden', 'visible', 'veryHidden'")    }    orientation <- tolower(orientation)    if (!orientation %in% c("portrait", "landscape")) {        stop("orientation must be 'portrait' or 'landscape'.")    }    vdpi <- as.integer(vdpi)    if (is.na(vdpi)) {        stop("vdpi must be numeric")    }    hdpi <- as.integer(hdpi)    if (is.na(hdpi)) {        stop("hdpi must be numeric")    }    sheetName <- replaceIllegalCharacters(sheetName)    invisible(wb$addWorksheet(sheetName = sheetName, showGridLines = gridLines,         tabColour = tabColour, zoom = zoom[1], oddHeader = headerFooterSub(header),         oddFooter = headerFooterSub(footer), evenHeader = headerFooterSub(evenHeader),         evenFooter = headerFooterSub(evenFooter), firstHeader = headerFooterSub(firstHeader),         firstFooter = headerFooterSub(firstFooter), visible = visible,         paperSize = paperSize, orientation = orientation, vdpi = vdpi,         hdpi = hdpi))})(wb = list(new("Workbook", .xData = <environment>)), sheetName = "Sheet 1")
 4: do.call(call_fun, call_params)
 5: do_call_params(addWorksheet, params, wb = wb)
 6: buildWorkbook(x, asTable = asTable, ...)
 7: openxlsx::write.xlsx(as.data.frame(1), tempfile())
An irrecoverable exception occurred. R is aborting now ...
Segmentation fault (core dumped)

*** recursive gc invocation

Traceback:
 1: (new("defaultBindingFunction", .Data = function (value) {    if (missing(value))         `.->sheetOrder`    else {        methods:::.setDummyField(.self, ".->sheetOrder", "integer",             "sheetOrder", FALSE, value)        value    }}, field = "sheetOrder", className = "integer"))(base::quote(1L))
 2: wb$addWorksheet(sheetName = sheetName, showGridLines = gridLines,     tabColour = tabColour, zoom = zoom[1], oddHeader = headerFooterSub(header),     oddFooter = headerFooterSub(footer), evenHeader = headerFooterSub(evenHeader),     evenFooter = headerFooterSub(evenFooter), firstHeader = headerFooterSub(firstHeader),     firstFooter = headerFooterSub(firstFooter), visible = visible,     paperSize = paperSize, orientation = orientation, vdpi = vdpi,     hdpi = hdpi)
 3: (function (wb, sheetName, gridLines = openxlsx_getOp("gridLines",     TRUE), tabColour = NULL, zoom = 100, header = openxlsx_getOp("header"),     footer = openxlsx_getOp("footer"), evenHeader = openxlsx_getOp("evenHeader"),     evenFooter = openxlsx_getOp("evenFooter"), firstHeader = openxlsx_getOp("firstHeader"),     firstFooter = openxlsx_getOp("firstFooter"), visible = TRUE,     paperSize = openxlsx_getOp("paperSize", 9), orientation = openxlsx_getOp("orientation",         "portrait"), vdpi = openxlsx_getOp("vdpi", 300), hdpi = openxlsx_getOp("hdpi",         300)) {    od <- getOption("OutDec")    options(OutDec = ".")    on.exit(expr = options(OutDec = od), add = TRUE)    if (inherits(wb, "list")) {        wb <- wb[[1]]    }    if (!inherits(wb, "Workbook")) {        stop("wb must be a Workbok", call. = FALSE)    }    gridLines <- gridLines %||% TRUE    paperSize <- paperSize %||% 9    orientation <- orientation %||% "portrait"    vdpi <- vdpi %||% 300    hdpi <- hdpi %||% 300    if (tolower(sheetName) %in% tolower(wb$sheet_names)) {        stop(paste0("A worksheet by the name '", sheetName, "' already exists! Sheet names must be unique case-insensitive."))    }    if (!is.logical(gridLines) | length(gridLines) > 1) {        stop("gridLines must be a logical of length 1.")    }    if (nchar(sheetName) > 31) {        stop(paste0("sheetName '", sheetName, "' too long! Max length is 31 characters."))    }    if (!is.null(tabColour)) {        tabColour <- validateColour(tabColour, "Invalid tabColour in addWorksheet.")    }    if (!is.numeric(zoom)) {        stop("zoom must be numeric")    }    if (!is.character(sheetName)) {        sheetName <- as.character(sheetName)    }    if (!is.null(header) & length(header) != 3) {        stop("header must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(footer) & length(footer) != 3) {        stop("footer must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(evenHeader) & length(evenHeader) != 3) {        stop("evenHeader must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(evenFooter) & length(evenFooter) != 3) {        stop("evenFooter must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(firstHeader) & length(firstHeader) != 3) {        stop("firstHeader must have length 3 where elements correspond to positions: left, center, right.")    }    if (!is.null(firstFooter) & length(firstFooter) != 3) {        stop("firstFooter must have length 3 where elements correspond to positions: left, center, right.")    }    visible <- tolower(visible[1])    if (!visible %in% c("true", "false", "hidden", "visible",         "veryhidden")) {        stop("visible must be one of: TRUE, FALSE, 'hidden', 'visible', 'veryHidden'")    }    orientation <- tolower(orientation)    if (!orientation %in% c("portrait", "landscape")) {        stop("orientation must be 'portrait' or 'landscape'.")    }    vdpi <- as.integer(vdpi)    if (is.na(vdpi)) {        stop("vdpi must be numeric")    }    hdpi <- as.integer(hdpi)    if (is.na(hdpi)) {        stop("hdpi must be numeric")    }    sheetName <- replaceIllegalCharacters(sheetName)    invisible(wb$addWorksheet(sheetName = sheetName, showGridLines = gridLines,         tabColour = tabColour, zoom = zoom[1], oddHeader = headerFooterSub(header),         oddFooter = headerFooterSub(footer), evenHeader = headerFooterSub(evenHeader),         evenFooter = headerFooterSub(evenFooter), firstHeader = headerFooterSub(firstHeader),         firstFooter = headerFooterSub(firstFooter), visible = visible,         paperSize = paperSize, orientation = orientation, vdpi = vdpi,         hdpi = hdpi))})(wb = list(new("Workbook", .xData = <environment>)), sheetName = "Sheet 1")
 4: do.call(call_fun, call_params)
 5: do_call_params(addWorksheet, params, wb = wb)
 6: buildWorkbook(x, asTable = asTable, ...)
 7: openxlsx::write.xlsx(as.data.frame(1), tempfile())
An irrecoverable exception occurred. R is aborting now ...
Segmentation fault (core dumped)

Here's a final, very short version not filling up the temp directory:

df <- data.frame(value = 10:49)
df$group <- paste0("Group", df$value %/% 10)
df$type <- paste0("Type", df$value %% 6)

mean_per_group_and_type <- function(df) {
    split_by <- list(df$group, df$type)
    sep <- "x"
    df_split <- split(df$value, split_by, sep = sep)
    as.data.frame(
        tidyr::pivot_wider(
            tidyr::pivot_longer(
                as.data.frame(lapply(df_split, mean)),
                tidyr::everything(),
                names_to = c("group", "type"),
                names_sep = sep,
            ),
            names_from = "group",
        )
    )
}

while (TRUE) {
    cat(".")
    means <- mean_per_group_and_type(df)
    data.table::as.data.table(1)
    openxlsx::write.xlsx(as.data.frame(1), "tmp.xlsx", overwrite = TRUE)
    saveRDS(ggplot2::ggplot(), "tmp.rds")
    readRDS("tmp.rds")
}

It would be great if this helped anyone reproduce this on their machine, and if someone could point me at the right repository to report this. My money is on base::split or tidyr, but since I have left a trace of 4 issues in various bug trackers already, I'd be happy about a better-founded opinion on where to head next (assuming it's not ggplot itself) ;)

[bersbersbers]

> sessionInfo()
R version 4.1.1 (2021-08-10)
Platform: x86_64-suse-linux-gnu (64-bit)
Running under: openSUSE Leap 15.2

Matrix products: default
BLAS:   /usr/lib64/R/lib/libRblas.so
LAPACK: /usr/lib64/R/lib/libRlapack.so

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C               LC_TIME=en_US.UTF-8       
 [4] LC_COLLATE=en_US.UTF-8     LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
 [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                  LC_ADDRESS=C              
[10] LC_TELEPHONE=C             LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.7        magrittr_2.0.1    munsell_0.5.0     tidyselect_1.1.1  colorspace_2.0-2 
 [6] R6_2.5.1          rlang_0.4.11      fansi_0.5.0       dplyr_1.0.7       tools_4.1.1      
[11] grid_4.1.1        import_1.2.0      gtable_0.3.0      data.table_1.14.2 utf8_1.2.2       
[16] DBI_1.1.1         ellipsis_0.3.2    assertthat_0.2.1  tibble_3.1.5      lifecycle_1.0.1  
[21] crayon_1.4.1      zip_2.2.0         purrr_0.3.4       ggplot2_3.3.5     tidyr_1.1.4      
[26] vctrs_0.3.8       glue_1.4.2        openxlsx_4.2.4    stringi_1.7.5     compiler_4.1.1   
[31] pillar_1.6.3      scales_1.1.1      generics_0.1.0    pkgconfig_2.0.3  
>

(and I can repro this on Windows and WSL, too).

[bersbersbers]

Two more examples:

Repros:

df <- data.frame("1.1"=0, "2.1"=0, "1.2"=0, "2.2"=0)
invisible(data.table::as.data.table(1))

while (TRUE) {
    means <- tidyr::pivot_longer(df, tidyr::everything(), 
        names_to = c("g", "t"), names_sep = "\\.")
    openxlsx::write.xlsx(as.data.frame(1), "tmp.xlsx", overwrite = TRUE)
    saveRDS(ggplot2::ggplot(), "tmp.rds")
    readRDS("tmp.rds")
}

Does not:

df <- data.frame("A"=1, "B"=2)
invisible(data.table::as.data.table(1))

while (TRUE) {
    means <- tidyr::pivot_longer(df, tidyr::everything())
    openxlsx::write.xlsx(as.data.frame(1), "tmp.xlsx", overwrite = TRUE)
    saveRDS(ggplot2::ggplot(), "tmp.rds")
    readRDS("tmp.rds")
}

[bersbersbers]

No loop required with gctorture:

gctorture2(500)
df <- data.frame(A.A = 0, A.B = 0, B.A = 0, B.B = 0)
invisible(data.table::as.data.table(1))

x <- tidyr::pivot_longer(df, tidyr::everything(), names_to = c("C", "D"), names_sep = "\\.")
openxlsx::write.xlsx(as.data.frame(1), "tmp.xlsx", overwrite = TRUE)
saveRDS(ggplot2::ggplot(), "tmp.rds")

x <- tidyr::pivot_longer(df, tidyr::everything(), names_to = c("C", "D"), names_sep = "\\.")
saveRDS(ggplot2::ggplot(), "tmp.rds")

[bersbersbers]

These repro steps work without any ggplot and saveRDS at all, so I guess the issue is unrelated to ggplot:

df <- data.frame(A.A = 0, A.B = 0, B.A = 0, B.B = 0)

invisible(gctorture2(500))

invisible(data.table::as.data.table(1))

x <- tidyr::build_longer_spec(
    df, tidyr::everything(), names_to = c("C", "D"), names_sep = "\\."
)

openxlsx::write.xlsx(as.data.frame(1), "tmp.xlsx", overwrite = TRUE)

print(tidyr::build_longer_spec(
    df, tidyr::everything(), names_to = c("C", "D"), names_sep = "\\."
))

print(tidyr::build_longer_spec(
    df, tidyr::everything(), names_to = c("C", "D"), names_sep = "\\."
))

Candidates remaining: data.table, openxlsx, tidyr, and R base.

[bersbersbers]

Fyi, apparently fixed in r-lib/cpp11#245.