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.

diff --git a/src/etc/optiondb.scm b/src/etc/optiondb.scm
index 9b7003cbeea3a8ec3776c64e8aea02ba50472d45..19f36ab69de2026f6f2d1adaee0e82a0fda71f9e 100644 (file)
--- 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 ca9826c091a63213516ea6fc73dad324681bbe18..8336f40d02d9b3ffab860e7d477f3353bf1e95a1 100644 (file)
--- 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)