As discussed on IRC, it doesn’t make much sense to have
(repository-path) return a string now that it’s a search path and thus
is not guaranteed to be a valid directory name any longer.
I tried to keep the scope of this patch as minimal as possible, it’s not
very clean but it seems to be working. I added a few tests to ensure that.
From 08f2609232185e09fd323afb6b8ceadad55c52f1 Mon Sep 17 00:00:00 2001
From: Kooda
Date: Thu, 9 Aug 2018 20:47:14 +0200
Subject: [PATCH] Make `repository-path` from (chicken platform) return a list
instead of a string
---
NEWS | 3 +++
chicken-install.scm | 2 +-
chicken-status.scm| 13 ++---
eval.scm | 44 ++-
library.scm | 42 ++---
tests/private-repository-test.scm | 2 +-
tests/repository-path-default.scm | 9 +++
tests/repository-path.scm | 33 +++
tests/runtests.bat| 10 +++
tests/runtests.sh | 11 +++-
tests/sample-module.scm | 3 +++
types.db | 1 +
12 files changed, 128 insertions(+), 45 deletions(-)
create mode 100644 tests/repository-path-default.scm
create mode 100644 tests/repository-path.scm
create mode 100644 tests/sample-module.scm
diff --git a/NEWS b/NEWS
index c6489e78..301bf947 100644
--- a/NEWS
+++ b/NEWS
@@ -102,6 +102,9 @@
- `process`, `process*` and `process-execute` now expect lists of the form
(("NAME" . "VALUE") ...) instead of the previous (("NAME=VALUE") ...)
as their environment argument.
+ - `repository-path` is now a parameter containing a list of strings instead
+of a string, as the search path for libraries can now contain multiple
+directories.
- Module system
- The compiler has been modularised, for improved namespacing. This
diff --git a/chicken-install.scm b/chicken-install.scm
index e88d23b6..14e07262 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -112,7 +112,7 @@
(define (repo-path)
(if (and cross-chicken (not host-extension))
- (destination-repository 'target)
+ (##sys#split-path (destination-repository 'target))
(repository-path)))
(define (install-path)
diff --git a/chicken-status.scm b/chicken-status.scm
index 25c873dc..e145e32a 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -63,7 +63,7 @@
(define (repo-path)
(if (and cross-chicken (not host-extensions))
- (destination-repository 'target)
+ (##sys#split-path (destination-repository 'target))
(repository-path)))
(define (grep rx lst)
@@ -93,7 +93,7 @@
(lambda (dir)
(map pathname-file
(glob (make-pathname dir "*" +egg-info-extension+
-(##sys#split-path (repo-path)))
+(repo-path))
equal?))
(define (format-string str cols #!optional right (padc #\space))
@@ -112,7 +112,14 @@
(let ((version
(cond ((let ((info (read-info egg dir ext)))
(and info (get-egg-property info 'version
- ((file-exists? (make-pathname (list dir egg) +version-file+))
+ ((and (string? dir)
+ (file-exists? (make-pathname (list dir egg) +version-file+)))
+ => (lambda (fname)
+ (with-input-from-file fname read)))
+ ((chicken.load#find-file +version-file+
+ (map (lambda (d)
+ (make-pathname d egg))
+ dir))
=> (lambda (fname)
(with-input-from-file fname read)))
(else "unknown"
diff --git a/eval.scm b/eval.scm
index c34622f7..68c824bf 100644
--- a/eval.scm
+++ b/eval.scm
@@ -1212,40 +1212,15 @@
(define ##sys#setup-mode #f)
-(define path-list-separator
- (if ##sys#windows-platform #\; #\:))
-
-(define ##sys#split-path
- (let ((cache '(#f)))
-(lambda (path)
- (cond ((not path) '())
-((equal? path (car cache))
- (cdr cache))
-(else
- (let* ((len (string-length path))
- (lst (let loop ((start 0) (pos 0))
-(cond ((fx>= pos len)
- (if (fx= pos start)
- '()
- (list (substring path start pos
- ((char=? (string-ref path pos)
- path-list-separator)
- (cons (substring path start pos)
- (loop (fx+ pos 1)
- (fx+ pos 1
- (else
-(loop start (fx+ pos 1)))
-(set! cache (cons path lst))
-lst))
-
(define (file-exists? name) ; defined here to avoid file unit dependency
(and (##sys#file-exists? name #t #f #f) name))
(define (find-file name search-path)
- (let loop ((p (##sys#split-path
