Permalink
Browse files

0.8.4.36:

	Fix bug 213a
	... CONS-TYPE-LENGTH-INFO to walk CONS-TYPE lists
	... delete the neat but ultimately flawed (CONS NIL T) test
		and use a proper test instead
	... test suite additions.
	Add idea from Michael Hudson (sbcl-devel 2003-08-26) to exit
		early from Darwin compilations when the stack size
		limit is too small.
  • Loading branch information...
csrhodes committed Oct 20, 2003
1 parent 9b87691 commit e3f68bde025bd0602cf554e1eaf5935aaa74662a
Showing with 94 additions and 45 deletions.
  1. +1 −5 BUGS
  2. +3 −0 NEWS
  3. +8 −0 make-config.sh
  4. +19 −12 src/code/coerce.lisp
  5. +18 −0 src/code/early-type.lisp
  6. +24 −23 src/code/seq.lisp
  7. +10 −4 src/code/sort.lisp
  8. +10 −0 tests/seq.impure.lisp
  9. +1 −1 version.lisp-expr
View
6 BUGS
@@ -727,11 +727,7 @@ WORKAROUND:
all of the arguments are circular is probably desireable).
213: "Sequence functions and type checking"
- a. MAKE-SEQUENCE, COERCE, MERGE and CONCATENATE cannot deal with
- various complicated, though recognizeable, CONS types [e.g.
- (CONS * (CONS * NULL))
- which according to ANSI should be recognized] (and, in SAFETY 3
- code, should return a list of LENGTH 2 or signal an error)
+ a. (fixed in 0.8.4.36)
b. MAP, when given a type argument that is SUBTYPEP LIST, does not
check that it will return a sequence of the given type. Fixing
it along the same lines as the others (cf. work done around
View
3 NEWS
@@ -2129,6 +2129,9 @@ changes in sbcl-0.8.5 relative to sbcl-0.8.4:
* bug fix: LOOP forms using NIL as a for-as-arithmetic counter no
longer raise an error; further, using a list as a for-as-arithmetic
counter now raises a meaningful error.
+ * fixed bug 213a: even fairly unreasonable CONS type specifiers are
+ now understood by sequence creation functions such as MAKE-SEQUENCE
+ and COERCE.
* compiler enhancement: SIGNUM is now better able to derive the type
of its result.
* type declarations inside WITH-SLOTS are checked. (reported by
View
@@ -178,6 +178,14 @@ elif [ "$sbcl_arch" = "ppc" -a "$sbcl_os" = "linux" ]; then
# versions 2.3.1 and 2.3.2
$GNUMAKE -C tools-for-build where-is-mcontext
tools-for-build/where-is-mcontext > src/runtime/ppc-linux-mcontext.h
+elif [ "$sbcl_arch" = "ppc" -a "$sbcl_os" = "darwin" ]; then
+ # The default stack ulimit under darwin is too small to run PURIFY.
+ # Best we can do is complain and exit at this stage
+ if [ $(ulimit -s) = "512" ]; then
+ echo "Your stack size limit is too small to build SBCL."
+ echo "See the limit(1) or ulimit(1) commands and the README file."
+ exit 1
+ fi
else
# Nothing need be done in this case, but sh syntax wants a placeholder.
echo > /dev/null
View
@@ -203,18 +203,25 @@
res))))
((csubtypep type (specifier-type 'list))
(if (vectorp object)
- (cond ((type= type (specifier-type 'list))
- (vector-to-list* object))
- ((type= type (specifier-type 'null))
- (if (= (length object) 0)
- 'nil
- (sequence-type-length-mismatch-error type
- (length object))))
- ((csubtypep (specifier-type '(cons nil t)) type)
- (if (> (length object) 0)
- (vector-to-list* object)
- (sequence-type-length-mismatch-error type 0)))
- (t (sequence-type-too-hairy (type-specifier type))))
+ (cond
+ ((type= type (specifier-type 'list))
+ (vector-to-list* object))
+ ((type= type (specifier-type 'null))
+ (if (= (length object) 0)
+ 'nil
+ (sequence-type-length-mismatch-error type
+ (length object))))
+ ((cons-type-p type)
+ (multiple-value-bind (min exactp)
+ (sb!kernel::cons-type-length-info type)
+ (let ((length (length object)))
+ (if exactp
+ (unless (= length min)
+ (sequence-type-length-mismatch-error type length))
+ (unless (>= length min)
+ (sequence-type-length-mismatch-error type length)))
+ (vector-to-list* object))))
+ (t (sequence-type-too-hairy (type-specifier type))))
(coerce-error)))
((csubtypep type (specifier-type 'vector))
(typecase object
View
@@ -460,6 +460,24 @@
(eq cdr-type *empty-type*))
*empty-type*
(%make-cons-type car-type cdr-type)))
+
+(defun cons-type-length-info (type)
+ (declare (type cons-type type))
+ (do ((min 1 (1+ min))
+ (cdr (cons-type-cdr-type type) (cons-type-cdr-type cdr)))
+ ((not (cons-type-p cdr))
+ (cond
+ ((csubtypep cdr (specifier-type 'null))
+ (values min t))
+ ((csubtypep *universal-type* cdr)
+ (values min nil))
+ ((type/= (type-intersection (specifier-type 'cons) cdr) *empty-type*)
+ (values min nil))
+ ((type/= (type-intersection (specifier-type 'null) cdr) *empty-type*)
+ (values min t))
+ (t (values min :maybe))))
+ ()))
+
;;;; type utilities
View
@@ -264,7 +264,7 @@
(defun make-sequence (type length &key (initial-element nil iep))
#!+sb-doc
"Return a sequence of the given TYPE and LENGTH, with elements initialized
- to :INITIAL-ELEMENT."
+ to INITIAL-ELEMENT."
(declare (fixnum length))
(let* ((adjusted-type
(typecase type
@@ -290,15 +290,15 @@
(if (= length 0)
'nil
(sequence-type-length-mismatch-error type length)))
- ((csubtypep (specifier-type '(cons nil t)) type)
- ;; The above is quite a neat way of finding out if
- ;; there's a type restriction on the CDR of the
- ;; CONS... if there is, I think it's probably fair to
- ;; give up; if there isn't, then the list to be made
- ;; must have a length of more than 0.
- (if (> length 0)
- (make-list length :initial-element initial-element)
- (sequence-type-length-mismatch-error type length)))
+ ((cons-type-p type)
+ (multiple-value-bind (min exactp)
+ (sb!kernel::cons-type-length-info type)
+ (if exactp
+ (unless (= length min)
+ (sequence-type-length-mismatch-error type length))
+ (unless (>= length min)
+ (sequence-type-length-mismatch-error type length)))
+ (make-list length :initial-element initial-element)))
;; We'll get here for e.g. (OR NULL (CONS INTEGER *)),
;; which may seem strange and non-ideal, but then I'd say
;; it was stranger to feed that type in to MAKE-SEQUENCE.
@@ -736,19 +736,20 @@
(and (vectorp x) (= (length x) 0))))
sequences)
'nil
- (sequence-type-length-mismatch-error type
- ;; FIXME: circular
- ;; list issues. And
- ;; rightward-drift.
- (reduce #'+
- (mapcar #'length
- sequences)))))
- ((csubtypep (specifier-type '(cons nil t)) type)
- (if (notevery (lambda (x) (or (null x)
- (and (vectorp x) (= (length x) 0))))
- sequences)
- (apply #'concat-to-list* sequences)
- (sequence-type-length-mismatch-error type 0)))
+ (sequence-type-length-mismatch-error
+ type
+ ;; FIXME: circular list issues.
+ (reduce #'+ sequences :key #'length))))
+ ((cons-type-p type)
+ (multiple-value-bind (min exactp)
+ (sb!kernel::cons-type-length-info type)
+ (let ((length (reduce #'+ sequences :key #'length)))
+ (if exactp
+ (unless (= length min)
+ (sequence-type-length-mismatch-error type length))
+ (unless (>= length min)
+ (sequence-type-length-mismatch-error type length)))
+ (apply #'concat-to-list* sequences))))
(t (sequence-type-too-hairy (type-specifier type)))))
((csubtypep type (specifier-type 'vector))
(apply #'concat-to-simple* output-type-spec sequences))
View
@@ -396,10 +396,16 @@
(sequence-type-length-mismatch-error type
(+ (length s1)
(length s2)))))
- (if (csubtypep (specifier-type '(cons nil t)) type)
- (if (and (null s1) (null s2))
- (sequence-type-length-mismatch-error type 0)
- (values (merge-lists* s1 s2 pred-fun key-fun)))
+ (if (cons-type-p type)
+ (multiple-value-bind (min exactp)
+ (sb!kernel::cons-type-length-info type)
+ (let ((length (+ (length s1) (length s2))))
+ (if exactp
+ (unless (= length min)
+ (sequence-type-length-mismatch-error type length))
+ (unless (>= length min)
+ (sequence-type-length-mismatch-error type length)))
+ (values (merge-lists* s1 s2 pred-fun key-fun))))
(sequence-type-too-hairy result-type))))
((csubtypep type (specifier-type 'vector))
(let* ((vector-1 (coerce sequence1 'vector))
View
@@ -299,31 +299,41 @@
;; MAKE-SEQUENCE
(assert-type-error (make-sequence 'cons 0))
(assert-type-error (make-sequence 'null 1))
+ (assert-type-error (make-sequence '(cons t null) 0))
+ (assert-type-error (make-sequence '(cons t null) 2))
;; KLUDGE: I'm not certain that this test actually tests for what
;; it should test, in that the type deriver and optimizers might
;; be too smart for the good of an exhaustive test system.
;; However, it makes me feel good. -- CSR, 2002-10-18
(assert (null (make-sequence 'null 0)))
(assert (= (length (make-sequence 'cons 3)) 3))
+ (assert (= (length (make-sequence '(cons t null) 1)) 1))
;; and NIL is not a valid type for MAKE-SEQUENCE
(assert-type-error (make-sequence 'nil 0))
;; COERCE
(assert-type-error (coerce #(1) 'null))
(assert-type-error (coerce #() 'cons))
+ (assert-type-error (coerce #() '(cons t null)))
+ (assert-type-error (coerce #(1 2) '(cons t null)))
(assert (null (coerce #() 'null)))
(assert (= (length (coerce #(1) 'cons)) 1))
+ (assert (= (length (coerce #(1) '(cons t null))) 1))
(assert-type-error (coerce #() 'nil))
;; MERGE
(assert-type-error (merge 'null '(1 3) '(2 4) '<))
(assert-type-error (merge 'cons () () '<))
(assert (null (merge 'null () () '<)))
(assert (= (length (merge 'cons '(1 3) '(2 4) '<)) 4))
+ (assert (= (length (merge '(cons t (cons t (cons t (cons t null))))
+ '(1 3) '(2 4) '<)) 4))
(assert-type-error (merge 'nil () () '<))
;; CONCATENATE
(assert-type-error (concatenate 'null '(1) "2"))
(assert-type-error (concatenate 'cons #() ()))
+ (assert-type-error (concatenate '(cons t null) #(1 2 3) #(4 5 6)))
(assert (null (concatenate 'null () #())))
(assert (= (length (concatenate 'cons #() '(1) "2 3")) 4))
+ (assert (= (length (concatenate '(cons t cons) '(1) "34")) 3))
(assert-type-error (concatenate 'nil '(3)))
;; FIXME: tests for MAP to come when some brave soul implements
;; the analogous type checking for MAP/%MAP.
View
@@ -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".)
-"0.8.4.35"
+"0.8.4.36"

0 comments on commit e3f68bd

Please sign in to comment.