From 22bbf7ca22f11cc33d887d0162cf2ec6661c3a3e Mon Sep 17 00:00:00 2001 From: Phillip Lord Date: Mon, 23 Nov 2015 22:02:42 +0000 Subject: Rename all test files to reflect source layout. * CONTRIBUTE,Makefile.in,configure.ac: Update to reflect test directory moves. * test/file-organisation.org: New file. * test/automated/Makefile.in test/automated/data/decompress/foo.gz test/automated/data/epg/pubkey.asc test/automated/data/epg/seckey.asc test/automated/data/files-bug18141.el.gz test/automated/data/flymake/test.c test/automated/data/flymake/test.pl test/automated/data/package/archive-contents test/automated/data/package/key.pub test/automated/data/package/key.sec test/automated/data/package/multi-file-0.2.3.tar test/automated/data/package/multi-file-readme.txt test/automated/data/package/newer-versions/archive-contents test/automated/data/package/newer-versions/new-pkg-1.0.el test/automated/data/package/newer-versions/simple-single-1.4.el test/automated/data/package/package-test-server.py test/automated/data/package/signed/archive-contents test/automated/data/package/signed/archive-contents.sig test/automated/data/package/signed/signed-bad-1.0.el test/automated/data/package/signed/signed-bad-1.0.el.sig test/automated/data/package/signed/signed-good-1.0.el test/automated/data/package/signed/signed-good-1.0.el.sig test/automated/data/package/simple-depend-1.0.el test/automated/data/package/simple-single-1.3.el test/automated/data/package/simple-single-readme.txt test/automated/data/package/simple-two-depend-1.1.el test/automated/abbrev-tests.el test/automated/auto-revert-tests.el test/automated/calc-tests.el test/automated/icalendar-tests.el test/automated/character-fold-tests.el test/automated/comint-testsuite.el test/automated/descr-text-test.el test/automated/electric-tests.el test/automated/cl-generic-tests.el test/automated/cl-lib-tests.el test/automated/eieio-test-methodinvoke.el test/automated/eieio-test-persist.el test/automated/eieio-tests.el test/automated/ert-tests.el test/automated/ert-x-tests.el test/automated/generator-tests.el test/automated/let-alist.el test/automated/map-tests.el test/automated/advice-tests.el test/automated/package-test.el test/automated/pcase-tests.el test/automated/regexp-tests.el test/automated/seq-tests.el test/automated/subr-x-tests.el test/automated/tabulated-list-test.el test/automated/thunk-tests.el test/automated/timer-tests.el test/automated/epg-tests.el test/automated/eshell.el test/automated/faces-tests.el test/automated/file-notify-tests.el test/automated/auth-source-tests.el test/automated/gnus-tests.el test/automated/message-mode-tests.el test/automated/help-fns.el test/automated/imenu-test.el test/automated/info-xref.el test/automated/mule-util.el test/automated/isearch-tests.el test/automated/json-tests.el test/automated/bytecomp-tests.el test/automated/coding-tests.el test/automated/core-elisp-tests.el test/automated/decoder-tests.el test/automated/files.el test/automated/font-parse-tests.el test/automated/lexbind-tests.el test/automated/occur-tests.el test/automated/process-tests.el test/automated/syntax-tests.el test/automated/textprop-tests.el test/automated/undo-tests.el test/automated/man-tests.el test/automated/completion-tests.el test/automated/dbus-tests.el test/automated/newsticker-tests.el test/automated/sasl-scram-rfc-tests.el test/automated/tramp-tests.el test/automated/obarray-tests.el test/automated/compile-tests.el test/automated/elisp-mode-tests.el test/automated/f90.el test/automated/flymake-tests.el test/automated/python-tests.el test/automated/ruby-mode-tests.el test/automated/subword-tests.el test/automated/replace-tests.el test/automated/simple-test.el test/automated/sort-tests.el test/automated/subr-tests.el test/automated/reftex-tests.el test/automated/sgml-mode-tests.el test/automated/tildify-tests.el test/automated/thingatpt.el test/automated/url-future-tests.el test/automated/url-util-tests.el test/automated/add-log-tests.el test/automated/vc-bzr.el test/automated/vc-tests.el test/automated/xml-parse-tests.el test/BidiCharacterTest.txt test/biditest.el test/cedet/cedet-utests.el test/cedet/ede-tests.el test/cedet/semantic-ia-utest.el test/cedet/semantic-tests.el test/cedet/semantic-utest-c.el test/cedet/semantic-utest.el test/cedet/srecode-tests.el test/cedet/tests/test.c test/cedet/tests/test.el test/cedet/tests/test.make test/cedet/tests/testdoublens.cpp test/cedet/tests/testdoublens.hpp test/cedet/tests/testfriends.cpp test/cedet/tests/testjavacomp.java test/cedet/tests/testnsp.cpp test/cedet/tests/testpolymorph.cpp test/cedet/tests/testspp.c test/cedet/tests/testsppcomplete.c test/cedet/tests/testsppreplace.c test/cedet/tests/testsppreplaced.c test/cedet/tests/testsubclass.cpp test/cedet/tests/testsubclass.hh test/cedet/tests/testtypedefs.cpp test/cedet/tests/testvarnames.c test/etags/CTAGS.good test/etags/ETAGS.good_1 test/etags/ETAGS.good_2 test/etags/ETAGS.good_3 test/etags/ETAGS.good_4 test/etags/ETAGS.good_5 test/etags/ETAGS.good_6 test/etags/a-src/empty.zz test/etags/a-src/empty.zz.gz test/etags/ada-src/2ataspri.adb test/etags/ada-src/2ataspri.ads test/etags/ada-src/etags-test-for.ada test/etags/ada-src/waroquiers.ada test/etags/c-src/a/b/b.c test/etags/c-src/abbrev.c test/etags/c-src/c.c test/etags/c-src/dostorture.c test/etags/c-src/emacs/src/gmalloc.c test/etags/c-src/emacs/src/keyboard.c test/etags/c-src/emacs/src/lisp.h test/etags/c-src/emacs/src/regex.h test/etags/c-src/etags.c test/etags/c-src/exit.c test/etags/c-src/exit.strange_suffix test/etags/c-src/fail.c test/etags/c-src/getopt.h test/etags/c-src/h.h test/etags/c-src/machsyscalls.c test/etags/c-src/machsyscalls.h test/etags/c-src/sysdep.h test/etags/c-src/tab.c test/etags/c-src/torture.c test/etags/cp-src/MDiagArray2.h test/etags/cp-src/Range.h test/etags/cp-src/burton.cpp test/etags/cp-src/c.C test/etags/cp-src/clheir.cpp.gz test/etags/cp-src/clheir.hpp test/etags/cp-src/conway.cpp test/etags/cp-src/conway.hpp test/etags/cp-src/fail.C test/etags/cp-src/functions.cpp test/etags/cp-src/screen.cpp test/etags/cp-src/screen.hpp test/etags/cp-src/x.cc test/etags/el-src/TAGTEST.EL test/etags/el-src/emacs/lisp/progmodes/etags.el test/etags/erl-src/gs_dialog.erl test/etags/f-src/entry.for test/etags/f-src/entry.strange.gz test/etags/f-src/entry.strange_suffix test/etags/forth-src/test-forth.fth test/etags/html-src/algrthms.html test/etags/html-src/index.shtml test/etags/html-src/software.html test/etags/html-src/softwarelibero.html test/etags/lua-src/allegro.lua test/etags/objc-src/PackInsp.h test/etags/objc-src/PackInsp.m test/etags/objc-src/Subprocess.h test/etags/objc-src/Subprocess.m test/etags/objcpp-src/SimpleCalc.H test/etags/objcpp-src/SimpleCalc.M test/etags/pas-src/common.pas test/etags/perl-src/htlmify-cystic test/etags/perl-src/kai-test.pl test/etags/perl-src/yagrip.pl test/etags/php-src/lce_functions.php test/etags/php-src/ptest.php test/etags/php-src/sendmail.php test/etags/prol-src/natded.prolog test/etags/prol-src/ordsets.prolog test/etags/ps-src/rfc1245.ps test/etags/pyt-src/server.py test/etags/tex-src/gzip.texi test/etags/tex-src/nonewline.tex test/etags/tex-src/testenv.tex test/etags/tex-src/texinfo.tex test/etags/y-src/atest.y test/etags/y-src/cccp.c test/etags/y-src/cccp.y test/etags/y-src/parse.c test/etags/y-src/parse.y test/indent/css-mode.css test/indent/js-indent-init-dynamic.js test/indent/js-indent-init-t.js test/indent/js-jsx.js test/indent/js.js test/indent/latex-mode.tex test/indent/modula2.mod test/indent/nxml.xml test/indent/octave.m test/indent/pascal.pas test/indent/perl.perl test/indent/prolog.prolog test/indent/ps-mode.ps test/indent/ruby.rb test/indent/scheme.scm test/indent/scss-mode.scss test/indent/sgml-mode-attribute.html test/indent/shell.rc test/indent/shell.sh test/redisplay-testsuite.el test/rmailmm.el test/automated/buffer-tests.el test/automated/cmds-tests.el test/automated/data-tests.el test/automated/finalizer-tests.el test/automated/fns-tests.el test/automated/inotify-test.el test/automated/keymap-tests.el test/automated/print-tests.el test/automated/libxml-tests.el test/automated/zlib-tests.el: Files Moved. --- test/lisp/emacs-lisp/cl-lib-tests.el | 496 +++++++++++++++++++++++++++++++++++ 1 file changed, 496 insertions(+) create mode 100644 test/lisp/emacs-lisp/cl-lib-tests.el (limited to 'test/lisp/emacs-lisp/cl-lib-tests.el') diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el new file mode 100644 index 00000000000..e2429b7de37 --- /dev/null +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -0,0 +1,496 @@ +;;; cl-lib.el --- tests for emacs-lisp/cl-lib.el -*- lexical-binding:t -*- + +;; Copyright (C) 2013-2015 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation, either version 3 of the +;; License, or (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see `http://www.gnu.org/licenses/'. + +;;; Commentary: + +;; Extracted from ert-tests.el, back when ert used to reimplement some +;; cl functions. + +;;; Code: + +(require 'cl-lib) +(require 'ert) + +(ert-deftest cl-lib-test-remprop () + (let ((x (cl-gensym))) + (should (equal (symbol-plist x) '())) + ;; Remove nonexistent property on empty plist. + (cl-remprop x 'b) + (should (equal (symbol-plist x) '())) + (put x 'a 1) + (should (equal (symbol-plist x) '(a 1))) + ;; Remove nonexistent property on nonempty plist. + (cl-remprop x 'b) + (should (equal (symbol-plist x) '(a 1))) + (put x 'b 2) + (put x 'c 3) + (put x 'd 4) + (should (equal (symbol-plist x) '(a 1 b 2 c 3 d 4))) + ;; Remove property that is neither first nor last. + (cl-remprop x 'c) + (should (equal (symbol-plist x) '(a 1 b 2 d 4))) + ;; Remove last property from a plist of length >1. + (cl-remprop x 'd) + (should (equal (symbol-plist x) '(a 1 b 2))) + ;; Remove first property from a plist of length >1. + (cl-remprop x 'a) + (should (equal (symbol-plist x) '(b 2))) + ;; Remove property when there is only one. + (cl-remprop x 'b) + (should (equal (symbol-plist x) '())))) + +(ert-deftest cl-lib-test-remove-if-not () + (let ((list (list 'a 'b 'c 'd)) + (i 0)) + (let ((result (cl-remove-if-not (lambda (x) + (should (eql x (nth i list))) + (cl-incf i) + (member i '(2 3))) + list))) + (should (equal i 4)) + (should (equal result '(b c))) + (should (equal list '(a b c d))))) + (should (equal '() + (cl-remove-if-not (lambda (_x) (should nil)) '())))) + +(ert-deftest cl-lib-test-remove () + (let ((list (list 'a 'b 'c 'd)) + (key-index 0) + (test-index 0)) + (let ((result + (cl-remove 'foo list + :key (lambda (x) + (should (eql x (nth key-index list))) + (prog1 + (list key-index x) + (cl-incf key-index))) + :test + (lambda (a b) + (should (eql a 'foo)) + (should (equal b (list test-index + (nth test-index list)))) + (cl-incf test-index) + (member test-index '(2 3)))))) + (should (equal key-index 4)) + (should (equal test-index 4)) + (should (equal result '(a d))) + (should (equal list '(a b c d))))) + (let ((x (cons nil nil)) + (y (cons nil nil))) + (should (equal (cl-remove x (list x y)) + ;; or (list x), since we use `equal' -- the + ;; important thing is that only one element got + ;; removed, this proves that the default test is + ;; `eql', not `equal' + (list y))))) + + +(ert-deftest cl-lib-test-set-functions () + (let ((c1 (cons nil nil)) + (c2 (cons nil nil)) + (sym (make-symbol "a"))) + (let ((e '()) + (a (list 'a 'b sym nil "" "x" c1 c2)) + (b (list c1 'y 'b sym 'x))) + (should (equal (cl-set-difference e e) e)) + (should (equal (cl-set-difference a e) a)) + (should (equal (cl-set-difference e a) e)) + (should (equal (cl-set-difference a a) e)) + (should (equal (cl-set-difference b e) b)) + (should (equal (cl-set-difference e b) e)) + (should (equal (cl-set-difference b b) e)) + ;; Note: this test (and others) is sensitive to the order of the + ;; result, which is not documented. + (should (equal (cl-set-difference a b) (list 'a nil "" "x" c2))) + (should (equal (cl-set-difference b a) (list 'y 'x))) + + ;; We aren't testing whether this is really using `eq' rather than `eql'. + (should (equal (cl-set-difference e e :test 'eq) e)) + (should (equal (cl-set-difference a e :test 'eq) a)) + (should (equal (cl-set-difference e a :test 'eq) e)) + (should (equal (cl-set-difference a a :test 'eq) e)) + (should (equal (cl-set-difference b e :test 'eq) b)) + (should (equal (cl-set-difference e b :test 'eq) e)) + (should (equal (cl-set-difference b b :test 'eq) e)) + (should (equal (cl-set-difference a b :test 'eq) (list 'a nil "" "x" c2))) + (should (equal (cl-set-difference b a :test 'eq) (list 'y 'x))) + + (should (equal (cl-union e e) e)) + (should (equal (cl-union a e) a)) + (should (equal (cl-union e a) a)) + (should (equal (cl-union a a) a)) + (should (equal (cl-union b e) b)) + (should (equal (cl-union e b) b)) + (should (equal (cl-union b b) b)) + (should (equal (cl-union a b) (list 'x 'y 'a 'b sym nil "" "x" c1 c2))) + + (should (equal (cl-union b a) (list 'x 'y 'a 'b sym nil "" "x" c1 c2))) + + (should (equal (cl-intersection e e) e)) + (should (equal (cl-intersection a e) e)) + (should (equal (cl-intersection e a) e)) + (should (equal (cl-intersection a a) a)) + (should (equal (cl-intersection b e) e)) + (should (equal (cl-intersection e b) e)) + (should (equal (cl-intersection b b) b)) + (should (equal (cl-intersection a b) (list sym 'b c1))) + (should (equal (cl-intersection b a) (list sym 'b c1)))))) + +(ert-deftest cl-lib-test-gensym () + ;; Since the expansion of `should' calls `cl-gensym' and thus has a + ;; side-effect on `cl--gensym-counter', we have to make sure all + ;; macros in our test body are expanded before we rebind + ;; `cl--gensym-counter' and run the body. Otherwise, the test would + ;; fail if run interpreted. + (let ((body (byte-compile + '(lambda () + (should (equal (symbol-name (cl-gensym)) "G0")) + (should (equal (symbol-name (cl-gensym)) "G1")) + (should (equal (symbol-name (cl-gensym)) "G2")) + (should (equal (symbol-name (cl-gensym "foo")) "foo3")) + (should (equal (symbol-name (cl-gensym "bar")) "bar4")) + (should (equal cl--gensym-counter 5)))))) + (let ((cl--gensym-counter 0)) + (funcall body)))) + +(ert-deftest cl-lib-test-coerce-to-vector () + (let* ((a (vector)) + (b (vector 1 a 3)) + (c (list)) + (d (list b a))) + (should (eql (cl-coerce a 'vector) a)) + (should (eql (cl-coerce b 'vector) b)) + (should (equal (cl-coerce c 'vector) (vector))) + (should (equal (cl-coerce d 'vector) (vector b a))))) + +(ert-deftest cl-lib-test-string-position () + (should (eql (cl-position ?x "") nil)) + (should (eql (cl-position ?a "abc") 0)) + (should (eql (cl-position ?b "abc") 1)) + (should (eql (cl-position ?c "abc") 2)) + (should (eql (cl-position ?d "abc") nil)) + (should (eql (cl-position ?A "abc") nil))) + +(ert-deftest cl-lib-test-mismatch () + (should (eql (cl-mismatch "" "") nil)) + (should (eql (cl-mismatch "" "a") 0)) + (should (eql (cl-mismatch "a" "a") nil)) + (should (eql (cl-mismatch "ab" "a") 1)) + (should (eql (cl-mismatch "Aa" "aA") 0)) + (should (eql (cl-mismatch '(a b c) '(a b d)) 2))) + +(ert-deftest cl-lib-test-loop () + (should (eql (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6))) + +(ert-deftest cl-lib-keyword-names-versus-values () + (should (equal + (funcall (cl-function (lambda (&key a b) (list a b))) + :b :a :a 42) + '(42 :a)))) + +(cl-defstruct (mystruct + (:constructor cl-lib--con-1 (&aux (abc 1))) + (:constructor cl-lib--con-2 (&optional def) "Constructor docstring.")) + "General docstring." + (abc 5 :readonly t) (def nil)) +(ert-deftest cl-lib-struct-accessors () + (let ((x (make-mystruct :abc 1 :def 2))) + (should (eql (cl-struct-slot-value 'mystruct 'abc x) 1)) + (should (eql (cl-struct-slot-value 'mystruct 'def x) 2)) + (setf (cl-struct-slot-value 'mystruct 'def x) -1) + (should (eql (cl-struct-slot-value 'mystruct 'def x) -1)) + (should (eql (cl-struct-slot-offset 'mystruct 'abc) 1)) + (should-error (cl-struct-slot-offset 'mystruct 'marypoppins)) + (should (pcase (cl-struct-slot-info 'mystruct) + (`((cl-tag-slot) (abc 5 :readonly t) + (def . ,(or `nil `(nil)))) + t))))) +(ert-deftest cl-lib-struct-constructors () + (should (string-match "\\`Constructor docstring." + (documentation 'cl-lib--con-2 t))) + (should (mystruct-p (cl-lib--con-1))) + (should (mystruct-p (cl-lib--con-2)))) + +(ert-deftest cl-lib-arglist-performance () + ;; An `&aux' should not cause lambda's arglist to be turned into an &rest + ;; that's parsed by hand. + (should (equal () (help-function-arglist 'cl-lib--con-1))) + (should (pcase (help-function-arglist 'cl-lib--con-2) + (`(&optional ,_) t)))) + +(ert-deftest cl-the () + (should (eql (cl-the integer 42) 42)) + (should-error (cl-the integer "abc")) + (let ((side-effect 0)) + (should (= (cl-the integer (cl-incf side-effect)) 1)) + (should (= side-effect 1)))) + +(ert-deftest cl-lib-test-plusp () + (should-not (cl-plusp -1.0e+INF)) + (should-not (cl-plusp -1.5e2)) + (should-not (cl-plusp -3.14)) + (should-not (cl-plusp -1)) + (should-not (cl-plusp -0.0)) + (should-not (cl-plusp 0)) + (should-not (cl-plusp 0.0)) + (should-not (cl-plusp -0.0e+NaN)) + (should-not (cl-plusp 0.0e+NaN)) + (should (cl-plusp 1)) + (should (cl-plusp 3.14)) + (should (cl-plusp 1.5e2)) + (should (cl-plusp 1.0e+INF)) + (should-error (cl-plusp "42") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-minusp () + (should (cl-minusp -1.0e+INF)) + (should (cl-minusp -1.5e2)) + (should (cl-minusp -3.14)) + (should (cl-minusp -1)) + (should-not (cl-minusp -0.0)) + (should-not (cl-minusp 0)) + (should-not (cl-minusp 0.0)) + (should-not (cl-minusp -0.0e+NaN)) + (should-not (cl-minusp 0.0e+NaN)) + (should-not (cl-minusp 1)) + (should-not (cl-minusp 3.14)) + (should-not (cl-minusp 1.5e2)) + (should-not (cl-minusp 1.0e+INF)) + (should-error (cl-minusp "-42") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-oddp () + (should (cl-oddp -3)) + (should (cl-oddp 3)) + (should-not (cl-oddp -2)) + (should-not (cl-oddp 0)) + (should-not (cl-oddp 2)) + (should-error (cl-oddp 3.0e+NaN) :type 'wrong-type-argument) + (should-error (cl-oddp 3.0) :type 'wrong-type-argument) + (should-error (cl-oddp "3") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-evenp () + (should (cl-evenp -2)) + (should (cl-evenp 0)) + (should (cl-evenp 2)) + (should-not (cl-evenp -3)) + (should-not (cl-evenp 3)) + (should-error (cl-evenp 2.0e+NaN) :type 'wrong-type-argument) + (should-error (cl-evenp 2.0) :type 'wrong-type-argument) + (should-error (cl-evenp "2") :type 'wrong-type-argument)) + +(ert-deftest cl-digit-char-p () + (should (eql 3 (cl-digit-char-p ?3))) + (should (eql 10 (cl-digit-char-p ?a 11))) + (should (eql 10 (cl-digit-char-p ?A 11))) + (should-not (cl-digit-char-p ?a)) + (should (eql 32 (cl-digit-char-p ?w 36))) + (should-error (cl-digit-char-p ?a 37) :type 'args-out-of-range) + (should-error (cl-digit-char-p ?a 1) :type 'args-out-of-range)) + +(ert-deftest cl-lib-test-first () + (should (null (cl-first '()))) + (should (= 4 (cl-first '(4)))) + (should (= 4 (cl-first '(4 2)))) + (should-error (cl-first "42") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-second () + (should (null (cl-second '()))) + (should (null (cl-second '(4)))) + (should (= 2 (cl-second '(1 2)))) + (should (= 2 (cl-second '(1 2 3)))) + (should-error (cl-second "1 2 3") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-third () + (should (null (cl-third '()))) + (should (null (cl-third '(1 2)))) + (should (= 3 (cl-third '(1 2 3)))) + (should (= 3 (cl-third '(1 2 3 4)))) + (should-error (cl-third "123") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-fourth () + (should (null (cl-fourth '()))) + (should (null (cl-fourth '(1 2 3)))) + (should (= 4 (cl-fourth '(1 2 3 4)))) + (should (= 4 (cl-fourth '(1 2 3 4 5)))) + (should-error (cl-fourth "1234") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-fifth () + (should (null (cl-fifth '()))) + (should (null (cl-fifth '(1 2 3 4)))) + (should (= 5 (cl-fifth '(1 2 3 4 5)))) + (should (= 5 (cl-fifth '(1 2 3 4 5 6)))) + (should-error (cl-fifth "12345") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-fifth () + (should (null (cl-fifth '()))) + (should (null (cl-fifth '(1 2 3 4)))) + (should (= 5 (cl-fifth '(1 2 3 4 5)))) + (should (= 5 (cl-fifth '(1 2 3 4 5 6)))) + (should-error (cl-fifth "12345") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-sixth () + (should (null (cl-sixth '()))) + (should (null (cl-sixth '(1 2 3 4 5)))) + (should (= 6 (cl-sixth '(1 2 3 4 5 6)))) + (should (= 6 (cl-sixth '(1 2 3 4 5 6 7)))) + (should-error (cl-sixth "123456") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-seventh () + (should (null (cl-seventh '()))) + (should (null (cl-seventh '(1 2 3 4 5 6)))) + (should (= 7 (cl-seventh '(1 2 3 4 5 6 7)))) + (should (= 7 (cl-seventh '(1 2 3 4 5 6 7 8)))) + (should-error (cl-seventh "1234567") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-eighth () + (should (null (cl-eighth '()))) + (should (null (cl-eighth '(1 2 3 4 5 6 7)))) + (should (= 8 (cl-eighth '(1 2 3 4 5 6 7 8)))) + (should (= 8 (cl-eighth '(1 2 3 4 5 6 7 8 9)))) + (should-error (cl-eighth "12345678") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-ninth () + (should (null (cl-ninth '()))) + (should (null (cl-ninth '(1 2 3 4 5 6 7 8)))) + (should (= 9 (cl-ninth '(1 2 3 4 5 6 7 8 9)))) + (should (= 9 (cl-ninth '(1 2 3 4 5 6 7 8 9 10)))) + (should-error (cl-ninth "123456789") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-tenth () + (should (null (cl-tenth '()))) + (should (null (cl-tenth '(1 2 3 4 5 6 7 8 9)))) + (should (= 10 (cl-tenth '(1 2 3 4 5 6 7 8 9 10)))) + (should (= 10 (cl-tenth '(1 2 3 4 5 6 7 8 9 10 11)))) + (should-error (cl-tenth "1234567890") :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-endp () + (should (cl-endp '())) + (should-not (cl-endp '(1))) + (should-error (cl-endp 1) :type 'wrong-type-argument) + (should-error (cl-endp [1]) :type 'wrong-type-argument)) + +(ert-deftest cl-lib-test-nth-value () + (let ((vals (cl-values 2 3))) + (should (= (cl-nth-value 0 vals) 2)) + (should (= (cl-nth-value 1 vals) 3)) + (should (null (cl-nth-value 2 vals))) + (should-error (cl-nth-value 0.0 vals) :type 'wrong-type-argument))) + +(ert-deftest cl-lib-nth-value-test-multiple-values () + "While CL multiple values are an alias to list, these won't work." + :expected-result :failed + (should (eq (cl-nth-value 0 '(2 3)) '(2 3))) + (should (= (cl-nth-value 0 1) 1)) + (should (null (cl-nth-value 1 1))) + (should-error (cl-nth-value -1 (cl-values 2 3)) :type 'args-out-of-range) + (should (string= (cl-nth-value 0 "only lists") "only lists"))) + +(ert-deftest cl-test-caaar () + (should (null (cl-caaar '()))) + (should (null (cl-caaar '(() (2))))) + (should (null (cl-caaar '((() (2)) (a b))))) + (should-error (cl-caaar '(1 2)) :type 'wrong-type-argument) + (should-error (cl-caaar '((1 2))) :type 'wrong-type-argument) + (should (= 1 (cl-caaar '(((1 2) (3 4)))))) + (should (null (cl-caaar '((() (3 4))))))) + +(ert-deftest cl-test-caadr () + (should (null (cl-caadr '()))) + (should (null (cl-caadr '(1)))) + (should-error (cl-caadr '(1 2)) :type 'wrong-type-argument) + (should (= 2 (cl-caadr '(1 (2 3))))) + (should (equal '((2) (3)) (cl-caadr '((1) (((2) (3))) (4)))))) + +(ert-deftest cl-test-ldiff () + (let ((l '(1 2 3))) + (should (null (cl-ldiff '() '()))) + (should (null (cl-ldiff '() l))) + (should (null (cl-ldiff l l))) + (should (equal l (cl-ldiff l '()))) + ;; must be part of the list + (should (equal l (cl-ldiff l '(2 3)))) + (should (equal '(1) (cl-ldiff l (nthcdr 1 l)))) + ;; should return a copy + (should-not (eq (cl-ldiff l '()) l)))) + +(ert-deftest cl-lib-adjoin-test () + (let ((nums '(1 2)) + (myfn-p '=)) + ;; add non-existing item to the front + (should (equal '(3 1 2) (cl-adjoin 3 nums))) + ;; just add - don't copy rest + (should (eq nums (cdr (cl-adjoin 3 nums)))) + ;; add only when not already there + (should (eq nums (cl-adjoin 2 nums))) + (should (equal '(2 1 (2)) (cl-adjoin 2 '(1 (2))))) + ;; default test function is eql + (should (equal '(1.0 1 2) (cl-adjoin 1.0 nums))) + ;; own :test function - returns true if match + (should (equal '(1.0 1 2) (cl-adjoin 1.0 nums :test nil))) ;defaults to eql + (should (eq nums (cl-adjoin 2 nums :test myfn-p))) ;match + (should (equal '(3 1 2) (cl-adjoin 3 nums :test myfn-p))) ;no match + ;; own :test-not function - returns false if match + (should (equal '(1.0 1 2) (cl-adjoin 1.0 nums :test-not nil))) ;defaults to eql + (should (equal '(2 2) (cl-adjoin 2 '(2) :test-not myfn-p))) ; no match + (should (eq nums (cl-adjoin 2 nums :test-not myfn-p))) ; 1 matches + (should (eq nums (cl-adjoin 3 nums :test-not myfn-p))) ; 1 and 2 matches + + ;; according to CLtL2 passing both :test and :test-not should signal error + ;;(should-error (cl-adjoin 3 nums :test 'myfn-p :test-not myfn-p)) + + ;; own :key fn + (should (eq nums (cl-adjoin 3 nums :key (lambda (x) (if (cl-evenp x) (1+ x) x))))) + (should (equal '(3 1 2) (cl-adjoin 3 nums :key (lambda (x) (if (cl-evenp x) (+ 2 x) x))))) + + ;; convert using :key, then compare with :test + (should (eq nums (cl-adjoin 1 nums :key 'int-to-string :test 'string=))) + (should (equal '(3 1 2) (cl-adjoin 3 nums :key 'int-to-string :test 'string=))) + (should-error (cl-adjoin 3 nums :key 'int-to-string :test myfn-p) + :type 'wrong-type-argument) + + ;; convert using :key, then compare with :test-not + (should (eq nums (cl-adjoin 3 nums :key 'int-to-string :test-not 'string=))) + (should (equal '(1 1) (cl-adjoin 1 '(1) :key 'int-to-string :test-not 'string=))) + (should-error (cl-adjoin 1 nums :key 'int-to-string :test-not myfn-p) + :type 'wrong-type-argument))) + +(ert-deftest cl-parse-integer () + (should-error (cl-parse-integer "abc")) + (should (null (cl-parse-integer "abc" :junk-allowed t))) + (should (null (cl-parse-integer "" :junk-allowed t))) + (should (= 342391 (cl-parse-integer "0123456789" :radix 8 :junk-allowed t))) + (should-error (cl-parse-integer "0123456789" :radix 8)) + (should (= -239 (cl-parse-integer "-efz" :radix 16 :junk-allowed t))) + (should-error (cl-parse-integer "efz" :radix 16)) + (should (= 239 (cl-parse-integer "zzef" :radix 16 :start 2))) + (should (= -123 (cl-parse-integer " -123 ")))) + +(ert-deftest cl-loop-destructuring-with () + (should (equal (cl-loop with (a b c) = '(1 2 3) return (+ a b c)) 6))) + +(ert-deftest cl-flet-test () + (should (equal (cl-flet ((f1 (x) x)) (let ((x #'f1)) (funcall x 5))) 5))) + +(ert-deftest cl-lib-test-typep () + (cl-deftype cl-lib-test-type (&optional x) `(member ,x)) + ;; Make sure we correctly implement the rule that deftype's optional args + ;; default to `*' rather than to nil. + (should (cl-typep '* 'cl-lib-test-type)) + (should-not (cl-typep 1 'cl-lib-test-type))) + +;;; cl-lib.el ends here -- cgit v1.2.3