Raymond Toy pushed to branch master at cmucl / cmucl

Commits: 3a206076 by Raymond Toy at 2024-03-29T15:43:02+00:00 Fix #291: pprint handler-case neatly

- - - - - 7c6275a2 by Raymond Toy at 2024-03-29T15:43:03+00:00 Merge branch 'issue-291-pprint-handler-case' into 'master'

Fix #291: pprint handler-case neatly

Closes #291

See merge request cmucl/cmucl!200 - - - - -

3 changed files:

- src/code/pprint.lisp - src/i18n/locale/cmucl.pot - tests/pprint.lisp

Changes:

===================================== src/code/pprint.lisp ===================================== @@ -1457,6 +1457,19 @@ When annotations are present, invoke them at the right positions." (declare (ignore noise)) (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~W~}~:>") stream list)) + +(defun pprint-handler-case (stream list &rest noise) + (declare (ignore noise)) + ;; Like pprint-handler-bind, but each of the error clauses is + ;; printed with declarations and forms on a separate line, indented + ;; like a function body. The handler-case part, "~:<~^~W~3I + ;; ~:_~W~1I~@{ ~:@_...~:>" comes from pprint-handler-bind, but the + ;; last "~W" is replaced to print out the error clauses in the way + ;; we want. These are done with "~:<~W~^~3I ~:_~W~^~1I~@{ + ;; ~@:_~W~}~:>", taken from PPRINT-WITH-LIKE. + (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~:<~W~^~3I ~:_~W~^~1I~@{ ~@:_~W~}~:>~}~:>") + stream list)) +

(defun pprint-quote (stream list &rest noise) (declare (ignore noise)) @@ -2021,7 +2034,7 @@ When annotations are present, invoke them at the right positions." (ecase pprint-case) (etypecase pprint-typecase) (handler-bind pprint-handler-bind) - (handler-case pprint-handler-bind) + (handler-case pprint-handler-case) ;; Loop is handled by pprint-loop.lisp #+nil(loop pprint-loop) (multiple-value-bind pprint-multiple-value-bind)

===================================== src/i18n/locale/cmucl.pot ===================================== @@ -8731,6 +8731,10 @@ msgstr "" msgid "Number not representable as a ~S: ~S" msgstr ""

+#: src/code/reader.lisp +msgid "Underflow" +msgstr "" + #: src/code/reader.lisp msgid "Invalid ratio: ~S/~S" msgstr ""

===================================== tests/pprint.lisp ===================================== @@ -26,3 +26,98 @@ (pprint '(ext:with-float-traps-enabled (:underflow) (print "Hello")) s)))) + +(define-test pprint.handler-case.1 + (:tag :issues) + ;; Just an expression + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition)) + s)))) + +(define-test pprint.handler-case.2 + (:tag :issues) + ;; One error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + "Lots of smoke, but no fire."))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.")) + s)))) + +(define-test pprint.handler-case.3 + (:tag :issues) + ;; More than one error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + "Lots of smoke, but no fire.") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL "~S looks especially bad." CONDITION)))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition))) + s)))) + +(define-test pprint.handler-case.4 + (:tag :issues) + ;; An expression and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (:NO-ERROR NIL + (FORMAT NIL "Nothing bad happened.")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + + +(define-test pprint.handler-case.5 + (:tag :issues) + ;; One error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + "Lots of smoke, but no fire.") + (:NO-ERROR NIL + (FORMAT NIL "Nothing bad happened.")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + (:no-error () + (format nil "Nothing bad happened."))) + s)))) + +(define-test pprint.handler-case.6 + (:tag :issues) + ;; More than one error clause and a no-error clause + (assert-equal + " +(HANDLER-CASE (SIGNAL CONDITION) + (WARNING NIL + "Lots of smoke, but no fire.") + ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION) + (FORMAT NIL "~S looks especially bad." CONDITION)) + (:NO-ERROR NIL + (FORMAT NIL "Nothing bad happened.")))" + (with-output-to-string (s) + (pprint '(handler-case (signal condition) + (warning () "Lots of smoke, but no fire.") + ((or arithmetic-error control-error cell-error stream-error) + (condition) + (format nil "~S looks especially bad." condition)) + (:no-error () + (format nil "Nothing bad happened."))) + s))))

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1bc977276cfcbcf56e38bd1...