[Git][cmucl/cmucl][master] 2 commits: Fix #143 - Adds argument checking for lisp-streams and Gray sttreams for LISTEN

[Jon Boone (@jboone)]

Jon Boone pushed to branch master at cmucl / cmucl


Commits:
6162e5b4 by Jon Boone at 2023-05-09T17:38:36+00:00
Fix #143 - Adds argument checking for lisp-streams and Gray sttreams for LISTEN

- - - - -
e472bd4f by Jon Boone at 2023-05-09T17:38:47+00:00
Merge branch 'issue-143-ansi-compliance-failure-listen-extra-argument' into 'master'

Fix #143 - Adds argument checking for lisp-streams and Gray sttreams for LISTEN

Closes #143

See merge request cmucl/cmucl!145
- - - - -


1 changed file:

- src/code/stream.lisp


Changes:

=====================================
src/code/stream.lisp
=====================================
@@ -604,19 +604,34 @@
 	   :skipped-char-form ()
 	   :eof-detected-form (eof-or-lose stream eof-errorp eof-value))))))
 
-(defun listen (&optional (stream *standard-input*) (width 1))
-  "Returns T if a character is available on the given Stream."
+(defun listen (&optional (stream *standard-input*) (width 1 width-p))
+  _N"Returns T if a character is available on the given Stream.
+  Argument Width is only used by instances of SIMPLE-STREAM. If
+  Stream is a LISP-STREAM or FUNDAMENTAL-STREAM, passing more
+  than one argument is invalid."
   (declare (type streamlike stream))
   (let ((stream (in-synonym-of stream)))
     (stream-dispatch stream
       ;; simple-stream
       (stream::%listen stream width)
       ;; lisp-stream
-      (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))
+      (progn
+	(when width-p
+	  (error 'kernel:simple-program-error
+		 :function-name 'listen
+		 :format-control (intl:gettext "Invalid number of arguments: ~S")
+		 :format-arguments (list 2)))
+	(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))))
+      (progn
+	(when width-p
+	  (error 'kernel:simple-program-error
+		 :function-name 'listen
+		 :format-control (intl:gettext "Invalid number of arguments: ~S")
+		 :format-arguments (list 2)))
+	(stream-listen stream)))))
 
 (defun read-char-no-hang (&optional (stream *standard-input*)
 				    (eof-errorp t) eof-value recursive-p)



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/fa4edacbea17140c0e869ac54692b0278ee7178b...e472bd4ff2846f2f6d4ac65b3494215b77d1e8e9

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/fa4edacbea17140c0e869ac54692b0278ee7178b...e472bd4ff2846f2f6d4ac65b3494215b77d1e8e9
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/20230509/454d2020/attachment-0001.html>