From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 9 Mar 2006 05:29:28 +0000 (+0000)
Subject: Fix bug: pathname directories can contain the symbol 'UP, but the
X-Git-Tag: 20090517-FFI~1070
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=5f5069aa3e21c436777154fe916d57ab0dc9b114;p=mit-scheme.git

Fix bug: pathname directories can contain the symbol 'UP, but the
pathname/URI conversions weren't handling that case.
---

diff --git a/v7/src/runtime/pathnm.scm b/v7/src/runtime/pathnm.scm
index 271ccfe35..28152fe1e 100644
--- a/v7/src/runtime/pathnm.scm
+++ b/v7/src/runtime/pathnm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: pathnm.scm,v 14.46 2006/03/07 20:29:34 cph Exp $
+$Id: pathnm.scm,v 14.47 2006/03/09 05:29:28 cph Exp $
 
 Copyright 1987,1988,1989,1990,1991,1992 Massachusetts Institute of Technology
 Copyright 1993,1994,1995,1996,2000,2001 Massachusetts Institute of Technology
@@ -304,9 +304,9 @@ these rules:
     (make-uri (if (pathname-absolute? pathname) 'file #f)
 	      #f
 	      (map (lambda (x)
-		     (if (eq? x 'WILD)
-			 "*"
-			 (string->utf8-string x)))
+		     (cond ((eq? x 'WILD) "*")
+			   ((eq? x 'UP) "..")
+			   (else (string->utf8-string x))))
 		   (append (if (pathname-absolute? pathname)
 			       (list "")
 			       '())
@@ -346,9 +346,9 @@ these rules:
     (let ((scheme (uri-scheme uri))
 	  (path
 	   (map (lambda (x)
-		  (if (string=? x "*")
-		      'WILD
-		      (utf8-string->string x)))
+		  (cond ((string=? x "*") 'WILD)
+			((string=? x "..") 'UP)
+			(else (utf8-string->string x))))
 		(uri-path uri)))
 	  (lose
 	   (lambda ()