# Project: RcppOctave
#
# Author: Renaud Gaujoux
# Created: Jul 21, 2015
###############################################################################
slashes <- function(x) gsub("\\", "/", x, fixed = TRUE)
Sys.path <- function(normalize = TRUE){
path <- strsplit(Sys.getenv('PATH'), .Platform$path.sep)[[1L]]
if( normalize ) path <- normalizePath(path, mustWork = FALSE)
path
}
ac_msg_checking <- function(..., appendLF = FALSE){
message("Checking ", ..., "... ", appendLF = appendLF)
}
ac_msg_result <- function(...) message(...)
ac_msg_notice <- function(...) message("configure: ", ...)
#' Retrieve a Program Configuration Variable
ac_prog_var <- function(prog, varname, msg = '', intern = FALSE, slashes = FALSE){
if( is.character(intern) ) intern <- nzchar(intern)
if( !nzchar(msg) ) msg <- paste(basename(prog), varname)
message(sprintf("Checking %s... ", msg), appendLF = FALSE)
cmd <- sprintf('"%s" --print %s', prog, varname)
value <- shell(cmd, intern = TRUE)
if( slashes ) value <- slashes(value)
if( !intern ){
message(value)
cat(value)
}
invisible(value)
}
#' Retrieve a Program Configuration Path
ac_prog_varpath <- function(...){
ac_prog_var(..., slashes = TRUE)
}
ac_shell <- function(cmd, msg, intern = FALSE, slashes = TRUE){
if( is.character(intern) ) intern <- nzchar(intern)
message(sprintf("Checking %s... ", msg), appendLF = FALSE)
value <- shell(cmd, intern = TRUE, ignore.stderr = TRUE)
if( slashes ) value <- slashes(value)
if( !intern ){
message(value)
cat(value)
}
invisible(value)
}
#' Finds a Program Location
ac_path_prog <- function(prog, notfound = '', path = "", msg = "", mode = c('first', 'all', 'deep'), strip.flags = FALSE, intern = FALSE){
strip.flags <- !missing(strip.flags) || !strip.flags
if( strip.flags ) prog <- strsplit(prog, ' -', fixed = TRUE)[[1L]][1L]
if( !nzchar(msg) ) msg <- prog
path <- path[nzchar(path)]
if( !length(path) ) path <- Sys.path()
if( length(path) == 1L ) msg <- sprintf("%s [in %s]", msg, path)
message(sprintf("Checking %s... ", msg), appendLF = FALSE)
if( missing(mode) || !nzchar(mode) ) mode <- 'first'
mode <- match.arg(mode)
res <- sapply(path, function(p){
if( mode == 'deep' ) f <- list.files(p, recursive = TRUE, pattern = prog, full.names = TRUE)
else f <- Sys.which2(prog, p)
# remove duplicates
if( length(f) > 1L ){
f <- f[order(nchar(basename(f)), decreasing = TRUE)]
f <- f[!duplicated(tools::md5sum(f))]
}
f
})
# remove empty elements
res <- unlist(res[lengths(res) > 0], use.names = FALSE)
# slashes
res <- slashes(res[nzchar(res)])
if( mode == 'first' ) res <- head(res, 1L)
res <- unname(res)
if( !length(res) ){
message('no')
if( !intern ) cat(notfound)
}else{
if( length(res) == 1L ) message(res)
else{
message(sprintf('multiple [%i]', length(res)))
lapply(paste(' *', res), message)
}
if( !intern ) cat(res, sep = "\n")
}
invisible(res)
}
strm <- function(x) message(paste0(capture.output(str(x)), collapse = "\n"))
Sys.which2 <- function(names, path = ""){
if( !nzchar(path) ) path <- Sys.path()
# backup and restore original PATH
PATH <- Sys.getenv('PATH')
on.exit( Sys.setenv(PATH = PATH) )
res <- sapply(path, function(p){
Sys.setenv(PATH=p)
normalizePath(Sys.which(names), mustWork = FALSE)
}
)
# slashes
res <- slashes(res[nzchar(res)])
unname(res)
}
#' Finds Rtools
ac_path_rtools <- function(gcc, intern = FALSE){
message("Checking Rtools ... ", appendLF = FALSE)
# look for file VERSION.txt that contains the string "rtools"
parts <- strsplit(gcc, '/')[[1L]]
path <- NULL
for( i in 1:length(parts) ){
p <- do.call(file.path, as.list(head(parts, i)))
if( file.exists(version_file <- file.path(p, 'VERSION.txt')) &&
length(grep('rtools', readLines(version_file), ignore.case = TRUE)) ){
path <- p
break
}
}
if( !length(path) ){ # not found
path <- slashes(normalizePath(file.path(dirname(gcc), "../..")))
# if( !intern ) cat("")
message("no")
ac_msg_notice("using guessed Rtools path ", appendLF = FALSE)
}
# else
{ # found
if( !intern ) cat(path)
message(path)
invisible(path)
}
}
#' Finds a gcc version in Rtools/ that is compatible with given gcc version
ac_cc_compatible <- function(target, rtools, absolute = TRUE, nolookup = TRUE){
r_gcc <- NULL
if( file_test("-f", rtools) ){
r_gcc <- rtools
rtools <- ac_path_rtools(rtools, intern = TRUE)
}
if( !length(rtools)){
message("none")
cat('')
return(invisible())
}
if( !nolookup ) path <- ac_path_prog('gcc[-0-9.]*.exe$', path = rtools, msg = "all Rtools compiler(s)", mode = 'deep', intern = TRUE)
else path <- r_gcc
.cc_spec <- function(cc){
v <- shell(sprintf("\"%s\" -dumpversion", cc), intern = TRUE)
m <- shell(sprintf("\"%s\" -dumpmachine", cc), intern = TRUE)
res <- list(version = package_version(v), machine = m, full = paste0(m,'-', v))
# print(res)
}
ac_msg_checking("Octave compiler version")
oct_spec <- .cc_spec(target)
ac_msg_result(oct_spec$full)
ac_msg_checking("compatible Rtools compiler")
# give priority to current compiler if any
if( !is.null(r_gcc) ){
m <- match(normalizePath(path), normalizePath(r_gcc))
path <- path[order(m)]
}
for( p in path ){
spec <- .cc_spec(p)
if( spec$full == oct_spec$full ||
( normalizePath(p) == normalizePath(r_gcc) && spec$version >= oct_spec$version) ||
( spec$machine == oct_spec$machine && spec$version >= oct_spec$version)
){
bin <- dirname(p)
message(sprintf("%s [%s]", basename(p), bin))
# check compiler aliases exist therein
# gcc
message("Checking gcc alias... ", appendLF = FALSE)
if( !file.exists(alias <- file.path(bin, 'gcc.exe')) ||
tools::md5sum(alias) != tools::md5sum(p) ){
break
}
message(alias)
# g++
cxx <- ac_path_prog('g++.exe', path = bin, msg = "g++", intern = TRUE)
if( !nzchar(cxx) ) break
p <- gsub(rtools, '', bin, fixed = TRUE)
cat(p)
if( !absolute ) p <- gsub(rtools, "", p, fixed = TRUE)
return(invisible(p))
}
}
# not found
message('none')
cat('')
invisible()
}
ac_cc_compatible_octave <- function(dir, cc, nolookup = FALSE){
if( is.character(nolookup) ) nolookup <- nzchar(nolookup)
r_gcc <- ac_path_prog(cc, strip.flags = TRUE, msg = 'current Rtools compiler', intern = TRUE)
# check octave-config is in the directory
octave_config <- ac_path_prog('octave-config', path = dir, intern = TRUE)
if( !length(octave_config) ){
return(invisible())
}
# get Octave version
ac_msg_checking("Octave version")
ver <- shell(sprintf("%s -p VERSION", octave_config), intern = TRUE)
ac_msg_result(ver)
lookup_dir <- dir
if( compareVersion(ver, "3.6.4") <= 0 ){
lookup_dir <- c(lookup_dir, file.path(dir, "../mingw/bin"))
}
octave_gcc <- ac_path_prog('gcc.exe', path = lookup_dir, msg = 'Octave compiler', intern = TRUE)
ac_cc_compatible(octave_gcc, r_gcc, nolookup = nolookup)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.