~ chicken-core (chicken-5) d2dcb46257c253bc926258ac9945896c78df133f


commit d2dcb46257c253bc926258ac9945896c78df133f
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sat Nov 9 17:02:15 2019 +0100
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon Nov 11 21:02:30 2019 +1300

    Change to the drive before changing directory when running egg commands
    
    On Windows, changing to the directory including the drive will just
    set the working directory of that drive, but it won't actually change
    to that working directory on that drive.  So, we first change to the
    drive before changing directories.
    
    Fixes #1647
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index 9f59849f..d9406408 100644
--- a/NEWS
+++ b/NEWS
@@ -52,6 +52,8 @@
   - chicken-install now correctly checks server response code to avoid
     interpreting error response bodies (like 404, 500) as Scheme code.
   - chicken-install now follows HTTP redirects when downloading eggs.
+  - chicken-install will now change to the correct drive before
+    attempting to change to the egg directory (fixes #1647).
 
 
 5.1.0
diff --git a/egg-compile.scm b/egg-compile.scm
index 0fd9c242..149f25a9 100644
--- a/egg-compile.scm
+++ b/egg-compile.scm
@@ -100,6 +100,11 @@
 
 (define (cd-command platform) "cd")
 
+(define (change-drive-command platform drive)
+  (case platform
+    ((unix) #f)
+    ((windows) drive)))		    ; Should already include the colon
+
 (define (uses-compiled-import-library? mode)
   (not (and (eq? mode 'host) staticbuild)))
 
@@ -1085,12 +1090,16 @@
     (with-output-to-file dest
       (lambda ()
         (prefix platform)
+        (receive (drive root parts) (decompose-directory srcdir)
+          (let ((cmd (change-drive-command platform drive)))
+            (when cmd
+              (print cmd))))
         (print (cd-command platform) " " (qs* srcdir platform #t))
         (for-each
           (lambda (cmd) (cmd srcdir platform))
           cmds)
         (suffix platform)))))
-                        
+
 
 ;;; affixes for build- and install-scripts
 
Trap