From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Thu, 10 Nov 2016 00:15:36 +0000 (-0700)
Subject: Search the library directory path for the standard library directory
X-Git-Tag: mit-scheme-pucked-9.2.12~254^2~6
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=147f47f0ee078e2eef21644a91c3d907514390eb;p=mit-scheme.git

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 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)