From 47b8b43437ee4d91b117444217329fd97984053d Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 17 Jul 1991 08:54:53 +0000 Subject: [PATCH] Fix bug in DIRECTORY-READ: if the argument has any name component, don't default other name components to 'WILD. --- v7/src/runtime/unxdir.scm | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/v7/src/runtime/unxdir.scm b/v7/src/runtime/unxdir.scm index 0ab544065..3a3dd7171 100644 --- a/v7/src/runtime/unxdir.scm +++ b/v7/src/runtime/unxdir.scm @@ -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)) -- 2.25.1