diff --git a/libguile/filesys.c b/libguile/filesys.c index b49d488f1..a2db6996f 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -30,6 +30,7 @@ #endif #include +#include #include #include @@ -1661,6 +1662,27 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_canonicalize_path, "canonicalize-path", 1, 0, 0, + (SCM path), + "Return the canonical path of @var{path}. A canonical path has\n" + "no @code{.} or @code{..} components, nor any repeated path\n" + "separators (@code{/}) nor symlinks.\n\n" + "Raises an error if any component of @var{path} does not exist.") +#define FUNC_NAME s_scm_canonicalize_path +{ char *str, *canon; + + SCM_VALIDATE_STRING (1, path); + + str = scm_to_locale_string (path); + canon = canonicalize_file_name (str); + free (str); + + if (canon) + return scm_take_locale_string (canon); + else + SCM_SYSERROR; +} +#undef FUNC_NAME diff --git a/libguile/filesys.h b/libguile/filesys.h index 3e5c83e76..b9a6ca8a6 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -65,6 +65,7 @@ SCM_API SCM scm_lstat (SCM str); SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile); SCM_API SCM scm_dirname (SCM filename); SCM_API SCM scm_basename (SCM filename, SCM suffix); +SCM_API SCM scm_canonicalize_path (SCM path); SCM_INTERNAL void scm_init_filesys (void); diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index 9f0ff2f3d..dfe8823be 100644 --- a/module/system/base/compile.scm +++ b/module/system/base/compile.scm @@ -131,7 +131,8 @@ (else (car %load-compiled-extensions)))) (and %compile-fallback-path (let ((f (string-append - %compile-fallback-path "/" file (compiled-extension)))) + %compile-fallback-path "/" (canonicalize-path file) + (compiled-extension)))) (and (false-if-exception (ensure-writable-dir (dirname f))) f))))