1#' Is a compiler available?
2#'
3#' `has_devel` returns `TRUE` or `FALSE`. `check_devel`
4#' throws an error if you don't have developer tools installed. Implementation
5#' based on a suggestion by Simon Urbanek. End-users (particularly those on
6#' Windows) should generally run [check_build_tools()] rather than
7#' [check_compiler()].
8#'
9#' @export
10#' @inheritParams has_rtools
11#' @seealso [check_build_tools()]
12#' @examples
13#' has_compiler()
14#' check_compiler()
15#'
16#' with_build_tools(has_compiler())
17has_compiler <- function(debug = FALSE) {
18  if (!debug && cache_exists("has_compiler")) {
19    return(cache_get("has_compiler"))
20  }
21
22  foo_path <- file.path(tempdir(), "foo.c")
23  cat("void foo(int *bar) { *bar=1; }\n", file = foo_path)
24  on.exit(unlink(foo_path))
25
26  res <- tryCatch({
27    if (debug)
28      message("Trying to compile a simple C file")
29
30    callr::rcmd_safe(
31      "SHLIB",
32      "foo.c",
33      wd = tempdir(),
34      show = debug,
35      echo = debug,
36      fail_on_status = TRUE,
37      stderr = "2>&1"
38    )
39
40    if (debug)
41      message("")
42    dylib <- file.path(tempdir(), paste0("foo", .Platform$dynlib.ext))
43    on.exit(unlink(dylib), add = TRUE)
44
45    dll <- dyn.load(dylib)
46    on.exit(dyn.unload(dylib), add = TRUE)
47
48    .C(dll$foo, 0L)[[1]] == 1L
49  }, error = function(e) {
50    FALSE
51  })
52
53  cache_set("has_compiler", res)
54  res
55}
56
57#' @export
58#' @rdname has_compiler
59check_compiler <- function(debug = FALSE) {
60  if (!has_compiler(debug))
61    stop("Failed to compile C code", call. = FALSE)
62
63  TRUE
64}
65
66#' @export
67#' @rdname has_compiler
68#' @usage NULL
69has_devel <- check_build_tools
70
71# The checking code looks for the objects in the package namespace, so defining
72# dll here removes the following NOTE
73# Registration problem:
74#   Evaluating 'dll$foo' during check gives error
75# 'object 'dll' not found':
76#    .C(dll$foo, 0L)
77# See https://github.com/wch/r-source/blob/d4e8fc9832f35f3c63f2201e7a35fbded5b5e14c/src/library/tools/R/QC.R#L1950-L1980
78# Setting the class is needed to avoid a note about returning the wrong class.
79# The local object is found first in the actual call, so current behavior is
80# unchanged.
81dll <- list(foo = structure(list(), class = "NativeSymbolInfo"))
82