[Git][cmucl/cmucl][issue-143-ansi-compliance-failure-listen-extra-argument] simplifies case where stream is of type lisp-stream and width provided

[Jon Boone (@jboone)]

Jon Boone pushed to branch issue-143-ansi-compliance-failure-listen-extra-argument at cmucl / cmucl


Commits:
ee8dae4c by Jon Boone at 2023-05-02T20:00:15-04:00
simplifies case where stream is of type lisp-stream and width provided

- - - - -


1 changed file:

- src/code/stream.lisp


Changes:

=====================================
src/code/stream.lisp
=====================================
@@ -604,7 +604,7 @@
 	   :skipped-char-form ()
 	   :eof-detected-form (eof-or-lose stream eof-errorp eof-value))))))
 
-(defun listen (&optional (stream *standard-input* stream-p) (width 1 width-p))
+(defun listen (&optional (stream *standard-input*) (width 1 width-p))
   "Returns T if a character is available on the given Stream."
   (declare (type streamlike stream))
   (let ((stream (in-synonym-of stream)))
@@ -612,26 +612,14 @@
       ;; simple-stream
       (stream::%listen stream width)
       ;; lisp-stream
-      (let ((error-type 'simple-program-error)
-            (function-name 'listen)
-            (format-control ())
-            (format-arguments ()))
-        (if width-p
-          ;; since width provided, two possible cases:
-          (progn
-            (if stream-p
-              ;; stream also provided, so too many arguments
-              (setf format-control (intl:gettext "Invalid number of arguments: ~S")
-                    format-arguments (list 3))
-              ;; stream init-form used, so invalid argument
-              (setf format-control (intl:gettext "Invalid argument: ~D")
-                    format-arguments (list 'width)))
-            (error error-type :function-name function-name
-                   :format-control format-control :format-arguments format-arguments))
-          ;; width not provided, so return expected value
-          (or (/= (the fixnum (lisp-stream-in-index stream)) in-buffer-length)
-            ;; Test for t explicitly since misc methods return :eof sometimes.
-            (eq (funcall (lisp-stream-misc stream) stream :listen) t))))
+      (when width-p
+	(error 'kernel:simple-program-error
+	       :function-name 'listen
+	       :format-control (intl:gettext "Invalid number of arguments: ~S")
+	       :format-arguments (list 3)))
+      (or (/= (the fixnum (lisp-stream-in-index stream)) in-buffer-length)
+          ;; Test for t explicitly since misc methods return :eof sometimes.
+          (eq (funcall (lisp-stream-misc stream) stream :listen) t))
       ;; fundamental-stream
       (stream-listen stream))))
 



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ee8dae4c3134419b32663631df9c3ab8fd65a318

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ee8dae4c3134419b32663631df9c3ab8fd65a318
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230503/2da20d63/attachment-0001.html>