Mercurial > hg > xemacs-beta

comparison tests/automated/lisp-tests.el @ 5737:165315eae1ab

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Make #'apply-partially more intelligent still when byte-compiled. lisp/ChangeLog addition: 2013-06-17 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el: * cl-macs.el (apply-partially): Be more intelligent about constructing (or not) compiled functions at runtime or compile time when making these closures. tests/ChangeLog addition: 2013-06-17 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test #'apply-partially more extensively, given changes in cl-macs.el.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 17 Jun 2013 19:54:02 +0100
parents 3192994c49ca
children ffc0c5a66ab1
comparison
equal deleted inserted replaced
5736:3192994c49ca 5737:165315eae1ab
2948 ;; Basic tests of #'apply-partially. 2948 ;; Basic tests of #'apply-partially.
2949 (let* ((four 4) 2949 (let* ((four 4)
2950 (times-four (apply-partially '* four)) 2950 (times-four (apply-partially '* four))
2951 (plus-twelve (apply-partially '+ 6 (* 3 2))) 2951 (plus-twelve (apply-partially '+ 6 (* 3 2)))
2952 (construct-list (apply-partially 'list (incf four) (incf four) 2952 (construct-list (apply-partially 'list (incf four) (incf four)
2953 (incf four)))) 2953 (incf four)))
2954 (list-and-multiply
2955 (apply-partially #'(lambda (a b c d &optional e)
2956 (cons (apply #'+ a b c d (if e (list e)))
2957 (list* a b c d e)))
2958 ;; Constant arguments -> function can be
2959 ;; constructed at compile time
2960 1 2 3))
2961 (list-and-four
2962 (apply-partially #'(lambda (a b c d &optional e)
2963 (cons (apply #'+ a b c d (if e (list e)))
2964 (list* a b c d e)))
2965 ;; Not constant arguments -> function constructed
2966 ;; at runtime.
2967 1 2 four)))
2954 (Assert (eql (funcall times-four 6) 24)) 2968 (Assert (eql (funcall times-four 6) 24))
2955 (Assert (eql (funcall times-four 4 4) 64)) 2969 (Assert (eql (funcall times-four 4 4) 64))
2956 (Assert (eql (funcall plus-twelve (funcall times-four 4) 4 4) 36)) 2970 (Assert (eql (funcall plus-twelve (funcall times-four 4) 4 4) 36))
2957 (Check-Error wrong-number-of-arguments (apply-partially)) 2971 (Check-Error wrong-number-of-arguments (apply-partially))
2958 (Assert (equal (funcall construct-list) '(5 6 7)))) 2972 (Assert (equal (funcall construct-list) '(5 6 7)))
2973 (Assert (equal (funcall list-and-multiply 5 6) '(17 1 2 3 5 . 6)))
2974 (Assert (equal (funcall list-and-multiply 7) '(13 1 2 3 7)))
2975 (Check-Error wrong-number-of-arguments
2976 (funcall list-and-multiply 7 8 9 10))
2977 (Assert (equal (funcall list-and-four 5 6) '(21 1 2 7 5 . 6)))
2978 (Assert (equal (funcall list-and-four 7) '(17 1 2 7 7)))
2979 (Check-Error wrong-number-of-arguments
2980 (funcall list-and-four 7 8 9 10)))
2959 2981
2960 ;; Test labels and inlining. 2982 ;; Test labels and inlining.
2961 (labels 2983 (labels
2962 ((+ (&rest arguments) 2984 ((+ (&rest arguments)
2963 ;; Shades of Java, hah. 2985 ;; Shades of Java, hah.