R/CheckLinkedVersion.R

In RcppAlgos: High Performance Tools for Combinatorics and Computational Mathematics

# ------------------------------------------------------------------------------
# Linked DLL version check (adapted from rlang)
#
# This file contains a slightly modified version of the standalone
# `check_linked_version()` implementation from the rlang package.
#
# Original source:
#   https://github.com/r-lib/rlang/blob/main/R/standalone-linked-version.R
#
# Copyright:
#   rlang authors
#
# License:
#   Unlicense (https://unlicense.org)
#
# Modifications:
#   Adapted for use in RcppAlgos to verify that the loaded shared library
#   matches the installed package version and to prevent crashes caused by
#   stale compiled binaries during development or installation issues.
#
# Full credit goes to the rlang team for the original implementation and design.
# ------------------------------------------------------------------------------
#
# nocov start

CheckLinkedVersion <- local({
    # Keep in sync with standalone-downstream-deps.R
    howto_reinstall_msg <- function(pkg) {
        os <- tolower(Sys.info()[["sysname"]])

        if (os == "windows") {
            url <- "https://github.com/jennybc/what-they-forgot/issues/62"
            c(
                i = sprintf("Please update %s to the latest version.", pkg),
                i = sprintf(
                    "Updating packages on Windows requires precautions:\n  <%s>",
                    url
                )
            )
        } else {
            c(
                i = sprintf(
                    "Please update %s with `install.packages(\"%s\")` and restart R.",
                    pkg,
                    pkg
                )
            )
        }
    }

    function(pkg) {
        ver <- utils::packageVersion(pkg)

        ns <- asNamespace(pkg)
        linked_ver_ptr <- ns[[paste0("_", pkg, "_linked_version")]]
        if (is.null(linked_ver_ptr)) {
            linked_ver <- ""
        } else {
            # Construct call to avoid NOTE when argument to `.Call()` is not
            # statically analysable
            linked_ver <- do.call(".Call", list(linked_ver_ptr))
        }

        if (nzchar(linked_ver) && ver == linked_ver) {
            return(invisible(NULL))
        }

        header <- sprintf("The %s package is not properly installed.", pkg)

        if (nzchar(linked_ver)) {
            msg <- c(
                x = sprintf(
                    "The DLL version (%s) does not correspond to the package version (%s).",
                    linked_ver,
                    ver
                )
            )
        } else {
            # Package does not have a version pointer. This happens when DLL
            # updating fails for the first version that includes the pointer.
            msg <- c(
                x = "The DLL version does not correspond to the package version."
            )
        }

        msg <- c(msg, howto_reinstall_msg(pkg))
        msg <- paste(c(header, msg), collapse = "\n")
        stop(msg, call. = FALSE)
    }
})

# nocov end