From 147f47f0ee078e2eef21644a91c3d907514390eb Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Wed, 9 Nov 2016 17:15:36 -0700 Subject: [PATCH] Search the library directory path for the standard library directory containing lib/ and the built-in object files. Adjust pathname-> standard-uri and standard-uri->pathname to use this directory instead of the first directory in the path. When plugins used --prepend-library to test a shared object, C worlds failed. They could not re-load registered object files, nor load bundled options. The guarded-system-loader only looked in the first directory in the path, not the standard library directory. --- src/etc/optiondb.scm | 5 ++++- src/runtime/load.scm | 8 ++++++-- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/src/etc/optiondb.scm b/src/etc/optiondb.scm index 9b7003cbe..19f36ab69 100644 --- a/src/etc/optiondb.scm +++ b/src/etc/optiondb.scm @@ -75,7 +75,10 @@ USA. (finish dir pathname) (dir-loop (cdr dirs))))) (receive (dir pathname) - (try-dir (system-library-directory-pathname)) + (try-dir + (let ((d (system-library-directory-pathname "lib"))) + (pathname-new-directory d (except-last-pair + (pathname-directory d))))) (if (not dir) (lose)) (finish dir pathname)))))))) diff --git a/src/runtime/load.scm b/src/runtime/load.scm index ca9826c09..8336f40d0 100644 --- a/src/runtime/load.scm +++ b/src/runtime/load.scm @@ -431,10 +431,14 @@ USA. (with-directory-rewriting-rule directory path thunk) (thunk))))))) +(define (standard-library-directory-pathname) + (let ((d (system-library-directory-pathname "lib"))) + (pathname-new-directory d (except-last-pair (pathname-directory d))))) + (define (pathname->standard-uri pathname) (let ((uri (pathname->uri - (enough-pathname pathname (system-library-directory-pathname))))) + (enough-pathname pathname (standard-library-directory-pathname))))) (if (uri-absolute? uri) uri (system-library-uri uri)))) @@ -443,7 +447,7 @@ USA. (or (uri->pathname uri #f) (merge-pathnames (uri->pathname (make-uri #f #f (list-tail (uri-path uri) 4) #f #f)) - (system-library-directory-pathname)))) + (standard-library-directory-pathname)))) (define (system-uri #!optional rel-uri) (if (string? system-base-uri) -- 2.25.1