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 (file)
--- 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 (file)
--- 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 (file)
--- 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)))))
-\f
-;;;; 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 (file)
--- 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 (file)
--- 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))
 \f
 ;;;; 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))))
 \f
@@ -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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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))))
+  
 \f
 ;;; variables
 (defmethod documentation ((x symbol) (doc-type (eql 'variable)))

diff --git a/version.lisp-expr b/version.lisp-expr
index c9358db..5adfde9 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".)
-"0.9.0.37"
+"0.9.0.38"