0.7.4.1:

        Apply patch to type system (CSR sbcl-devel 2002-05-23) to generate
                more useful types from intersections of complicated numeric
                types;
        Be more consistent over handling of wild pathnames to functions
		expecting non-wild pathnames;
	Apply two slight optimizations to array transforms;
	Fix (from Pierre Mai) for BUG 140; treat with (slight) care, as this
		removes an explicit request for non-invalidation of a wrapper,
		which presumably had some reason for being there at one time.

diff --git a/BUGS b/BUGS
index 0838256..ad7b82a 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -260,7 +260,6 @@ WORKAROUND:
           MERGE also have the same problem.
        c: (COERCE 'AND 'FUNCTION) returns something related to
           (MACRO-FUNCTION 'AND), but ANSI says it should raise an error.
           MERGE also have the same problem.
        c: (COERCE 'AND 'FUNCTION) returns something related to
           (MACRO-FUNCTION 'AND), but ANSI says it should raise an error.

-       g: (LOAD "*.lsp") should signal FILE-ERROR.

        h: (MAKE-CONCATENATED-STREAM (MAKE-STRING-OUTPUT-STREAM))
           should signal TYPE-ERROR.
        i: MAKE-TWO-WAY-STREAM doesn't check that its arguments can
        h: (MAKE-CONCATENATED-STREAM (MAKE-STRING-OUTPUT-STREAM))
           should signal TYPE-ERROR.
        i: MAKE-TWO-WAY-STREAM doesn't check that its arguments can

@@ -897,9 +896,6 @@ WORKAROUND:
    Evidently Python thinks of the lambda as a code transformation so
    much that it forgets that it's also an object.
 
    Evidently Python thinks of the lambda as a code transformation so
    much that it forgets that it's also an object.
 

-126:
-  (fixed in 0.pre7.41)
-

 127:
   The DEFSTRUCT section of the ANSI spec, in the :CONC-NAME section,
   specifies a precedence rule for name collisions between slot accessors of
 127:
   The DEFSTRUCT section of the ANSI spec, in the :CONC-NAME section,
   specifies a precedence rule for name collisions between slot accessors of

@@ -1003,36 +999,6 @@ WORKAROUND:
   still some functions named "hairy arg processor" and
   "SB-INT:&MORE processor".
 
   still some functions named "hairy arg processor" and
   "SB-INT:&MORE processor".
 

-140:
-  (reported by Alexey Dejneka sbcl-devel 2002-01-03)
-
-  SUBTYPEP does not work well with redefined classes:
-  ---
-  * (defclass a () ())
-  #<STANDARD-CLASS A>
-  * (defclass b () ())
-  #<STANDARD-CLASS B>
-  * (subtypep 'b 'a)
-  NIL
-  T
-  * (defclass b (a) ())
-  #<STANDARD-CLASS B>
-  * (subtypep 'b 'a)
-  T
-  T
-  * (defclass b () ())
-  #<STANDARD-CLASS B>
-   
-  ;;; And now...
-  * (subtypep 'b 'a)
-  T
-  T
-
-  This is probably due to underzealous clearing of the type caches; a
-  brute-force solution in that case would be to make a defclass expand
-  into something that included a call to SB-KERNEL::CLEAR-TYPE-CACHES,
-  but there may be a better solution.
-

 141: 
   Pretty-printing nested backquotes doesn't work right, as 
   reported by Alexey Dejneka sbcl-devel 2002-01-13:
 141: 
   Pretty-printing nested backquotes doesn't work right, as 
   reported by Alexey Dejneka sbcl-devel 2002-01-13:

@@ -1160,9 +1126,6 @@ WORKAROUND:
   but it has happened in more complicated cases (which I haven't
   figured out how to reproduce).
 
   but it has happened in more complicated cases (which I haven't
   figured out how to reproduce).
 

-155:
-  (fixed in sbcl-0.7.2.9)
-

 156:
   FUNCTION-LAMBDA-EXPRESSION doesn't work right in 0.7.0 or 0.7.2.9:
     * (function-lambda-expression #'(lambda (x) x))
 156:
   FUNCTION-LAMBDA-EXPRESSION doesn't work right in 0.7.0 or 0.7.2.9:
     * (function-lambda-expression #'(lambda (x) x))

@@ -1175,16 +1138,6 @@ WORKAROUND:
   UPGRADED-COMPLEX-PART-TYPE should have an optional environment argument.
   (reported by Alexey Dejneka sbcl-devel 2002-04-12)
 
   UPGRADED-COMPLEX-PART-TYPE should have an optional environment argument.
   (reported by Alexey Dejneka sbcl-devel 2002-04-12)
 

-158:
-  Compiling the following code causes SBCL 0.7.2 to bug. This only
-  happens with optimization enabled, and only when the loop variable is
-  being incremented by more than 1.
-    (defun foo (array)
-      (declare (optimize (safety 0) (space 0) (debug 0) (speed 3)))
-      (loop for i from 0 to 10 by 2
-            do (foo (svref array i))) (svref array (1+ i)))
-  (reported by Eric Marsden sbcl-devel 2002-04-15)
-

 162:
   (reported by Robert E. Brown 2002-04-16) 
   When a function is called with too few arguments, causing the
 162:
   (reported by Robert E. Brown 2002-04-16) 
   When a function is called with too few arguments, causing the

@@ -1205,12 +1158,6 @@ WORKAROUND:
   isn't too surprising since there are many differences in stack
   implementation and GC conservatism between the X86 and other ports.)
 
   isn't too surprising since there are many differences in stack
   implementation and GC conservatism between the X86 and other ports.)
 

-164:
-  The type system still can't quite deal with all useful identities;
-  for instance, as of sbcl-0.7.2.18, the type specifier '(and (real -1
-  7) (real 4 8)) is a HAIRY-TYPE rather than that which would be hoped
-  for, viz: '(real 4 7).
-

 165:
   Array types with element-types of some unknown type are falsely being
   assumed to be of type (ARRAY T) by the compiler in some cases. The
 165:
   Array types with element-types of some unknown type are falsely being
   assumed to be of type (ARRAY T) by the compiler in some cases. The

