Fix bug in DIRECTORY-READ: if the argument has any name component,
authorChris Hanson <org/chris-hanson/cph>
Wed, 17 Jul 1991 08:54:53 +0000 (08:54 +0000)
committerChris Hanson <org/chris-hanson/cph>
Wed, 17 Jul 1991 08:54:53 +0000 (08:54 +0000)
don't default other name components to 'WILD.

v7/src/runtime/unxdir.scm

index 0ab544065be82f0f67b0eda1a5c0df799a79e6e4..3a3dd71713b4bcfe200f95406bbca26e05277126 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxdir.scm,v 14.4 1989/08/04 02:14:09 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxdir.scm,v 14.5 1991/07/17 08:54:53 cph Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -44,9 +44,15 @@ MIT in each case. |#
 
 (define (directory-read-nosort pattern)
   (let ((pattern
-        (pathname-default (pathname->absolute-pathname (->pathname pattern))
-                          false false false
-                          'WILD 'WILD 'WILD)))
+        (let ((pattern (pathname->absolute-pathname (->pathname pattern))))
+          (if (or (pathname-name pattern)
+                  (pathname-type pattern)
+                  (pathname-version pattern))
+              pattern
+              (make-pathname (pathname-host pathname)
+                             (pathname-device pathname)
+                             (pathname-directory pathname)
+                             'WILD 'WILD 'WILD)))))
     (let ((directory-path (pathname-directory-path pattern)))
       (let ((pathnames (generate-directory-pathnames directory-path)))
        (cond ((and (eq? 'WILD (pathname-name pattern))