Raymond Toy pushed to branch issue-275b-signal-float-underflow at cmucl / cmucl

Commits:

7 changed files:

Changes:

  • bin/run-ansi-tests.sh
    ... ... @@ -41,7 +41,7 @@ else
    41 41 
     fi
    42 42
    43 43 
     cd ../ansi-test
    44 
    -git checkout cmucl-expected-failures
    44 
    +git checkout issue-288-new-failures
    45 45
    46 46 
     make LISP="$LISP batch -noinit -nositeinit"
    47 47 
     # There should be no unexpected successes or failures; check these separately

  • 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/compiler/float-tran.lisp
    ... ... @@ -236,7 +236,7 @@
    236 236 
       (frob %random-single-float single-float)
    237 237 
       (frob %random-double-float double-float))
    238 238
    239 
    -#-(or new-random random-mt19937 rand-xoroshiro)
    239 
    +#-(or new-random random-mt19937 random-xoroshiro)
    240 240 
     (deftransform random ((num &optional state)
    241 241 
     		      ((integer 1 #.random-fixnum-max) &optional *))
    242 242 
       _N"use inline fixnum operations"
    ... ... @@ -259,7 +259,7 @@
    259 259 
       '(values (truncate (%random-double-float (coerce num 'double-float)
    260 260 
     		      (or state *random-state*)))))
    261 261
    262 
    -#+(or random-mt19937)
    262 
    +#+(or random-mt19937 random-xoroshiro)
    263 263 
     (deftransform random ((num &optional state)
    264 264 
     		      ((integer 1 #.(expt 2 32)) &optional *))
    265 265 
       _N"use inline (unsigned-byte 32) operations"

  • src/general-info/release-21f.md
    ... ... @@ -62,6 +62,9 @@ public domain.
    62 62 
         * ~~#278~~ Add some more debugging prints to gencgc
    63 63 
         * ~~#283~~ Add VOP for `integer-length` for `(unsigned-byte 32)` arg.
    64 64 
         * ~~#284~~ Microoptimize `signed-byte-32-int-len` VOP for x86.
    65 
    +    * ~~#288~~ Re-enable `deftransform` for random integers.
    66 
    +    * ~~#290~~ Pprint `with-float-traps-masked` better
    67 
    +    * ~~#291~~ Pprint `handler-case` neatly.
    65 68 
       * Other changes:
    66 69 
       * Improvements to the PCL implementation of CLOS:
    67 70 
       * Changes to building procedure:

  • src/i18n/locale/cmucl.pot
    ... ... @@ -19005,6 +19005,10 @@ msgstr ""
    19005 19005 
     msgid "use inline (unsigned-byte 32) operations"
    19006 19006 
     msgstr ""
    19007 19007
    19008 
    +#: src/compiler/float-tran.lisp
    19009 
    +msgid "Shouldn't happen"
    19010 
    +msgstr ""
    19011 
    +
    19008 19012 
     #: src/compiler/float-tran.lisp
    19009 19013 
     msgid "Can't open-code float to rational comparison."
    19010 19014 
     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))))

  • tests/rng.lisp
    ... ... @@ -82,3 +82,27 @@
    82 82 
         (assert-equal result (multiple-value-list
    83 83 
     			  (64-bit-rng-state *test-state*)))))
    84 84
    85 
    +;; Test that the deftransform for random integers is working.
    86 
    +(defun rng-int-trans (state)
    87 
    +  (declare (type random-state state)
    88 
    +           (optimize (speed 3)))
    89 
    +  (random 100000 state))
    90 
    +
    91 
    +(defun rng-int (n state)
    92 
    +  (declare (type random-state state))
    93 
    +  (random n state))
    94 
    +
    95 
    +(define-test deftransform-random-int
    96 
    +    (:tag :issues)
    97 
    +  ;; Using the same state, generate a random integer with RNG-INT.
    98 
    +  ;; This is the expected value.  The generate an integer with
    99 
    +  ;; RNG-INT-TRANS.  The compiler should have used a deftransform in
    100 
    +  ;; this function.  The values returned should be the same.
    101 
    +  (let ((state (kernel::make-random-object :state (kernel::init-random-state 31415926535))))
    102 
    +    (dotimes (k 2)
    103 
    +      (print state)
    104 
    +      (assert-equal (rng-int 100000 (make-random-state state))
    105 
    +                    (rng-int-trans (make-random-state state)))
    106 
    +      ;; Generate a random number to change our state.
    107 
    +      (random 100000 state))))
    108 
    +

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