@@ -1302,20 +1249,10 @@ WORKAROUND:
   ;   caught 1 STYLE-WARNING condition
   But the code works as it should. Checked in 0.6.12.43 and later.
 
   ;   caught 1 STYLE-WARNING condition
   But the code works as it should. Checked in 0.6.12.43 and later.
 

-170:
-  (reported by Matthias Hoelzl on sbcl-devel 2002-05-13)
-    * (defmacro foo () ''x)
-    FOO
-    * (foo)
-    X
-    * (compile 'foo)
-    FOO
-    NIL
-    NIL
-    * (foo)
-    debugger invoked on condition of type UNDEFINED-FUNCTION:
-      The function FOO is undefined.
-
+171:
+  (reported by Pierre Mai while investigating bug 47):
+    (DEFCLASS FOO () ((A :SILLY T))) 
+  signals a SIMPLE-ERROR, not a PROGRAM-ERROR.

 
 DEFUNCT CATEGORIES OF BUGS
   IR1-#:
 
 DEFUNCT CATEGORIES OF BUGS
   IR1-#:

diff --git a/NEWS b/NEWS
index b2516d9..7ba2cfe 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1126,6 +1126,13 @@ changes in sbcl-0.7.4 relative to sbcl-0.7.3:
     an ordinary character. Thus e.g. (READ-FROM-STRING "A\7fB") returns
     |A\7fB|, instead of A as it used to.
 
     an ordinary character. Thus e.g. (READ-FROM-STRING "A\7fB") returns
     |A\7fB|, instead of A as it used to.
 

+changes in sbcl-0.7.5 relative to sbcl-0.7.4:
+  * bug 140 fixed: redefinition of classes with different supertypes
+    is now reflected in the type hierarchy. (thanks to Pierre Mai)
+  * minor incompatible change: The LOAD function no longer, when given
+    a wild pathname to load, loads all files matching that pathname;
+    instead, an error of type FILE-ERROR is signalled.
+

 planned incompatible changes in 0.7.x:
 * When the profiling interface settles down, maybe in 0.7.x, maybe
   later, it might impact TRACE. They both encapsulate functions, and
 planned incompatible changes in 0.7.x:
 * When the profiling interface settles down, maybe in 0.7.x, maybe
   later, it might impact TRACE. They both encapsulate functions, and

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index b4d48c6..bde23dc 100644 (file)
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -682,14 +682,16 @@
 (defun unix-namestring (pathname-spec &optional (for-input t))
   (let* ((namestring (physicalize-pathname (merge-pathnames pathname-spec)))
         (matches nil)) ; an accumulator for actual matches
 (defun unix-namestring (pathname-spec &optional (for-input t))
   (let* ((namestring (physicalize-pathname (merge-pathnames pathname-spec)))
         (matches nil)) ; an accumulator for actual matches

+    (when (wild-pathname-p namestring)
+      (error 'simple-file-error
+            :pathname namestring
+            :format-control "bad place for a wild pathname"))

     (!enumerate-matches (match namestring nil :verify-existence for-input)
                        (push match matches))
     (case (length matches)
       (0 nil)
       (1 (first matches))
     (!enumerate-matches (match namestring nil :verify-existence for-input)
                        (push match matches))
     (case (length matches)
       (0 nil)
       (1 (first matches))

-      (t (error 'simple-file-error
-               :format-control "~S is ambiguous:~{~%  ~A~}"
-               :format-arguments (list pathname-spec matches))))))
+      (t (bug "!ENUMERATE-MATCHES returned more than one match on a non-wild pathname")))))

 \f
 ;;;; TRUENAME and PROBE-FILE
 
 \f
 ;;;; TRUENAME and PROBE-FILE
 

@@ -703,27 +705,19 @@
 
   Under Unix, the TRUENAME of a broken symlink is considered to be
   the name of the broken symlink itself."
 
   Under Unix, the TRUENAME of a broken symlink is considered to be
   the name of the broken symlink itself."

-  (if (wild-pathname-p pathname)
+  (let ((result (probe-file pathname)))
+    (unless result

       (error 'simple-file-error
       (error 'simple-file-error

-            :format-control "can't use a wild pathname here"
-            :pathname pathname)
-      (let ((result (probe-file pathname)))
-       (unless result
-         (error 'simple-file-error
-                :pathname pathname
-                :format-control "The file ~S does not exist."
-                :format-arguments (list (namestring pathname))))
-       result)))
+            :pathname pathname
+            :format-control "The file ~S does not exist."
+            :format-arguments (list (namestring pathname))))
+    result))

 
 ;;; If PATHNAME exists, return its truename, otherwise NIL.
 (defun probe-file (pathname)
   #!+sb-doc
   "Return a pathname which is the truename of the file if it exists, or NIL
   otherwise. An error of type FILE-ERROR is signaled if pathname is wild."
 
 ;;; If PATHNAME exists, return its truename, otherwise NIL.
 (defun probe-file (pathname)
   #!+sb-doc
   "Return a pathname which is the truename of the file if it exists, or NIL
   otherwise. An error of type FILE-ERROR is signaled if pathname is wild."

-  (when (wild-pathname-p pathname)
-    (error 'simple-file-error
-          :pathname pathname
-          :format-control "can't use a wild pathname here"))

   (let* ((defaulted-pathname (merge-pathnames
                              pathname
                              (sane-default-pathname-defaults)))
   (let* ((defaulted-pathname (merge-pathnames
                              pathname
                              (sane-default-pathname-defaults)))

@@ -789,43 +783,30 @@
   #!+sb-doc
   "Return file's creation date, or NIL if it doesn't exist.
  An error of type file-error is signaled if file is a wild pathname"
   #!+sb-doc
   "Return file's creation date, or NIL if it doesn't exist.
  An error of type file-error is signaled if file is a wild pathname"

-  (if (wild-pathname-p file)
-      ;; FIXME: This idiom appears many times in this file. Perhaps it
-      ;; should turn into (CANNOT-BE-WILD-PATHNAME FILE). (C-B-W-P
-      ;; should be a macro, not a function, so that the error message
-      ;; is reported as coming from e.g. FILE-WRITE-DATE instead of
-      ;; from CANNOT-BE-WILD-PATHNAME itself.)
-      (error 'simple-file-error
-            :pathname file
-            :format-control "bad place for a wild pathname")
-      (let ((name (unix-namestring file t)))
-       (when name
-         (multiple-value-bind
-             (res dev ino mode nlink uid gid rdev size atime mtime)
-             (sb!unix:unix-stat name)
-           (declare (ignore dev ino mode nlink uid gid rdev size atime))
-           (when res
-             (+ unix-to-universal-time mtime)))))))
+  (let ((name (unix-namestring file t)))
+    (when name
+      (multiple-value-bind
+           (res dev ino mode nlink uid gid rdev size atime mtime)
+         (sb!unix:unix-stat name)
+       (declare (ignore dev ino mode nlink uid gid rdev size atime))
+       (when res
+         (+ unix-to-universal-time mtime))))))

 
 (defun file-author (file)
   #!+sb-doc
   "Return the file author as a string, or NIL if the author cannot be
  determined. Signal an error of type FILE-ERROR if FILE doesn't exist,
  or FILE is a wild pathname."
 
 (defun file-author (file)
   #!+sb-doc
   "Return the file author as a string, or NIL if the author cannot be
  determined. Signal an error of type FILE-ERROR if FILE doesn't exist,
  or FILE is a wild pathname."

-  (if (wild-pathname-p file)
+  (let ((name (unix-namestring (pathname file) t)))
+    (unless name

       (error 'simple-file-error
             :pathname file
       (error 'simple-file-error
             :pathname file

-            "bad place for a wild pathname")
-      (let ((name (unix-namestring (pathname file) t)))
-       (unless name
-         (error 'simple-file-error
-                :pathname file
-                :format-control "~S doesn't exist."
-                :format-arguments (list file)))
-       (multiple-value-bind (winp dev ino mode nlink uid)
-           (sb!unix:unix-stat name)
-         (declare (ignore dev ino mode nlink))
-         (and winp (sb!unix:uid-username uid))))))
+            :format-control "~S doesn't exist."
+            :format-arguments (list file)))
+    (multiple-value-bind (winp dev ino mode nlink uid)
+       (sb!unix:unix-stat name)
+      (declare (ignore dev ino mode nlink))
+      (and winp (sb!unix:uid-username uid)))))

 \f
 ;;;; DIRECTORY
 
 \f
 ;;;; DIRECTORY
 

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 4b92965..5bf3aa3 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -849,6 +849,16 @@
                #+sb-xc-host (coerce types 'list)
                #-sb-xc-host (coerce-to-list types)))))
 
                #+sb-xc-host (coerce types 'list)
                #-sb-xc-host (coerce-to-list types)))))
 

+(defun maybe-distribute-one-union (union-type types)
+  (let* ((intersection (apply #'type-intersection types))
+        (union (mapcar (lambda (x) (type-intersection x intersection))
+                       (union-type-types union-type))))
+    (if (notany (lambda (x) (or (hairy-type-p x)
+                               (intersection-type-p x)))
+               union)
+       union
+       nil)))
+

 (defun type-intersection (&rest input-types)
   (let ((simplified-types (simplified-compound-types input-types
                                                     #'intersection-type-p
 (defun type-intersection (&rest input-types)
   (let ((simplified-types (simplified-compound-types input-types
                                                     #'intersection-type-p

@@ -860,11 +870,17 @@
     ;; always achieve that by the distributive rule. But we don't want
     ;; to just apply the distributive rule, since it would be too easy
     ;; to end up with unreasonably huge type expressions. So instead
     ;; always achieve that by the distributive rule. But we don't want
     ;; to just apply the distributive rule, since it would be too easy
     ;; to end up with unreasonably huge type expressions. So instead

-    ;; we punt to HAIRY-TYPE when this comes up.
+    ;; we try to generate a simple type by distributing the union; if
+    ;; the type can't be made simple, we punt to HAIRY-TYPE.

     (if (and (> (length simplified-types) 1)
             (some #'union-type-p simplified-types))
     (if (and (> (length simplified-types) 1)
             (some #'union-type-p simplified-types))

-       (make-hairy-type
-        :specifier `(and ,@(map 'list #'type-specifier simplified-types)))
+       (let* ((first-union (find-if #'union-type-p simplified-types))
+              (other-types (coerce (remove first-union simplified-types) 'list))
+              (distributed (maybe-distribute-one-union first-union other-types)))
+         (if distributed
+             (apply #'type-union distributed)
+             (make-hairy-type
+              :specifier `(and ,@(map 'list #'type-specifier simplified-types)))))

        (make-compound-type-or-something #'%make-intersection-type
                                         simplified-types
                                         (some #'type-enumerable
        (make-compound-type-or-something #'%make-intersection-type
                                         simplified-types
                                         (some #'type-enumerable

diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp
index 9254a35..48a96c4 100644 (file)
--- a/src/code/target-load.lisp
+++ b/src/code/target-load.lisp
@@ -183,40 +183,29 @@
                        '(unsigned-byte 8)))
             (load-as-fasl filespec verbose print)
             (load-as-source filespec verbose print))
                        '(unsigned-byte 8)))
             (load-as-fasl filespec verbose print)
             (load-as-source filespec verbose print))

-        (let (;; FIXME: MERGE-PATHNAMES doesn't work here for
-              ;; FILESPEC="TEST:Load-Test" and
-              ;; (LOGICAL-PATHNAME-TRANSLATIONS "TEST")
-              ;;   = (("**;*.*.*" "/foo/bar/**/*.*")).
-              ;; Physicalizing the pathname before merging 
-              ;; is a workaround, but the ANSI spec talks about
-              ;; MERGE-PATHNAMES accepting (and returning)
-              ;; logical pathnames, so a true fix would probably
-              ;; include fixing MERGE-PATHNAMES, then probably
-              ;; revisiting this code.
-              (ppn (physicalize-pathname (pathname filespec))))
-          (if (wild-pathname-p ppn)
-              (let ((files (directory ppn)))
-                #!+high-security
-                (when (null files)
-                  (error 'file-error :pathname filespec))
-                (dolist (file files t)
-                  (internal-load ppn
-                                 file
-                                 internal-if-does-not-exist
-                                 verbose
-                                 print)))
-              (let ((tn (probe-file ppn)))
-                (if (or tn (pathname-type ppn))
-                    (internal-load ppn
-                                   tn
-                                   internal-if-does-not-exist
-                                   verbose
-                                   print)
-                    (internal-load-default-type
-                     ppn
-                     internal-if-does-not-exist
-                     verbose
-                     print)))))))))
+        (let* (;; FIXME: MERGE-PATHNAMES doesn't work here for
+               ;; FILESPEC="TEST:Load-Test" and
+               ;; (LOGICAL-PATHNAME-TRANSLATIONS "TEST")
+               ;;   = (("**;*.*.*" "/foo/bar/**/*.*")).
+               ;; Physicalizing the pathname before merging 
+               ;; is a workaround, but the ANSI spec talks about
+               ;; MERGE-PATHNAMES accepting (and returning)
+               ;; logical pathnames, so a true fix would probably
+               ;; include fixing MERGE-PATHNAMES, then probably
+               ;; revisiting this code.
+               (ppn (physicalize-pathname (pathname filespec)))
+               (unix-name (unix-namestring ppn t)))
+          (if (or unix-name (pathname-type ppn))
+              (internal-load ppn
+                             unix-name
+                             internal-if-does-not-exist
+                             verbose
+                             print)
+              (internal-load-default-type
+               ppn
+               internal-if-does-not-exist
+               verbose
+               print)))))))

 \f
 ;;; Load a code object. BOX-NUM objects are popped off the stack for
 ;;; the boxed storage section, then SIZE bytes of code are read in.
 \f
 ;;; Load a code object. BOX-NUM objects are popped off the stack for
 ;;; the boxed storage section, then SIZE bytes of code are read in.

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 1cb1a64..772b90f 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -512,12 +512,7 @@
                  `(if (<= ,n-svalue ,n-end ,n-len)
                       ;; success
                       (values ,n-array ,n-svalue ,n-end 0)
                  `(if (<= ,n-svalue ,n-end ,n-len)
                       ;; success
                       (values ,n-array ,n-svalue ,n-end 0)

-                      ;; failure: Make a NOTINLINE call to
-                      ;; %WITH-ARRAY-DATA with our bad data
-                      ;; to cause the error to be signalled.
-                      (locally
-                        (declare (notinline %with-array-data))
-                        (%with-array-data ,n-array ,n-svalue ,n-evalue)))))
+                      (failed-%with-array-data ,n-array ,n-svalue ,n-evalue))))

             (,(if force-inline '%with-array-data-macro '%with-array-data)
              ,n-array ,n-svalue ,n-evalue))
        ,@forms)))
             (,(if force-inline '%with-array-data-macro '%with-array-data)
              ,n-array ,n-svalue ,n-evalue))
        ,@forms)))

@@ -561,16 +556,12 @@
         (declare (type index ,cumulative-offset))))))
 
 (deftransform %with-array-data ((array start end)
         (declare (type index ,cumulative-offset))))))
 
 (deftransform %with-array-data ((array start end)

-                               ;; Note: This transform is limited to
-                               ;; VECTOR only because I happened to
-                               ;; create it in order to get sequence
-                               ;; function operations to be more
-                               ;; efficient. It might very well be
-                               ;; reasonable to allow general ARRAY
-                               ;; here, I just haven't tried to
-                               ;; understand the performance issues
-                               ;; involved. -- WHN
-                               (vector index (or index null))
+                               ;; It might very well be reasonable to
+                               ;; allow general ARRAY here, I just
+                               ;; haven't tried to understand the
+                               ;; performance issues involved. --
+                               ;; WHN, and also CSR 2002-05-26
+                               (simple-array index (or index null))

                                *
                                :important t
                                :node node
                                *
                                :important t
                                :node node

diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index ca67036..246b911 100644 (file)
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -578,7 +578,7 @@
               (sb-kernel:order-layout-inherits
                (map 'simple-vector #'class-wrapper
                     (reverse (rest (class-precedence-list class))))))
               (sb-kernel:order-layout-inherits
                (map 'simple-vector #'class-wrapper
                     (reverse (rest (class-precedence-list class))))))

