R crashes when fitting truncated normal distribution

The following code crashes every time I run it and on two different R versions. I bet I'm doing something wrong (maybe I inadvertently drive the optimization somewhere it can't go?) but I fail to see what. My idea here is to help the MLE the most I can by providing almost good a, mean and sd. As you can see I generate a data sample quite close to the fitting parameters (on purpose).

library(truncnorm)
library(fitdistrplus)
fitdist(rtruncnorm(100, a=8, mean=10, sd=1),
        "truncnorm", fix.arg=list(a=8),
        start = list(mean = 10+0.5, sd = 1+0.1))

This code crashes (so it quits the R session) with error : "Process R floating point exception at Wed Apr 27 18:03:47 2022" on Linux and "session aborted" on RStudio on Windows. I tried several start parameters for mean and sd but the result is the same: crash. I use R version 4.0.3.

Solution

tl;dr fitdistr() tries to test the distribution function by passing it an x value of numeric(0), which crashes dtruncnorm(). You could probably write a wrapper that didn't do that.

Debugging sequence

library(truncnorm)
library(fitdistrplus)
set.seed(101)
x <- rtruncnorm(100, a=8, mean=10, sd=1)
debug(fitdist)
fitdist(x,
        distr = "truncnorm", fix.arg=list(a=8),
        start = list(mean = 10+0.5, sd = 1+0.1))

Fails in

 resdpq <- testdpqfun(distname, dpq2test, start.arg = arg_startfix$start.arg, 
    fix.arg = arg_startfix$fix.arg, discrete = discrete)

More minimal/deeper example:

library(truncnorm)
library(fitdistrplus)
distname <- "truncnorm"
dpq2test <- c("d", "p")
arg_startfix <- list(start.arg = list(mean = 10.5, sd = 1.1), fix.arg = list(
    a = 8))
discrete <- FALSE
debug(fitdistrplus:::testdpqfun)
fitdistrplus:::testdpqfun(distname, dpq2test, start.arg = arg_startfix$start.arg, 
    fix.arg = arg_startfix$fix.arg, discrete = discrete)

So we don't even need x!

Fails at

res <- rbind(res, test1fun(paste0("d", distr), start.arg, fix.arg))

So:

library(truncnorm)
library(fitdistrplus)
arg_startfix <- list(start.arg = list(mean = 10.5, sd = 1.1), fix.arg = list(
    a = 8))
fitdistrplus:::test1fun("dtruncnorm",
   arg_startfix$start.arg, 
    fix.arg = arg_startfix$fix.arg)

Which gets us down to

 res0 <- try(do.call(fn, c(list(numeric(0)), start.arg, fix.arg)), 
    silent = TRUE)

Which suggests that just

dtruncnorm(numeric(0))

is sufficient to trigger the bug.