1
0
mirror of synced 2026-05-02 14:31:05 +00:00
Files
Interlisp.medley/internal/test/LANGUAGE/AUTO/7-3-FUNCALL.TEST

78 lines
2.8 KiB
Plaintext

;; Function To Be Tested: funcall
;;
;; Source: Steele's book Section 7.3: Function Invocation Page: 108
;;
;; Created By: Karin M. Sye
;;
;; Creation Date: June 6,1986
;;
;; Last Update: June 6,1986
;;
;; Filed As: {eris}<lispcore>cml>test>7-3-funcall.test
;;
;;
;; Syntax: FUNCALL fn &rest arguments
;;
;; Function Description: FUNCALL applies the fn to the arguments and returns its value. Fn may not be
;; a special form or macro.
;;
;; Argument(s): fn -
;; {argument}*
;;
;; Returns: a value returned by fn
;;
(do-test test-funcall0
(setq fc (symbol-function `+))
(= (funcall fc 1 2) 3))
(do-test test-funcall2
(and (equal (funcall 'append '(+ 1 2 3) '(4 5 6)) '(+ 1 2 3 4 5 6))
(equal (funcall #'append `(,(+ 1 2 3)) '(4 5 6)) '(6 4 5 6))))
(do-test test-funcall3
(and (= (multiple-value-setq ( a b c d) (funcall 'values 1 2 3 4)) 1)
(= (funcall `+ a b c d) 10)
(equal (multiple-value-list (funcall (function values-list) (list #\p #\l #\m))) '(#\p #\l #\m))))
(do-test test-funcall4
(progn (set 'funlist '())
(push (function (lambda (x y) (+ x y))) funlist)
(push (function (lambda (x y) (* x y))) funlist)
(push (function (lambda (x y) (gcd x y))) funlist)
(defun fun (m n o p) (funcall (case n ((1) (car m))
((2) (cadr m))
((3) (caddr m))) o p))
(and (= (fun funlist 1 3 9) 3)
(= (fun funlist 2 100 100) 10000)
(= (fun funlist 3 100 (sqrt 4)) 102)
(= (fun funlist 2 (expt #3r10 2) (/ 8 2)) 36))))
(do-test test-funcall5
(and (funcall '> 10000.001 +10000.00009 9999.999 9998.999 -9998.9999)
(funcall #'(lambda (x1 x2 x3 x4 x5 x6) (and x1 x2 x3 x4 x5 x6)) 'e 8 30 t 'null 'nill)
(every #'(lambda (x) (funcall 'null x)) (list nil '() (intersection '(2 4) '(1 3)) (set-difference '(2 4) '(2 4))))
(funcall #'(lambda (x y z) (every #'(lambda (a b c) (eq c (+ a b))) x y z)) '(1 3 5) '(2 4 6) '(3 7 11))))
(do-test test-funcall6
;;
;; --It is illegal for the fn to be the name of a macro or special form --
;; (page 108 CLtL)
;;
;; (progn (defmacro mac1 () ''mac1)
;; (defmacro mac2 () '(list 1 2))
;; (not (or (nlsetq (funcall #'mac1 nil))
;; (nlsetq (funcall #'mac2 nil))
;; (nlsetq (funcall #'quote 'quote))
;; (nlsetq (funcall #'progn nil))
;;
;; setq is defined as a special-form in common lisp
;;
;; (nlsetq (funcall 'setq '(foo (1+ 10))))
;; (nlsetq (funcall 'no-such-fun1 nil))))))
t)
;;
;;
STOP