From a1d0f35392e40dbe754ec5bb84a328e8701e61c4 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 21 May 1995 01:36:23 +0000 Subject: [PATCH] Change canonicalization of pathname case so that environment variables are case-sensitive. --- v7/src/runtime/dospth.scm | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/v7/src/runtime/dospth.scm b/v7/src/runtime/dospth.scm index 088c4f018..caaf6c871 100644 --- a/v7/src/runtime/dospth.scm +++ b/v7/src/runtime/dospth.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: dospth.scm,v 1.24 1995/04/09 22:32:25 cph Exp $ +$Id: dospth.scm,v 1.25 1995/05/21 01:36:23 cph Exp $ Copyright (c) 1992-95 Massachusetts Institute of Technology @@ -75,10 +75,11 @@ MIT in each case. |# (define (dos/parse-namestring string host) (call-with-values (lambda () - (parse-device-and-path - (expand-directory-prefixes - (string-components (string-downcase string) - sub-directory-delimiters)))) + (let ((components + (expand-directory-prefixes + (string-components string sub-directory-delimiters)))) + (for-each string-downcase! components) + (parse-device-and-path components))) (lambda (device components) (call-with-values (lambda () (parse-name (car (last-pair components)))) (lambda (name type) @@ -149,22 +150,22 @@ MIT in each case. |# (let ((index (substring-find-next-char-in-set string start end delimiters))) (if index - (cons (substring string start index) (loop (+ index 1))) + (cons (substring string start index) (loop (fix:+ index 1))) (list (substring string start end)))))) (define (parse-name string) (let ((dot (string-find-previous-char string #\.)) (end (string-length string))) (if (or (not dot) - (= dot 0) - (= dot (- end 1)) - (char=? #\. (string-ref string (- dot 1)))) - (values (cond ((= end 0) #f) + (fix:= dot 0) + (fix:= dot (fix:- end 1)) + (char=? #\. (string-ref string (fix:- dot 1)))) + (values (cond ((fix:= end 0) #f) ((string=? "*" string) 'WILD) (else string)) #f) (values (extract string 0 dot) - (extract string (+ dot 1) end))))) + (extract string (fix:+ dot 1) end))))) (define (extract string start end) (if (substring=? string start end "*" 0 1) -- 2.25.1