Fix bug: when an environment variable expands into a string that ends

in a slash, that trailing slash must be ignored if the environment
variable is delimited by a slash.

diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm
index d9f640d36bac0637b293e09732214c5531b261a5..8847495976f887e82fba7ea7980f16e7fd2d0e53 100644 (file)
--- a/v7/src/runtime/dospth.scm
+++ b/v7/src/runtime/dospth.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: dospth.scm,v 1.32 1995/10/23 07:10:07 cph Exp $
+$Id: dospth.scm,v 1.33 1996/02/27 21:53:06 cph Exp $
 
-Copyright (c) 1992-95 Massachusetts Institute of Technology
+Copyright (c) 1992-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -100,7 +100,18 @@ MIT in each case. |#
                             'UNSPECIFIC))))))
 
 (define (expand-directory-prefixes components)
-  (let ((string (car components)))
+  (let ((string (car components))
+       (replace-head
+        (lambda (string)
+          ;; If STRING has a trailing slash, and it's followed by a
+          ;; slash, drop the trailing slash to avoid doubling.
+          (let ((head (string-components string sub-directory-delimiters)))
+            (append (if (and (pair? (cdr components))
+                             (pair? (cdr head))
+                             (string-null? (car (last-pair head))))
+                        (except-last-pair head)
+                        head)
+                    (cdr components))))))
     (if (or (string-null? string)
            (not *expand-directory-prefixes?*))
        components
@@ -109,18 +120,14 @@ MIT in each case. |#
           (let ((value (get-environment-variable (string-tail string 1))))
             (if (not value)
                 components
-                (append (string-components value sub-directory-delimiters)
-                        (cdr components)))))
+                (replace-head value))))
          ((#\~)
-          (append
-           (string-components (->namestring
-                               (directory-pathname-as-file
-                                (let ((user-name (string-tail string 1)))
-                                  (if (string-null? user-name)
-                                      (current-home-directory)
-                                      (user-home-directory user-name)))))
-                              sub-directory-delimiters)
-           (cdr components)))
+          (replace-head
+           (->namestring
+            (let ((user-name (string-tail string 1)))
+              (if (string-null? user-name)
+                  (current-home-directory)
+                  (user-home-directory user-name))))))
          (else components)))))
 
 (define (parse-device-and-path components)

diff --git a/v7/src/runtime/unxpth.scm b/v7/src/runtime/unxpth.scm
index 167662d37d547cc56c7d6ca443b5e8174f62a1a7..e40da1d65d4ab199d65798ee3d3082002fc03f46 100644 (file)
--- a/v7/src/runtime/unxpth.scm
+++ b/v7/src/runtime/unxpth.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: unxpth.scm,v 14.20 1995/10/18 05:00:46 cph Exp $
+$Id: unxpth.scm,v 14.21 1996/02/27 21:53:14 cph Exp $
 
-Copyright (c) 1988-95 Massachusetts Institute of Technology
+Copyright (c) 1988-96 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -60,9 +60,8 @@ MIT in each case. |#
 (define (unix/parse-namestring string host)
   (let ((end (string-length string)))
     (let ((components
-          (let ((components (substring-components string 0 end #\/)))
-            (append (expand-directory-prefixes (car components))
-                    (cdr components)))))
+          (expand-directory-prefixes
+           (substring-components string 0 end #\/))))
       (parse-name (car (last-pair components))
        (lambda (name type)
          (%make-pathname host
@@ -81,36 +80,48 @@ MIT in each case. |#
                          type
                          'UNSPECIFIC))))))
 
+(define (expand-directory-prefixes components)
+  (let ((string (car components))
+       (replace-head
+        (lambda (string)
+          ;; If STRING has a trailing slash, and it's followed by a
+          ;; slash, drop the trailing slash to avoid doubling.
+          (let ((head (string-components string #\/)))
+            (append (if (and (pair? (cdr components))
+                             (pair? (cdr head))
+                             (string-null? (car (last-pair head))))
+                        (except-last-pair head)
+                        head)
+                    (cdr components))))))
+    (if (or (string-null? string)
+           (not *expand-directory-prefixes?*))
+       components
+       (case (string-ref string 0)
+         ((#\$)
+          (let ((name (string-tail string 1)))
+            (let ((value (get-environment-variable name)))
+              (if value
+                  (replace-head value)
+                  components))))
+         ((#\~)
+          (replace-head
+           (->namestring
+            (let ((user-name (substring string 1 (string-length string))))
+              (if (string-null? user-name)
+                  (current-home-directory)
+                  (user-home-directory user-name))))))
+         (else components)))))
+\f
 (define (simplify-directory directory)
   (if (and (eq? (car directory) 'RELATIVE) (null? (cdr directory)))
       false
       directory))
-\f
+
 (define (parse-directory-component component)
   (if (string=? ".." component)
       'UP
       component))
 
-(define (expand-directory-prefixes string)
-  (if (or (string-null? string)
-         (not *expand-directory-prefixes?*))
-      (list string)
-      (case (string-ref string 0)
-       ((#\$)
-        (let ((name (string-tail string 1)))
-          (let ((value (get-environment-variable name)))
-            (if (not value)
-                (error "Unbound environment variable:" name))
-            (string-components value #\/))))
-       ((#\~)
-        (let ((user-name (substring string 1 (string-length string))))
-          (string-components
-           (if (string-null? user-name)
-               (current-home-directory)
-               (user-home-directory user-name))
-           #\/)))
-       (else (list string)))))
-
 (define (string-components string delimiter)
   (substring-components string 0 (string-length string) delimiter))
 
@@ -309,5 +320,4 @@ MIT in each case. |#
       pathname))
 
 (define (unix/end-of-line-string pathname)
-  pathname                             ; ignored
-  "\n")
\ No newline at end of file
+  (or (os/file-end-of-line-translation pathname) "\n"))
\ No newline at end of file