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