Running ‘testthat.R’ [4s/13s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > library(testthat)
  > library(traitdataform)
  > 
  > test_check("traitdataform")
  
   *** caught segfault ***
  address (nil), cause 'unknown'
  
  Traceback:
   1: curl::curl_fetch_memory(x$url$url, handle = x$url$handle)
   2: crul_fetch(opts)
   3: private$make_request(rr)
   4: cli$get(query = args, ...)
   5: gbif_name_backbone(sciname)
   6: FUN(X[[i]], ...)
   7: lapply(sciname, get_gbifd_help, messages = messages, rows = rows,     method = method)
   8: setNames(lapply(sciname, get_gbifd_help, messages = messages,     rows = rows, method = method), sciname)
   9: taxize::get_gbifid_(x, messages = verbose)
  10: (function (x, subspecies = TRUE, higherrank = FALSE, verbose = FALSE,     fuzzy = TRUE, conf_threshold = 90, resolve_synonyms = TRUE) {    matchtype = status = confidence = NULL    temp <- taxize::get_gbifid_(x, messages = verbose)    for (i in 1:length(temp)) {        warning_i = ""        synonym_i = FALSE        if (nrow(temp[[i]]) == 0) {            warning_i <- paste("No matching species concept!")            temp[[i]] <- data.frame(scientificName = x[i], matchtype = "NONE",                 status = "NA", rank = "species")        }        if (!fuzzy & nrow(temp[[i]]) > 0) {            temp[[i]] <- subset(temp[[i]], matchtype != "FUZZY")            if (nrow(temp[[i]]) == 0) {                warning_i <- paste(warning_i, "Fuzzy matching might yield results.")            }        }        if (!is.null(conf_threshold) & nrow(temp[[i]]) > 0) {            temp[[i]] <- subset(temp[[i]], confidence >= conf_threshold)            if (nrow(temp[[i]]) == 0) {                temp[[i]] <- data.frame(scientificName = x[i],                   matchtype = "NONE", status = "NA", rank = "species")                warning_i <- paste(warning_i, "No match! Check spelling or lower confidence threshold!")            }        }        if (any(temp[[i]]$status == "ACCEPTED")) {            temp[[i]] <- subset(temp[[i]], status == "ACCEPTED")            temp[[i]] <- subset(temp[[i]], temp[[i]]$confidence ==                 max(temp[[i]]$confidence))            if (nrow(temp[[i]]) > 1) {                temp[[i]] <- temp[[i]][1, ]                warning_i <- paste(warning_i, "Selected first of multiple equally ranked concepts!")            }        }        if (!any(temp[[i]]$status == "ACCEPTED") & any(temp[[i]]$status ==             "SYNONYM")) {            if (resolve_synonyms) {                keep <- temp[i]                temp[i] <- taxize::get_gbifid_(temp[[i]]$species[which.max(temp[[i]]$confidence)],                   messages = verbose)                if (temp[[i]][1, ]$status == "ACCEPTED") {                  temp[[i]] <- subset(temp[[i]], matchtype ==                     "EXACT" & status == "ACCEPTED")                  temp[[i]] <- subset(temp[[i]], temp[[i]]$confidence ==                     max(temp[[i]]$confidence))                  if (nrow(temp[[i]]) > 1) {                    temp[[i]] <- temp[[i]][1, ]                    warning_i <- paste(warning_i, "Selected first of multiple equally ranked concepts!")                  }                  warning_i <- paste(warning_i, "A synonym was mapped to the accepted species concept!",                     sep = " ")                  synonym_i = TRUE                }                else {                  status <- temp[[i]][1, ]$status                  temp[i] <- keep                  if (nrow(temp[[i]]) > 1) {                    temp[[i]] <- temp[[i]][1, ]                    warning_i <- paste(warning_i, "Selected first of multiple equally ranked concepts!")                  }                  warning_i <- paste0(warning_i, " Resolved synonym '",                     temp[[i]]$species, "' is labelled '", status,                     "'. Clarification required!")                }            }            else {                temp[[i]] <- subset(temp[[i]], status == "SYNONYM")                temp[[i]] <- subset(temp[[i]], temp[[i]]$confidence ==                   max(temp[[i]]$confidence))                warning_i <- paste(warning_i, "The provided taxon seems to be a synonym of '",                   temp[[i]]$species, "'!", sep = "")            }        }        if (all(temp[[i]]$status == "DOUBTFUL")) {            temp[[i]] <- subset(temp[[i]], status == "DOUBTFUL")            warning_i <- paste(warning_i, "Mapped concept is labelled 'DOUBTFUL'!")            temp[[i]] <- subset(temp[[i]], temp[[i]]$confidence ==                 max(temp[[i]]$confidence))            if (nrow(temp[[i]]) > 1) {                temp[[i]] <- temp[[i]][1, ]                warning_i <- paste(warning_i, "Selected first of multiple equally ranked concepts!")            }        }        rankorder <- c("kingdom", "phylum", "class", "order",             "family", "genus", "species", "subspecies")        if (match(temp[[i]]$rank, rankorder) > 7 & !subspecies) {            if (length(strsplit(as.character(temp[[i]]$canonicalname),                 " ")[[1]]) > 2) {                temp[i] <- taxize::get_gbifid_(paste(strsplit(names(temp[i]),                   " ")[[1]][1:2], collapse = " "), messages = verbose)                temp[[i]] <- subset(temp[[i]], temp[[i]]$confidence ==                   max(temp[[i]]$confidence))                warning_i <- paste(warning_i, "Subspecies has been remapped to species concept!",                   sep = " ")            }            else {                temp[[i]] <- data.frame(scientificName = x[i],                   matchtype = "NONE", rank = "subspecies")                warning_i <- paste(warning_i, "No mapping of subspecies name to species was possible!",                   sep = " ")            }        }        if (temp[[i]]$matchtype == "HIGHERRANK") {            if (higherrank) {                temp[[i]] <- subset(temp[[i]], temp[[i]]$confidence ==                   max(temp[[i]]$confidence))                warning_i <- paste(warning_i, "No matching species concept! Entry has been mapped to higher taxonomic level.")            }            else {                temp[[i]] <- data.frame(scientificName = x[i],                   matchtype = "NONE", rank = "highertaxon")                warning_i <- paste("No matching species concept!",                   warning_i)            }        }        if (temp[[i]]$matchtype != "NONE") {            temp[[i]] <- data.frame(scientificName = x[i], synonym = synonym_i,                 scientificNameStd = temp[[i]]$canonicalname,                 author = sub(paste0(temp[[i]]$canonicalname,                   " "), "", temp[[i]]$scientificname), taxonRank = temp[[i]]$rank,                 confidence = temp[[i]]$confidence, kingdom = if (is.null(temp[[i]]$kingdom))                   NA                else temp[[i]]$kingdom, phylum = if (is.null(temp[[i]]$phylum))                   NA                else temp[[i]]$phylum, class = if (is.null(temp[[i]]$class))                   NA                else temp[[i]]$class, order = if (is.null(temp[[i]]$order))                   NA                else temp[[i]]$order, family = if (is.null(temp[[i]]$family))                   NA                else temp[[i]]$family, genus = if (is.null(temp[[i]]$genus))                   NA                else temp[[i]]$genus, taxonomy = "GBIF Backbone Taxonomy",                 taxonID = paste0("http://www.gbif.org/species/",                   temp[[i]]$usagekey, ""), warnings = NA)        }        else {            temp[[i]] <- data.frame(scientificName = x[i], warnings = NA)        }        temp[[i]]$warnings <- warning_i        if (verbose & nchar(warning_i) >= 1)             warning(warning_i)    }    out <- data.table::rbindlist(temp, fill = TRUE)    class(out) <- c("data.frame", "taxonomy")    return(out)})(c("Abax_parallelepipedus", "Calathus_cinctus", "Dromius_angustus", "Limodromus_assimilis", "Miscodira_artica", "Notiophilus_aquaticus", "Trichocellus_placidus"), subspecies = 1, higherrank = 0, verbose = 0,     fuzzy = 1, conf_threshold = 90, resolve_synonyms = 1)
  11: do.call(method, c(list(levels(droplevels(as.factor(x$scientificName)))),     method_options))
  12: standardise_taxa(dataset1[c(1, 83, 166, 206, 240, 286, 320, 323,     361, 306, 440), ])
  13: eval(code, test_env)
  14: eval(code, test_env)
  15: withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error)
  16: doTryCatch(return(expr), name, parentenv, handler)
  17: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  18: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  19: doTryCatch(return(expr), name, parentenv, handler)
  20: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
  21: tryCatchList(expr, classes, parentenv, handlers)
  22: tryCatch(withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error), error = handle_fatal,     skip = function(e) {    })
  23: test_code(desc, code, env = parent.frame())
  24: test_that("mapping of taxa works", {    pulldata("carabids")    dataset1 <- as.traitdata(carabids)    dd1 <- standardise_taxa(dataset1[c(1, 83, 166, 206, 240,         286, 320, 323, 361, 306, 440), ])    expect_equal(as.character(dd1$scientificNameStd), c("Abax parallelepipedus",         "Abax parallelepipedus", "Calathus cinctus", "Calathus cinctus",         "Dromius angustus", "Platynus assimilis", "Platynus assimilis",         NA, NA, "Notiophilus aquaticus", "Dicheirotrichus placidus"))    expect_true(all(c("scientificNameStd", "taxonID", "warnings") %in%         names(dd1)))    dd1 <- standardise_taxa(dataset1[c(1, 83, 166, 206, 240,         286, 320, 323, 361, 306, 440), ], method_options = c(resolve_synonyms = FALSE))    expect_equal(as.character(dd1$scientificNameStd), c("Abax parallelepipedus",         "Abax parallelepipedus", "Calathus cinctus", "Calathus cinctus",         "Dromius angustus", "Limodromus assimilis", "Limodromus assimilis",         NA, NA, "Notiophilus aquaticus", "Trichocellus placidus"))    expect_true(all(c("scientificNameStd", "taxonID", "warnings") %in%         names(dd1)))    pulldata("arthropodtraits")    dataset2 <- as.traitdata(arthropodtraits)    dd2 <- standardise_taxa(dataset2[c(215, 476, 774, 975, 1445,         1706, 3437, 3905, 4667, 5396, 5896, 8755, 8966), ])    expect_equal(as.character(dd2$scientificNameStd), c("Acalypta parvula",         "Kosswigianella denticauda", "Kosswigianella spinosa",         "Kosswigianella spinosa", "Kosswigianella spinosa", "Aspidapion radiolus",         "Aspidapion radiolus", "Aspidapion radiolus", "Mocyta fungi",         "Gymnetron ictericus", "Gymnetron ictericus", "Gymnetron ictericus",         "Trigonocranus emmeae"))    expect_true(all(c("scientificNameStd", "taxonID", "warnings") %in%         names(dd2)))})
  25: eval(code, test_env)
  26: eval(code, test_env)
  27: withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error)
  28: doTryCatch(return(expr), name, parentenv, handler)
  29: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  30: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  31: doTryCatch(return(expr), name, parentenv, handler)
  32: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
  33: tryCatchList(expr, classes, parentenv, handlers)
  34: tryCatch(withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error), error = handle_fatal,     skip = function(e) {    })
  35: test_code(NULL, exprs, env)
  36: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  37: force(code)
  38: with_reporter(reporter = reporter, start_end_reporter = start_end_reporter,     {        reporter$start_file(basename(path))        lister$start_file(basename(path))        source_file(path, new.env(parent = env), chdir = TRUE,             wrap = wrap)        reporter$end_context()        reporter$end_file()    })
  39: FUN(X[[i]], ...)
  40: lapply(paths, test_file, env = env, reporter = current_reporter,     start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  41: force(code)
  42: with_reporter(reporter = current_reporter, results <- lapply(paths,     test_file, env = env, reporter = current_reporter, start_end_reporter = FALSE,     load_helpers = FALSE, wrap = wrap))
  43: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure,     stop_on_warning = stop_on_warning, wrap = wrap)
  44: test_dir(path = test_path, reporter = reporter, env = env, filter = filter,     ..., stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     wrap = wrap)
  45: test_package_dir(package = package, test_path = test_path, filter = filter,     reporter = reporter, ..., stop_on_failure = stop_on_failure,     stop_on_warning = stop_on_warning, wrap = wrap)
  46: test_check("traitdataform")
  An irrecoverable exception occurred. R is aborting now ...
  Segmentation fault