From e07bf2bf43adfa053f18bd54daaf96f5cab1b3d0 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 28 Feb 1996 23:30:20 +0000
Subject: [PATCH] Continuation of previous bug fix.

---
 v7/src/runtime/dospth.scm | 45 +++++++++++++++++++++++----------------
 v7/src/runtime/unxpth.scm | 14 +++++++-----
 2 files changed, 36 insertions(+), 23 deletions(-)

diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm
index 884749597..f3183e21e 100644
--- a/v7/src/runtime/dospth.scm
+++ b/v7/src/runtime/dospth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: dospth.scm,v 1.33 1996/02/27 21:53:06 cph Exp $
+$Id: dospth.scm,v 1.34 1996/02/28 23:30:20 cph Exp $
 
 Copyright (c) 1992-96 Massachusetts Institute of Technology
 
@@ -83,21 +83,26 @@ MIT in each case. |#
     (lambda (device components)
       (call-with-values (lambda () (parse-name (car (last-pair components))))
 	(lambda (name type)
-	  (dos/make-pathname host
-			     device
-			     (let ((components (except-last-pair components)))
-			       (and (not (null? components))
-				    (simplify-directory
-				     (if (string=? "" (car components))
-					 (cons 'ABSOLUTE
-					       (map parse-directory-component
-						    (cdr components)))
-					 (cons 'RELATIVE
-					       (map parse-directory-component
-						    components))))))
-			     name
-			     type
-			     'UNSPECIFIC))))))
+	  (dos/make-pathname
+	   host
+	   device
+	   (let ((components (except-last-pair components)))
+	     (and (not (null? components))
+		  (simplify-directory
+		   (if (string-null? (car components))
+		       (cons 'ABSOLUTE
+			     (if (and (pair? (cdr components))
+				      (string-null? (cadr components)))
+				 (cons (cadr components)
+				       (parse-directory-components
+					(cddr components)))
+				 (parse-directory-components
+				  (cdr components))))
+		       (cons 'RELATIVE
+			     (parse-directory-components components))))))
+	   name
+	   type
+	   'UNSPECIFIC))))))
 
 (define (expand-directory-prefixes components)
   (let ((string (car components))
@@ -129,7 +134,7 @@ MIT in each case. |#
 		   (current-home-directory)
 		   (user-home-directory user-name))))))
 	  (else components)))))
-
+
 (define (parse-device-and-path components)
   (let ((string (car components)))
     (let ((colon (string-find-next-char string #\:)))
@@ -144,11 +149,15 @@ MIT in each case. |#
 	((equal? '(ABSOLUTE UP) directory) '(ABSOLUTE))
 	(else directory)))
 
+(define (parse-directory-components components)
+  (map parse-directory-component
+       (list-transform-negative components string-null?)))
+
 (define (parse-directory-component component)
   (if (string=? ".." component)
       'UP
       component))
-
+
 (define (string-components string delimiters)
   (substring-components string 0 (string-length string) delimiters))
 
diff --git a/v7/src/runtime/unxpth.scm b/v7/src/runtime/unxpth.scm
index e40da1d65..60e87c6d9 100644
--- a/v7/src/runtime/unxpth.scm
+++ b/v7/src/runtime/unxpth.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: unxpth.scm,v 14.21 1996/02/27 21:53:14 cph Exp $
+$Id: unxpth.scm,v 14.22 1996/02/28 23:26:12 cph Exp $
 
 Copyright (c) 1988-96 Massachusetts Institute of Technology
 
@@ -71,11 +71,11 @@ MIT in each case. |#
 				 (simplify-directory
 				  (if (string=? "" (car components))
 				      (cons 'ABSOLUTE
-					    (map parse-directory-component
-						 (cdr components)))
+					    (parse-directory-components
+					     (cdr components)))
 				      (cons 'RELATIVE
-					    (map parse-directory-component
-						 components))))))
+					    (parse-directory-components
+					     components))))))
 			  name
 			  type
 			  'UNSPECIFIC))))))
@@ -117,6 +117,10 @@ MIT in each case. |#
       false
       directory))
 
+(define (parse-directory-components components)
+  (map parse-directory-component
+       (list-transform-negative components string-null?)))
+
 (define (parse-directory-component component)
   (if (string=? ".." component)
       'UP
-- 
2.25.1