Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

3 changed files:

Changes:

  • src/code/pprint.lisp
    ... ... @@ -1457,6 +1457,19 @@ When annotations are present, invoke them at the right positions."
    1457 1457 
       (declare (ignore noise))
    1458 1458 
       (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~W~}~:>")
    1459 1459 
     	   stream list))
    1460 
    +
    1461 
    +(defun pprint-handler-case (stream list &rest noise)
    1462 
    +  (declare (ignore noise))
    1463 
    +  ;; Like pprint-handler-bind, but each of the error clauses is
    1464 
    +  ;; printed with declarations and forms on a separate line, indented
    1465 
    +  ;; like a function body.  The handler-case part, "~:<~^~W~3I
    1466 
    +  ;; ~:_~W~1I~@{ ~:@_...~:>" comes from pprint-handler-bind, but the
    1467 
    +  ;; last "~W" is replaced to print out the error clauses in the way
    1468 
    +  ;; we want.  These are done with "~:<~W~^~3I ~:_~W~^~1I~@{
    1469 
    +  ;; ~@:_~W~}~:>", taken from PPRINT-WITH-LIKE.
    1470 
    +  (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~:<~W~^~3I ~:_~W~^~1I~@{ ~@:_~W~}~:>~}~:>")
    1471 
    +	   stream list))
    1472 
    +
    1460 1473
    1461 1474 
     (defun pprint-quote (stream list &rest noise)
    1462 1475 
       (declare (ignore noise))
    ... ... @@ -2021,7 +2034,7 @@ When annotations are present, invoke them at the right positions."
    2021 2034 
         (ecase pprint-case)
    2022 2035 
         (etypecase pprint-typecase)
    2023 2036 
         (handler-bind pprint-handler-bind)
    2024 
    -    (handler-case pprint-handler-bind)
    2037 
    +    (handler-case pprint-handler-case)
    2025 2038 
         ;; Loop is handled by pprint-loop.lisp
    2026 2039 
         #+nil(loop pprint-loop)
    2027 2040 
         (multiple-value-bind pprint-multiple-value-bind)

  • src/i18n/locale/cmucl.pot
    ... ... @@ -8731,6 +8731,10 @@ msgstr ""
    8731 8731 
     msgid "Number not representable as a ~S: ~S"
    8732 8732 
     msgstr ""
    8733 8733
    8734 
    +#: src/code/reader.lisp
    8735 
    +msgid "Underflow"
    8736 
    +msgstr ""
    8737 
    +
    8734 8738 
     #: src/code/reader.lisp
    8735 8739 
     msgid "Invalid ratio: ~S/~S"
    8736 8740 
     msgstr ""

  • tests/pprint.lisp
    ... ... @@ -26,3 +26,98 @@
    26 26 
            (pprint '(ext:with-float-traps-enabled (:underflow)
    27 27 
                      (print "Hello"))
    28 28 
                    s))))
    29 
    +
    30 
    +(define-test pprint.handler-case.1
    31 
    +    (:tag :issues)
    32 
    +  ;; Just an expression
    33 
    +  (assert-equal
    34 
    +   "
    35 
    +(HANDLER-CASE (SIGNAL CONDITION))"
    36 
    +    (with-output-to-string (s)
    37 
    +      (pprint '(handler-case (signal condition))
    38 
    +              s))))
    39 
    +
    40 
    +(define-test pprint.handler-case.2
    41 
    +    (:tag :issues)
    42 
    +  ;; One error clause
    43 
    +  (assert-equal
    44 
    +   "
    45 
    +(HANDLER-CASE (SIGNAL CONDITION)
    46 
    +  (WARNING NIL
    47 
    +    \"Lots of smoke, but no fire.\"))"
    48 
    +    (with-output-to-string (s)
    49 
    +      (pprint '(handler-case (signal condition)
    50 
    +                (warning () "Lots of smoke, but no fire."))
    51 
    +              s))))
    52 
    +
    53 
    +(define-test pprint.handler-case.3
    54 
    +    (:tag :issues)
    55 
    +  ;; More than one error clause
    56 
    +  (assert-equal
    57 
    +   "
    58 
    +(HANDLER-CASE (SIGNAL CONDITION)
    59 
    +  (WARNING NIL
    60 
    +    \"Lots of smoke, but no fire.\")
    61 
    +  ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION)
    62 
    +    (FORMAT NIL \"~S looks especially bad.\" CONDITION)))"
    63 
    +   (with-output-to-string (s)
    64 
    +     (pprint '(handler-case (signal condition)
    65 
    +               (warning () "Lots of smoke, but no fire.")
    66 
    +               ((or arithmetic-error control-error cell-error stream-error)
    67 
    +                (condition)
    68 
    +                (format nil "~S looks especially bad." condition)))
    69 
    +             s))))
    70 
    +
    71 
    +(define-test pprint.handler-case.4
    72 
    +    (:tag :issues)
    73 
    +  ;; An expression and a no-error clause
    74 
    +  (assert-equal
    75 
    +   "
    76 
    +(HANDLER-CASE (SIGNAL CONDITION)
    77 
    +  (:NO-ERROR NIL
    78 
    +    (FORMAT NIL \"Nothing bad happened.\")))"
    79 
    +   (with-output-to-string (s)
    80 
    +     (pprint '(handler-case (signal condition)
    81 
    +               (:no-error ()
    82 
    +                (format nil "Nothing bad happened.")))
    83 
    +             s))))
    84 
    +
    85 
    +
    86 
    +(define-test pprint.handler-case.5
    87 
    +    (:tag :issues)
    88 
    +  ;; One error clause and a no-error clause
    89 
    +  (assert-equal
    90 
    +   "
    91 
    +(HANDLER-CASE (SIGNAL CONDITION)
    92 
    +  (WARNING NIL
    93 
    +    \"Lots of smoke, but no fire.\")
    94 
    +  (:NO-ERROR NIL
    95 
    +    (FORMAT NIL \"Nothing bad happened.\")))"
    96 
    +   (with-output-to-string (s)
    97 
    +     (pprint '(handler-case (signal condition)
    98 
    +               (warning () "Lots of smoke, but no fire.")
    99 
    +               (:no-error ()
    100 
    +                (format nil "Nothing bad happened.")))
    101 
    +             s))))
    102 
    +
    103 
    +(define-test pprint.handler-case.6
    104 
    +    (:tag :issues)
    105 
    +  ;; More than one error clause and a no-error clause
    106 
    +  (assert-equal
    107 
    +   "
    108 
    +(HANDLER-CASE (SIGNAL CONDITION)
    109 
    +  (WARNING NIL
    110 
    +    \"Lots of smoke, but no fire.\")
    111 
    +  ((OR ARITHMETIC-ERROR CONTROL-ERROR CELL-ERROR STREAM-ERROR) (CONDITION)
    112 
    +    (FORMAT NIL \"~S looks especially bad.\" CONDITION))
    113 
    +  (:NO-ERROR NIL
    114 
    +    (FORMAT NIL \"Nothing bad happened.\")))"
    115 
    +   (with-output-to-string (s)
    116 
    +     (pprint '(handler-case (signal condition)
    117 
    +               (warning () "Lots of smoke, but no fire.")
    118 
    +               ((or arithmetic-error control-error cell-error stream-error)
    119 
    +                (condition)
    120 
    +                (format nil "~S looks especially bad." condition))
    121 
    +               (:no-error ()
    122 
    +                (format nil "Nothing bad happened.")))
    123 
    +             s))))

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. Manage all notifications · Help