1
0
mirror of synced 2026-05-01 14:06:47 +00:00
Files
Interlisp.medley/internal/test/LANGUAGE/AUTO/7-5-LETSTAR.TEST

114 lines
3.3 KiB
Plaintext

;; Function To Be Tested: let*
;;
;; Source: CLtL Section 7.5: Establishing New Variable Bindings Page: 110
;;
;; Created By: Karin M. Sye
;;
;; Creation Date: Oct. 10 ,1986
;;
;; Last Update: Oct. 10 ,1986
;;
;; Filed As: {eris}<lispcore>cml>test>7-5-let*.test
;;
;;
;; Syntax: let* ( {VAR | (VAR VALUE)}*) {DECLARATION}* {FORM}*
;;
;; Function Description: A let* form can be used to execute a series of forms with specified variables bound to specified values.
;; All of the variables VARs are bound to the corresponding values sequentially ; each binding will be a
;; lexical binding unless there is a special declaration to the contrary. The expressions FORMs are then
;; evaluated in order; the values of all but the last are discarded.
;;
;; Argument(s): VAR - a variable
;; VALUE - a valid lisp form
;; DECLARATION -
;; FORM -
;;
;; Returns: anythihng
;;
(do-test-group (test-let*-group
:before (progn (test-setq a 2 b 20 c 4 d -12 e 30 buf '())))
(do-test "test let* 0"
(and
(eq (let* ()) nil)
(= (let* () 100) 100)
(eq (let* (a b c d)) nil)
(= (let* (a b c d) (imagpart #c(1 2))) 2)
(equal (multiple-value-list (let* () (values 1 2 3 4))) '(1 2 3 4))
)
)
(do-test "test let* - variables are bound sequentially"
(and
(equal (let* ( (a 10) (b (1+ a)) (c (- b 2)))
(list a b c))
'(10 11 9))
(equal (let* ( (e (+ a b)) (d (+ e a)) (c (- e d)) (b (+ e d c)))
(list e d c b))
'(22 24 -2 44))
)
)
(do-test "test let* - the expressions (forms) are evaluated in order ; the value(s) of the last form are returned"
(and
(equal (let* ()
(push a buf) (push b buf) (push c buf) (push d buf)) '( -12 4 20 2))
(equal buf '(-12 4 20 2))
(equal (let* ((a 20) (b 30))
(setq a (* 3 a))
(setq b (* -2 b))
(decf a)
(incf b)
(list b a)) '(-59 59))
(equal (let* (x)
(setq x (concatenate 'string "abcdefg"))
(setq x (concatenate 'string x '(#\q #\w #\e #\r #\t)))
(setq x (concatenate 'string x "zxcvbn"))
x) "abcdefgqwertzxcvbn")
)
)
(do-test "test let* - include declaration statement(s)"
(and
(equal (let* ((x 0) (y 0) (u "") (w "a"))
(declare (fixnum x y) (simple-string u w))
(setq x (1+ x))
(setq y (lcm (+ 2 y) (+ 11 y)))
(setq u (concatenate 'string u w "za"))
(setq w (concatenate 'string w u w))
(list w u y x))
'("aazaa" "aza" 22 1))
(equalp (let* ((a #*1010111000) (b (vector #\t #\e #\s #\t #\s)) (c nil) (d 20))
(declare (number d) (list c) (sequence b) (simple-bit-vector a))
(setq a (subseq a 4))
(setq b (concatenate 'string (subseq b 1 4)))
(setq c (cons "a" (cons "b" (cons "c" c))))
;; (setq d (+ #c(1 2) #c( -2 -1) ))
(list a b c ))
'( #*111000 "est" ("a" "b" "c")))
)
)
(do-test "test let* - the body of a let* form is an implicit progn; it returns multiple values"
(and
(equal (multiple-value-list (let* ((a 1) (b 2) (c 3) (d 4) e f)
(values a b c d e f))) '(1 2 3 4 nil nil))
(equal (multiple-value-list (let* (a b c d e f)
(multiple-value-bind (a c e) (values 11 22 33) (values f e d c b a))))
'(nil 33 nil 22 nil 11))
)
)
)
STOP