summaryrefslogtreecommitdiff
path: root/module/system/base/compile.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-06-30 16:07:17 +0200
committerAndy Wingo <wingo@pobox.com>2011-06-30 16:07:17 +0200
commit6934d9e75fde9c880b39faa19237b041495c8531 (patch)
tree63db3896a3de0b59fc164dc75eebb48b005a4ed1 /module/system/base/compile.scm
parent94906b754120343f1e767d2feadc2be5666c70ed (diff)
downloadguile-6934d9e75fde9c880b39faa19237b041495c8531.tar.gz
fix generation of auto-compiled file names on mingw systems
* libguile/load.c (canonical_to_suffix, scm_primitive_load_path): * module/ice-9/boot-9.scm (load-in-vicinity): * module/system/base/compile.scm (compiled-file-name): If the canonical path of a file is a DOS-style path with a drive letter, turn it into a path suffix it by removing the colon and prefixing a "/". Inspired by a patch from Jan Nieuwenhuizen.
Diffstat (limited to 'module/system/base/compile.scm')
-rw-r--r--module/system/base/compile.scm14
1 files changed, 11 insertions, 3 deletions
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 1b6e73f32..943999040 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -103,6 +103,16 @@
;;;
;;; See also boot-9.scm:load.
(define (compiled-file-name file)
+ ;; FIXME: would probably be better just to append SHA1(canon-path)
+ ;; to the %compile-fallback-path, to avoid deep directory stats.
+ (define (canonical->suffix canon)
+ (cond
+ ((string-prefix? "/" canon) canon)
+ ((and (> (string-length canon) 2)
+ (eqv? (string-ref canon 1) #\:))
+ ;; Paths like C:... transform to /C...
+ (string-append "/" (substring canon 0 1) (substring canon 2)))
+ (else canon)))
(define (compiled-extension)
(cond ((or (null? %load-compiled-extensions)
(string-null? (car %load-compiled-extensions)))
@@ -113,9 +123,7 @@
(and %compile-fallback-path
(let ((f (string-append
%compile-fallback-path
- ;; no need for '/' separator here, canonicalize-path
- ;; will give us an absolute path
- (canonicalize-path file)
+ (canonical->suffix (canonicalize-path file))
(compiled-extension))))
(and (false-if-exception (ensure-writable-dir (dirname f)))
f))))