-      (sb-kernel:register-layout layout :invalidate nil)
+      (sb-kernel:register-layout layout)

 
       ;; Subclasses of formerly forward-referenced-class may be
       ;; unknown to CL:FIND-CLASS and also anonymous. This
 
       ;; Subclasses of formerly forward-referenced-class may be
       ;; unknown to CL:FIND-CLASS and also anonymous. This

diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp
index a1800e2..3e7ab3d 100644 (file)
--- a/tests/filesys.pure.lisp
+++ b/tests/filesys.pure.lisp
@@ -49,8 +49,24 @@
   ;; SBCL 0.7.1.2 failed to merge on OPEN
   (with-open-file (i "tests/filesys.pure.lisp")
       (assert i)))
   ;; SBCL 0.7.1.2 failed to merge on OPEN
   (with-open-file (i "tests/filesys.pure.lisp")
       (assert i)))

-  

 
 

+;;; OPEN, LOAD and friends should signal an error of type FILE-ERROR
+;;; if they are fed wild pathname designators; firstly, with wild
+;;; pathnames that don't correspond to any files:
+(assert (typep (nth-value 1 (ignore-errors (open "non-existent*.lisp")))
+              'file-error))
+(assert (typep (nth-value 1 (ignore-errors (load "non-existent*.lisp")))
+              'file-error))
+;;; then for pathnames that correspond to precisely one:
+(assert (typep (nth-value 1 (ignore-errors (open "filesys.pur*.lisp")))
+              'file-error))
+(assert (typep (nth-value 1 (ignore-errors (load "filesys.pur*.lisp")))
+              'file-error))
+;;; then for pathnames corresponding to many:
+(assert (typep (nth-value 1 (ignore-errors (open "*.lisp")))
+              'file-error))
+(assert (typep (nth-value 1 (ignore-errors (load "*.lisp")))
+              'file-error))

 
 ;;; ANSI: FILE-LENGTH should signal an error of type TYPE-ERROR if
 ;;; STREAM is not a stream associated with a file.
 
 ;;; ANSI: FILE-LENGTH should signal an error of type TYPE-ERROR if
 ;;; STREAM is not a stream associated with a file.

diff --git a/tests/type.impure.lisp b/tests/type.impure.lisp
index 5033591..bf127c7 100644 (file)
--- a/tests/type.impure.lisp
+++ b/tests/type.impure.lisp
@@ -182,6 +182,11 @@
 ;;; thing to want anyway, let's test for it here:
 (assert-t-t (subtypep '(or some-undefined-type (member :no-ir2-yet :dead))
                      '(or some-undefined-type (member :no-ir2-yet :dead))))
 ;;; thing to want anyway, let's test for it here:
 (assert-t-t (subtypep '(or some-undefined-type (member :no-ir2-yet :dead))
                      '(or some-undefined-type (member :no-ir2-yet :dead))))

+;;; BUG 158 (failure to compile loops with vector references and
+;;; increments of greater than 1) was a symptom of type system
+;;; uncertainty, to wit:
+(assert-t-t (subtypep '(and (mod 536870911) (or (integer 0 0) (integer 2 536870912)))
+                     '(mod 536870911))) ; aka SB-INT:INDEX.

 \f
 ;;;; Douglas Thomas Crosher rewrote the CMU CL type test system to
 ;;;; allow inline type tests for CONDITIONs and STANDARD-OBJECTs, and
 \f
 ;;;; Douglas Thomas Crosher rewrote the CMU CL type test system to
 ;;;; allow inline type tests for CONDITIONs and STANDARD-OBJECTs, and

@@ -337,6 +342,13 @@
   #.*tests-of-inline-type-tests*)
 (tests-of-inline-type-tests)
 (format t "~&/done with compiled (TESTS-OF-INLINE-TYPE-TESTS)~%")
   #.*tests-of-inline-type-tests*)
 (tests-of-inline-type-tests)
 (format t "~&/done with compiled (TESTS-OF-INLINE-TYPE-TESTS)~%")

-
+\f
+;;; Redefinition of classes should alter the type hierarchy (BUG 140):
+(defclass superclass () ())
+(defclass maybe-subclass (superclass) ())
+(assert-t-t (subtypep 'maybe-subclass 'superclass))
+(defclass maybe-subclass () ())
+(assert-nil-t (subtypep 'maybe-subclass 'superclass))
+\f

 ;;; success
 (quit :unix-status 104)
 ;;; success
 (quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index c74a620..76aca69 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 

-"0.7.4"
+"0.7.4.1"