Mercurial > hg > xemacs-beta
comparison tests/automated/lisp-tests.el @ 4686:cdabd56ce1b5
Fix various small issues with the multiple-value implementation.
lisp/ChangeLog addition:
2009-08-31 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-form-code-walker):
Be careful about discarding multiple values when optimising
#'prog1 calls.
(byte-optimize-or):
Preserve any trailing nil, as this is a supported way to
explicitly discard multiple values.
(byte-optimize-cond-1):
Discard multiple values with a singleton followed by no more
clauses.
* bytecomp.el (progn):
(prog1):
(prog2):
Be careful about discarding multiple values in the byte-hunk
handler of these three forms.
* bytecomp.el (byte-compile-prog1, byte-compile-prog2):
Don't call #'values explicitly, use `(or ,(pop form) nil) instead,
since that compiles to bytecode, not a funcall.
* bytecomp.el (byte-compile-values):
With one non-const argument, byte-compile to `(or ,(second form)
nil), not an explicit #'values call.
* bytecomp.el (byte-compile-insert-header):
Be nicer in the error message to emacs versions that don't
understand our bytecode.
src/ChangeLog addition:
2009-08-31 Aidan Kehoe <kehoea@parhasard.net>
* eval.c (For, Fand):
Don't declare val as REGISTER in these functions, for some reason
it breaks the non-DEBUG union build. These functions are only
called from interpreted code, the performance implication doesn't
matter. Thank you Robert Delius Royar!
* eval.c (Fmultiple_value_list_internal):
Error on too many arguments.
tests/ChangeLog addition:
2009-08-31 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el (Assert-rounding):
Remove an overly-verbose failure message here.
Correct a couple of tests which were buggy in themselves. Add
three new tests, checking the behaviour of #'or and #'and when
passed zero arguments, and a Known-Bug-Expect-Failure call
involving letf and values. (The bug predates the C-level
multiple-value implementation.)
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sun, 06 Sep 2009 19:36:02 +0100 |
parents | 2c64d2bbb316 |
children | d0ea57eb3de4 |
comparison
equal
deleted
inserted
replaced
4685:945247a8112f | 4686:cdabd56ce1b5 |
---|---|
1473 (round first))) | 1473 (round first))) |
1474 (format "checking (round %S) gives %S" | 1474 (format "checking (round %S) gives %S" |
1475 first one-round-result)) | 1475 first one-round-result)) |
1476 (Assert (equal one-round-result (multiple-value-list | 1476 (Assert (equal one-round-result (multiple-value-list |
1477 (round first 1))) | 1477 (round first 1))) |
1478 (format "checking (round %S 1) gives %S, types %S, actual %S, types %S" | 1478 (format "checking (round %S 1) gives %S" |
1479 first one-round-result (mapcar #'type-of one-round-result) | 1479 first one-round-result)) |
1480 (multiple-value-list (round first 1)) | |
1481 (mapcar #'type-of (multiple-value-list (round first 1))))) | |
1482 | |
1483 (Check-Error arith-error (round first 0)) | 1480 (Check-Error arith-error (round first 0)) |
1484 (Check-Error arith-error (round first 0.0)) | 1481 (Check-Error arith-error (round first 0.0)) |
1485 (Assert (equal two-round-result (multiple-value-list | 1482 (Assert (equal two-round-result (multiple-value-list |
1486 (round first second))) | 1483 (round first second))) |
1487 (format "checking (round %S %S) gives %S" | 1484 (format "checking (round %S %S) gives %S" |
1947 (foo-zero (x y) | 1944 (foo-zero (x y) |
1948 (values (floor (+ x y) y))) | 1945 (values (floor (+ x y) y))) |
1949 (multiple-value-function-returning-t () | 1946 (multiple-value-function-returning-t () |
1950 (values t pi e degrees-to-radians radians-to-degrees)) | 1947 (values t pi e degrees-to-radians radians-to-degrees)) |
1951 (multiple-value-function-returning-nil () | 1948 (multiple-value-function-returning-nil () |
1952 (values t pi e radians-to-degrees degrees-to-radians)) | 1949 (values nil pi e radians-to-degrees degrees-to-radians)) |
1953 (function-throwing-multiple-values () | 1950 (function-throwing-multiple-values () |
1954 (let* ((listing '(0 3 4 nil "string" symbol)) | 1951 (let* ((listing '(0 3 4 nil "string" symbol)) |
1955 (tail listing) | 1952 (tail listing) |
1956 elt) | 1953 elt) |
1957 (while t | 1954 (while t |
2049 (Assert | 2046 (Assert |
2050 (= 1 (length (multiple-value-list | 2047 (= 1 (length (multiple-value-list |
2051 (cond ((multiple-value-function-returning-t)))))) | 2048 (cond ((multiple-value-function-returning-t)))))) |
2052 "Checking cond doesn't pass back multiple values in tests.") | 2049 "Checking cond doesn't pass back multiple values in tests.") |
2053 (Assert | 2050 (Assert |
2054 (equal (list t pi e degrees-to-radians radians-to-degrees) | 2051 (equal (list nil pi e radians-to-degrees degrees-to-radians) |
2055 (multiple-value-list | 2052 (multiple-value-list |
2056 (cond (t (multiple-value-function-returning-nil))))) | 2053 (cond (t (multiple-value-function-returning-nil))))) |
2057 "Checking cond passes back multiple values in clauses.") | 2054 "Checking cond passes back multiple values in clauses.") |
2058 (Assert | 2055 (Assert |
2059 (= 1 (length (multiple-value-list | 2056 (= 1 (length (multiple-value-list |
2067 (Assert | 2064 (Assert |
2068 (equal (list t pi e degrees-to-radians radians-to-degrees) | 2065 (equal (list t pi e degrees-to-radians radians-to-degrees) |
2069 (multiple-value-list | 2066 (multiple-value-list |
2070 (catch 'VoN61Lo4Y (function-throwing-multiple-values))))) | 2067 (catch 'VoN61Lo4Y (function-throwing-multiple-values))))) |
2071 (Assert | 2068 (Assert |
2072 (equal (list t pi e radians-to-degrees degrees-to-radians) | 2069 (equal (list t pi e degrees-to-radians radians-to-degrees) |
2073 (multiple-value-list | 2070 (multiple-value-list |
2074 (loop | 2071 (loop |
2075 for eye in `(a b c d ,e f g ,nil ,pi) | 2072 for eye in `(a b c d ,e f g ,nil ,pi) |
2076 do (when (null eye) | 2073 do (when (null eye) |
2077 (return (multiple-value-function-returning-t)))))) | 2074 (return (multiple-value-function-returning-t)))))) |
2078 "Checking #'loop passes back multiple values correctly.")) | 2075 "Checking #'loop passes back multiple values correctly.") |
2076 (Assert | |
2077 (null (or)) | |
2078 "Checking #'or behaves correctly with zero arguments.") | |
2079 (Assert | |
2080 (eq t (and)) | |
2081 "Checking #'and behaves correctly with zero arguments.") | |
2082 ;; This bug was here before the full multiple-value functionality | |
2083 ;; was introduced (check it with (floor* pi) if you're | |
2084 ;; curious). #'setf works, though, which is what most people are | |
2085 ;; interested in. If you know the setf-method code better than I do, | |
2086 ;; please post a patch; otherwise this is going to the back of the | |
2087 ;; queue of things to do. I didn't break it :-) Aidan Kehoe, Mon Aug | |
2088 ;; 31 10:45:50 GMTDT 2009. | |
2089 (Known-Bug-Expect-Error | |
2090 void-variable | |
2091 (letf (((values three one-four-one-five-nine) (floor pi))) | |
2092 (* three one-four-one-five-nine)))) | |
2093 |