From: Juho Snellman Date: Thu, 19 May 2005 02:50:38 +0000 (+0000) Subject: 0.9.0.38: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=af178240ffbda39e9c3bf584ad8ed0adcf4b6abd;p=sbcl.git 0.9.0.38: Fix a few ansi-test bugs: * The type-errors signalled for invalid function names now have a correct (if ugly) expected type. * Functions taking type names as arguments correctly signal type-errors (instead of package-lock errors, arg-count-errors, etc) for some pathological non-function names (e.g (SETF), (SETF . BAR)). * (SETF (DOCUMENTATION ... 'STRUCTURE)) no longer signals an error for structures defined with a :TYPE. * Documentation strings specified in the DEFSTRUCT form for typed structures are no longer immediately discarded (not strictly a bug, just a quality of implementation issue...) * FILE-STRING-LENGTH and STREAM-EXTERNAL-FORMAT now work on non-fd-streams too. * FILE-LENGTH now also works on broadcast streams. The spec has slightly conflicting opinions on this issue; FILE-LENGTH description says that stream must be associated with stream or an error is signalled. BROADCAST-STREAM description explicitly describes how FILE-LENGTH must be implemented. --- diff --git a/NEWS b/NEWS index 7d695ae..7fe3b8b 100644 --- a/NEWS +++ b/NEWS @@ -24,6 +24,14 @@ changes in sbcl-0.9.1 relative to sbcl-0.9.0: a file has the stream as its datum. ** type-errors on single-floats on x86-64 no longer have :INVALID-OBJECT as the datum + ** the type-errors signalled for invalid function names now have + a correct expected type + ** (SETF (DOCUMENTATION ... 'STRUCTURE)) no longer signals an error + for structures defined with a :TYPE. Documentation strings for + typed structures are no longer immediately discarded + ** FILE-STRING-LENGTH and STREAM-EXTERNAL-FORMAT now work on + broadcast streams and synonym streams. FILE-LENGTH now also works + on broadcast streams. changes in sbcl-0.9.0 relative to sbcl-0.8.21: * incompatible change: the --noprogrammer option, deprecated since diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 0062a7b..7ae0061 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -650,7 +650,7 @@ (unless (legal-fun-name-p name) (error 'simple-type-error :datum name - :expected-type '(or symbol list) + :expected-type '(or symbol (cons (member setf) (cons symbol null))) :format-control "invalid function name: ~S" :format-arguments (list name)))) diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 1d8b567..5c17dd1 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -1599,6 +1599,8 @@ (sb!sys:serve-all-events))) (:element-type (fd-stream-element-type fd-stream)) + (:external-format + (fd-stream-external-format fd-stream)) (:interactive-p (= 1 (the (member 0 1) (sb!unix:unix-isatty (fd-stream-fd fd-stream))))) @@ -1627,6 +1629,12 @@ (if (zerop mode) nil (truncate size (fd-stream-element-size fd-stream))))) + ;; FIXME: I doubt this is correct in the presence of Unicode, + ;; since fd-stream FILE-POSITION is measured in bytes. + (:file-string-length + (etypecase arg1 + (character 1) + (string (length arg1)))) (:file-position (fd-stream-file-position fd-stream arg1)))) @@ -2040,29 +2048,3 @@ t) (t (fd-stream-pathname stream))))) - -;;;; international character support (which is trivial for our simple -;;;; character sets) - -;;;; (Those who do Lisp only in English might not remember that ANSI -;;;; requires these functions to be exported from package -;;;; COMMON-LISP.) - -(defun file-string-length (stream object) - (declare (type (or string character) object) (type fd-stream stream)) - #!+sb-doc - "Return the delta in STREAM's FILE-POSITION that would be caused by writing - OBJECT to STREAM. Non-trivial only in implementations that support - international character sets." - (declare (ignore stream)) - (etypecase object - (character 1) - (string (length object)))) - -(defun stream-external-format (stream) - (declare (type fd-stream stream)) - #!+sb-doc - "Return the actual external format for fd-streams, otherwise :DEFAULT." - (if (typep stream 'fd-stream) - (fd-stream-external-format stream) - :default)) diff --git a/src/code/function-names.lisp b/src/code/function-names.lisp index 405916d..0f0f743 100644 --- a/src/code/function-names.lisp +++ b/src/code/function-names.lisp @@ -44,7 +44,8 @@ use as a BLOCK name in the function in question." (otherwise nil))) (define-function-name-syntax setf (name) - (when (cdr name) + (when (and (cdr name) + (consp (cdr name))) (destructuring-bind (fun &rest rest) (cdr name) (when (null rest) (typecase fun diff --git a/src/code/stream.lisp b/src/code/stream.lisp index b8ac730..969c562 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -115,6 +115,9 @@ (defun stream-element-type (stream) (ansi-stream-element-type stream)) +(defun stream-external-format (stream) + (funcall (ansi-stream-misc stream) stream :external-format)) + (defun interactive-stream-p (stream) (declare (type stream stream)) (funcall (ansi-stream-misc stream) stream :interactive-p)) @@ -201,8 +204,18 @@ ;; cause cross-compiler hangup. ;; ;; (declare (type (or file-stream synonym-stream) stream)) - (stream-must-be-associated-with-file stream) + ;; + ;; The description for FILE-LENGTH says that an error must be raised + ;; for streams not associated with files (which broadcast streams + ;; aren't according to the glossary). However, the behaviour of + ;; FILE-LENGTH for broadcast streams is explicitly described in the + ;; BROADCAST-STREAM entry. + (unless (typep stream 'broadcast-stream) + (stream-must-be-associated-with-file stream)) (funcall (ansi-stream-misc stream) stream :file-length)) + +(defun file-string-length (stream object) + (funcall (ansi-stream-misc stream) stream :file-string-length object)) ;;;; input functions @@ -618,6 +631,8 @@ (finish-output stream)) (:element-type (stream-element-type stream)) + (:stream-external-format + (stream-external-format stream)) (:interactive-p (interactive-stream-p stream)) (:line-length @@ -626,6 +641,8 @@ (charpos stream)) (:file-length (file-length stream)) + (:file-string-length + (file-string-length stream arg1)) (:file-position (file-position stream arg1)))) @@ -693,6 +710,15 @@ ((null streams) res) (when (null (cdr streams)) (setq res (stream-element-type (car streams))))))) + (:external-format + (let ((res :default)) + (dolist (stream streams res) + (setq res (stream-external-format stream))))) + (:file-length + (let ((last (last streams))) + (if last + (file-length (car last)) + 0))) (:file-position (if arg1 (let ((res (or (eql arg1 :start) (eql arg1 0)))) @@ -701,6 +727,10 @@ (let ((res 0)) (dolist (stream streams res) (setq res (file-position stream)))))) + (:file-string-length + (let ((res 1)) + (dolist (stream streams res) + (setq res (file-string-length stream arg1))))) (:close (set-closed-flame stream)) (t diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp index 33dc00d..7cf0795 100644 --- a/src/code/target-defstruct.lisp +++ b/src/code/target-defstruct.lisp @@ -237,7 +237,7 @@ #'listp)))) (when (dd-doc dd) - (setf (fdocumentation (dd-name dd) 'type) + (setf (fdocumentation (dd-name dd) 'structure) (dd-doc dd))) ;; the BOUNDP test here is to get past cold-init. diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp index 39f662c..88b3cbf 100644 --- a/src/code/target-package.lisp +++ b/src/code/target-package.lisp @@ -237,9 +237,11 @@ error if any of PACKAGES is not a valid package designator." #!+sb-package-locks (let* ((symbol (etypecase name (symbol name) - (list (if (eq 'setf (first name)) + (list (if (and (consp (cdr name)) + (eq 'setf (first name))) (second name) - ;; Skip (class-predicate foo), etc. + ;; Skip lists of length 1, single conses and + ;; (class-predicate foo), etc. ;; FIXME: MOP and package-lock ;; interaction needs to be thought about. (return-from diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index 322754b..b0decc0 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -1278,6 +1278,11 @@ :type :info :type-spec t :default nil) +(define-info-type + :class :typed-structure + :type :documentation + :type-spec (or string null) + :default nil) (define-info-class :declaration) (define-info-type diff --git a/src/pcl/documentation.lisp b/src/pcl/documentation.lisp index df24ea8..f1ab48b 100644 --- a/src/pcl/documentation.lisp +++ b/src/pcl/documentation.lisp @@ -144,8 +144,12 @@ (slot-value class 'documentation))))) (defmethod documentation ((x symbol) (doc-type (eql 'structure))) - (when (eq (info :type :kind x) :instance) - (values (info :type :documentation x)))) + (cond ((eq (info :type :kind x) :instance) + (values (info :type :documentation x))) + ((info :typed-structure :info x) + (values (info :typed-structure :documentation x))) + (t + (error "~S is not the name of a structure type." x)))) (defmethod (setf documentation) (new-value (x structure-class) @@ -178,9 +182,13 @@ (defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'structure))) - (unless (eq (info :type :kind x) :instance) - (error "~S is not the name of a structure type." x)) - (setf (info :type :documentation x) new-value)) + (cond ((eq (info :type :kind x) :instance) + (setf (info :type :documentation x) new-value)) + ((info :typed-structure :info x) + (setf (info :typed-structure :documentation x) new-value)) + (t + (error "~S is not the name of a structure type." x)))) + ;;; variables (defmethod documentation ((x symbol) (doc-type (eql 'variable))) diff --git a/version.lisp-expr b/version.lisp-expr index c9358db..5adfde9 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".) -"0.9.0.37" +"0.9.0.38"