From beed226895c0eab10e0b535e4642db7cbf1a3d2b Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 27 Feb 1996 21:53:14 +0000 Subject: [PATCH] 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. --- v7/src/runtime/dospth.scm | 35 ++++++++++++--------- v7/src/runtime/unxpth.scm | 66 ++++++++++++++++++++++----------------- 2 files changed, 59 insertions(+), 42 deletions(-) diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm index d9f640d36..884749597 100644 --- 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 167662d37..e40da1d65 100644 --- 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))))) + (define (simplify-directory directory) (if (and (eq? (car directory) 'RELATIVE) (null? (cdr directory))) false directory)) - + (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 -- 2.25.1