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.

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index ecb6cd2..aba52a6 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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"