mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
new function: canonicalize-path. use when autocompiling
* libguile/filesys.h: * libguile/filesys.c (scm_canonicalize_path): New function, canonicalize-path. * module/system/base/compile.scm (compiled-file-name): Canonicalize the filename so that compiling e.g. ../foo.scm doesn't compile to ~/.guile-ccache/1.9/../foo.scm.
This commit is contained in:
parent
ffca4c2203
commit
25b82b3485
3 changed files with 25 additions and 1 deletions
|
@ -30,6 +30,7 @@
|
|||
#endif
|
||||
|
||||
#include <alloca.h>
|
||||
#include <canonicalize.h>
|
||||
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
|
@ -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
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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))))
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue