From 16f861fd9d7c9246a22a212c26d97fb2e3712607 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 2 Jun 2009 15:03:03 +0000 Subject: [PATCH] 1.0.28.71: two regressions from the 1.0.28. series * from 1.0.28.51: when destructuring a constant :INITIAL-CONTENTS to MAKE-ARRAY, take care to quote the elements. * from 1.0.28.61: handle :BACK and :UP in CANONICALIZE-PATHNAME, and make sure they do not appear after :WILD-INFERIORS or :ABSOLUTE. I'm more and more concinved that MAKE-PATHNAME should canonicalize, though, so that these checks don't need to be carried out by users of pathnames -- but leaving that for later. ...how appropriate that it is .71 that fixes both. --- src/code/filesys.lisp | 41 ++++++++++++++++++++++++++++++----------- src/compiler/array-tran.lisp | 2 +- version.lisp-expr | 2 +- 3 files changed, 32 insertions(+), 13 deletions(-) diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index ecb6cd2..aba52a6 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -606,15 +606,33 @@ matching filenames." #'string< :key #'car)))) - (defun canonicalize-pathname (pathname) - ;; We're really only interested in :UNSPECIFIC -> NIL, - ;; and dealing with #p"foo/.." and #p"foo/." - (flet ((simplify (piece) - (unless (eq :unspecific piece) - piece))) - (let ((name (simplify (pathname-name pathname))) - (type (simplify (pathname-type pathname))) - (dir (pathname-directory pathname))) +(defun canonicalize-pathname (pathname) + ;; We're really only interested in :UNSPECIFIC -> NIL, :BACK and :UP, + ;; and dealing with #p"foo/.." and #p"foo/." + (labels ((simplify (piece) + (unless (eq :unspecific piece) + piece)) + (canonicalize-directory (directory) + (let (pieces) + (dolist (piece directory) + (if (and pieces (member piece '(:back :up))) + ;; FIXME: We should really canonicalize when we construct + ;; pathnames. This is just wrong. + (case (car pieces) + ((:absolute :wild-inferiors) + (error 'simple-file-error + :format-control "Invalid use of ~S after ~S." + :format-arguments (list piece (car pieces)) + :pathname pathname)) + ((:relative :up :back) + (push piece pieces)) + (t + (pop pieces))) + (push piece pieces))) + (nreverse pieces)))) + (let ((name (simplify (pathname-name pathname))) + (type (simplify (pathname-type pathname))) + (dir (canonicalize-directory (pathname-directory pathname)))) (cond ((equal "." name) (cond ((not type) (make-pathname :name nil :defaults pathname)) @@ -624,8 +642,9 @@ matching filenames." :directory (butlast dir) :defaults pathname)))) (t - (make-pathname :name name :type type :defaults pathname)))))) - + (make-pathname :name name :type type + :directory dir + :defaults pathname)))))) ;;; Given a native namestring, provides a WITH-HASH-TABLE-ITERATOR style ;;; interface to mapping over namestrings of entries in the corresponding diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index 340ce53..4c4ec20 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -329,7 +329,7 @@ (truly-the ,result-spec (initialize-vector ,alloc-form ,@(map 'list (lambda (elt) - `(the ,elt-spec ,elt)) + `(the ,elt-spec ',elt)) contents))))))) ;; any other :INITIAL-CONTENTS (initial-contents diff --git a/version.lisp-expr b/version.lisp-expr index 6d5b3ad..1d56119 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.28.70" +"1.0.28.71" -- 1.7.10.4