next exiting thread, no need to gc to collect thread stacks anymore
** minor incompatible change: INTERRUPT-THREAD-ERROR-ERRNO removed
** WITH-RECURSIVE-LOCK can be nested in a WITH-MUTEX for the same lock
+ * fixed some bugs revealed by Paul Dietz' test suite:
+ ** SUBTYPEP is slightly more accurate on heinously complicated
+ CONS types where some of the members have uncertain (in the
+ NIL, NIL sense) type relationships to each other.
changes in sbcl-0.9.5 relative to sbcl-0.9.4:
* new feature: timers based on Zach Beane's excellent timer package
(let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))
(host (url-host url))
(port (url-port url))
- result)
+ result)
(declare (ignore port))
(unwind-protect
- (progn
- (socket-connect
- s (car (host-ent-addresses (get-host-by-name (url-host (or *proxy* url)))))
- (url-port (or *proxy* url)))
- (let ((stream (socket-make-stream s :input t :output t :buffering :full :external-format :iso-8859-1)))
- ;; we are exceedingly unportable about proper line-endings here.
- ;; Anyone wishing to run this under non-SBCL should take especial care
- (format stream "GET ~A HTTP/1.0~c~%Host: ~A~c~%Cookie: CCLAN-SITE=~A~c~%~c~%"
- url #\Return host #\Return *cclan-mirror* #\Return #\Return)
- (force-output stream)
- (setf result
- (list
- (let* ((l (read-line stream))
- (space (position #\Space l)))
- (parse-integer l :start (1+ space) :junk-allowed t))
- (loop for line = (read-line stream nil nil)
- until (or (null line) (eql (elt line 0) (code-char 13)))
- collect
- (let ((colon (position #\: line)))
- (cons (intern (string-upcase (subseq line 0 colon)) :keyword)
- (string-trim (list #\Space (code-char 13))
- (subseq line (1+ colon))))))
- stream))))
+ (progn
+ (socket-connect
+ s (car (host-ent-addresses (get-host-by-name (url-host (or *proxy* url)))))
+ (url-port (or *proxy* url)))
+ (let ((stream (socket-make-stream s :input t :output t :buffering :full :external-format :iso-8859-1)))
+ ;; we are exceedingly unportable about proper line-endings here.
+ ;; Anyone wishing to run this under non-SBCL should take especial care
+ (format stream "GET ~A HTTP/1.0~c~%Host: ~A~c~%Cookie: CCLAN-SITE=~A~c~%~c~%"
+ url #\Return host #\Return *cclan-mirror* #\Return #\Return)
+ (force-output stream)
+ (setf result
+ (list
+ (let* ((l (read-line stream))
+ (space (position #\Space l)))
+ (parse-integer l :start (1+ space) :junk-allowed t))
+ (loop for line = (read-line stream nil nil)
+ until (or (null line) (eql (elt line 0) (code-char 13)))
+ collect
+ (let ((colon (position #\: line)))
+ (cons (intern (string-upcase (subseq line 0 colon)) :keyword)
+ (string-trim (list #\Space (code-char 13))
+ (subseq line (1+ colon))))))
+ stream))))
(when (and (null result)
- (socket-open-p s))
- (socket-close s)))))
+ (socket-open-p s))
+ (socket-close s)))))
(defun download-files-for-package (package-name-or-url file-name)
(let ((url
;; more general case of the above, but harder to compute
((progn
(setf car-not1 (type-negation car-type1))
- (not (csubtypep car-type2 car-not1)))
+ (multiple-value-bind (yes win)
+ (csubtypep car-type2 car-not1)
+ (and (not yes) win)))
(frob-car car-type1 car-type2 cdr-type1 cdr-type2 car-not1))
((progn
(setf car-not2 (type-negation car-type2))
- (not (csubtypep car-type1 car-not2)))
+ (multiple-value-bind (yes win)
+ (csubtypep car-type1 car-not2)
+ (and (not yes) win)))
(frob-car car-type2 car-type1 cdr-type2 cdr-type1 car-not2))
;; Don't put these in -- consider the effect of taking the
;; union of (CONS (INTEGER 0 2) (INTEGER 5 7)) and
(assert (functionp (sb-pcl::ensure-ctor
(list 'sb-pcl::ctor (gensym)) nil nil))))
\f
+;;; from PFD ansi-tests
+(let ((t1 '(cons (cons (cons (real -744833699 -744833699) cons)
+ (integer -234496 215373))
+ integer))
+ (t2 '(cons (cons (cons integer integer)
+ (integer -234496 215373))
+ t)))
+ (assert (null (values (subtypep `(not ,t2) `(not ,t1))))))
+\f
;;; success
projects / sbcl.git / commitdiff