diff options
-rw-r--r-- | libguile/load.c | 36 | ||||
-rw-r--r-- | module/system/base/compile.scm | 5 |
2 files changed, 24 insertions, 17 deletions
diff --git a/libguile/load.c b/libguile/load.c index d8139e657..890b0f824 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2009 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -247,24 +247,28 @@ scm_init_load_path () #endif /* SCM_LIBRARY_DIR */ { - char *home; + char cachedir[1024]; + char *e; +#ifdef HAVE_GETPWENT + struct passwd *pwd; +#endif - home = getenv ("HOME"); +#define FALLBACK_DIR "guile/ccache/"SCM_EFFECTIVE_VERSION + + if ((e = getenv ("XDG_CACHE_HOME"))) + snprintf (cachedir, sizeof(cachedir), "%s" FALLBACK_DIR, e); + else if ((e = getenv ("HOME"))) + snprintf (cachedir, sizeof(cachedir), "%s/.cache/" FALLBACK_DIR, e); #ifdef HAVE_GETPWENT - if (!home) - { - struct passwd *pwd; - pwd = getpwuid (getuid ()); - if (pwd) - home = pwd->pw_dir; - } + else if ((pwd = getpwuid (getuid ())) && pwd->pw_dir) + snprintf (cachedir, sizeof(cachedir), "%s/.cache/" FALLBACK_DIR, + pwd->pw_dir); #endif /* HAVE_GETPWENT */ - if (home) - { char buf[1024]; - snprintf (buf, sizeof(buf), - "%s/.guile-ccache/" SCM_EFFECTIVE_VERSION, home); - *scm_loc_compile_fallback_path = scm_from_locale_string (buf); - } + else + cachedir[0] = 0; + + if (cachedir[0]) + *scm_loc_compile_fallback_path = scm_from_locale_string (cachedir); } env = getenv ("GUILE_LOAD_PATH"); diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index dfe8823be..22f8e04f1 100644 --- a/module/system/base/compile.scm +++ b/module/system/base/compile.scm @@ -131,7 +131,10 @@ (else (car %load-compiled-extensions)))) (and %compile-fallback-path (let ((f (string-append - %compile-fallback-path "/" (canonicalize-path file) + %compile-fallback-path + ;; no need for '/' separator here, canonicalize-path + ;; will give us an absolute path + (canonicalize-path file) (compiled-extension)))) (and (false-if-exception (ensure-writable-dir (dirname f))) f)))) |