[Bug-openmcl] consolidated patch

[bryan o'connor]

there were just a few minor patches against the latest
bleeding-edge cvs that haven't been integrated yet.

with these patches and the latest ansi-test suite which fixes
the make-broadcast-stream contradictions, we are back squarely
at 66 failures.  90% of those are related to subtypep, pathname,
or :element-type of [un]signed-byte > 32.  i'd categorize the
subtypep tests as worthwhile to eventually fix; the others seem
less like bugs and more like "implementation-defined behavior"
which should just be documented somewhere for now.

ansi bug fixes in the patch below:
  - invoke-restart should return nil when the restart-function is nil.
  - with-simple-restart should return (values nil T).
  - read-byte and write-byte must type-check the stream arg.
  - file-length from the previous message.

				...bryan


-------------- next part --------------
Index: level-1/l1-error-system.lisp
===================================================================
RCS file: /usr/local/tmpcvs/ccl-0.14-dev/ccl/level-1/l1-error-system.lisp,v
retrieving revision 1.6
diff -c -3 -r1.6 l1-error-system.lisp
*** level-1/l1-error-system.lisp	26 Jan 2004 12:06:46 -0000	1.6
--- level-1/l1-error-system.lisp	31 Jan 2004 18:33:43 -0000
***************
*** 494,500 ****
      (let ((fn (%restart-action restart)))
        (cond ((null fn)                  ; simple restart
               (unless (null values) (%err-disp $xtminps))
!              (throw tag (values nil T)))
              ((fixnump fn)               ; restart case
               (throw tag (cons fn values)))
              (t (apply fn values))))))   ; restart bind
--- 494,500 ----
      (let ((fn (%restart-action restart)))
        (cond ((null fn)                  ; simple restart
               (unless (null values) (%err-disp $xtminps))
!              (throw tag nil))
              ((fixnump fn)               ; restart case
               (throw tag (cons fn values)))
              (t (apply fn values))))))   ; restart bind
Index: level-1/l1-streams.lisp
===================================================================
RCS file: /usr/local/tmpcvs/ccl-0.14-dev/ccl/level-1/l1-streams.lisp,v
retrieving revision 1.10
diff -c -3 -r1.10 l1-streams.lisp
*** level-1/l1-streams.lisp	30 Jan 2004 23:56:26 -0000	1.10
--- level-1/l1-streams.lisp	31 Jan 2004 18:33:46 -0000
***************
*** 2335,2341 ****
    (etypecase stream
      ;; Don't use an OR type here
      (file-stream (stream-length stream))
!     (broadcast-stream (stream-length stream))))
    
  (defun file-position (stream &optional position)
    (when position
--- 2335,2346 ----
    (etypecase stream
      ;; Don't use an OR type here
      (file-stream (stream-length stream))
!     (synonym-stream (file-length 
!                      (symbol-value (synonym-stream-symbol stream))))
!     (broadcast-stream (let* ((last (last-broadcast-stream stream)))
!                         (if last
!                             (file-length last)
!                           0)))))
    
  (defun file-position (stream &optional position)
    (when position
Index: lib/macros.lisp
===================================================================
RCS file: /usr/local/tmpcvs/ccl-0.14-dev/ccl/lib/macros.lisp,v
retrieving revision 1.9
diff -c -3 -r1.9 macros.lisp
*** lib/macros.lisp	30 Jan 2004 19:30:14 -0000	1.9
--- lib/macros.lisp	31 Jan 2004 18:33:49 -0000
***************
*** 423,429 ****
      (let ((stream (gensym)))
        (setq format-string `#'(lambda (,stream) (format ,stream ,format-string , at format-args)))))
    `(let* ((,temp (%cons-restart ',restart-name
!                                 nil
                                  ,format-string
                                  nil
                                  nil))
--- 423,429 ----
      (let ((stream (gensym)))
        (setq format-string `#'(lambda (,stream) (format ,stream ,format-string , at format-args)))))
    `(let* ((,temp (%cons-restart ',restart-name
!                                 #'(lambda () (values nil T))
                                  ,format-string
                                  nil
                                  nil))
Index: lib/streams.lisp
===================================================================
RCS file: /usr/local/tmpcvs/ccl-0.14-dev/ccl/lib/streams.lisp,v
retrieving revision 1.1.1.1
diff -c -3 -r1.1.1.1 streams.lisp
*** lib/streams.lisp	19 Oct 2003 08:57:12 -0000	1.1.1.1
--- lib/streams.lisp	31 Jan 2004 18:33:50 -0000
***************
*** 82,88 ****
  
  (defun read-byte (stream &optional (eof-error-p t) eof-value)
    (check-eof
!    (stream-read-byte stream)
     stream
     eof-error-p
     eof-value))
--- 82,88 ----
  
  (defun read-byte (stream &optional (eof-error-p t) eof-value)
    (check-eof
!    (stream-read-byte (require-type stream 'stream))
     stream
     eof-error-p
     eof-value))
***************
*** 108,114 ****
    80)
  
  (defun write-byte (integer stream)
!   (stream-write-byte stream integer)
    integer)
  
  
--- 108,114 ----
    80)
  
  (defun write-byte (integer stream)
!   (stream-write-byte (require-type stream 'stream) integer)
    integer)
  
  
-------------- next part --------------