pax_global_header00006660000000000000000000000064147127350670014526gustar00rootroot0000000000000052 comment=bbea0e7cc7ab7d96e7f062014bde438aa8ffcd43 rolandwalker-list-utils-cd0ec9b/000077500000000000000000000000001471273506700170755ustar00rootroot00000000000000rolandwalker-list-utils-cd0ec9b/.gitignore000066400000000000000000000000521471273506700210620ustar00rootroot00000000000000/ert-tests/ert.el *-autoloads.el *.elc *~ rolandwalker-list-utils-cd0ec9b/.travis.yml000066400000000000000000000112401471273506700212040ustar00rootroot00000000000000### ### Notes ### ### The travis web interface may choke silently and fail to ### update when there are issues with the .travis.yml file. ### ### The "travis-lint" command-line tool does not catch all ### errors which may lead to silent failure. ### ### Shell-style comments must have "#" as the first character ### of the line. ### ### ### language ### # travis-lint no longer permits this value # language: emacs-lisp language: ruby ### ### defining the build matrix ### ### ===> <=== ### ===> each variation in env/matrix will be built and tested <=== ### ===> <=== ### ### variables under env/global are available to the build process ### but don't cause the creation of a separate variation ### env: matrix: # - EMACS=xemacs21 - EMACS=emacs22 - EMACS=emacs23 - EMACS=emacs24 - EMACS=emacs-snapshot global: - SOME_TOKEN=some_value ### ### allowing failures ### matrix: allow_failures: # - env: EMACS=xemacs21 - env: EMACS=emacs22 - env: EMACS=emacs-snapshot ### ### limit build attempts to defined branches ### # branches: # only: # - master ### ### runtime initialization ### ### notes ### ### emacs22 is extracted manually from Ubuntu Maverick. ### ### emacs23 is the stock default, but is updated anyway to ### a GUI-capable version, which will have certain additional ### functions compiled in. ### ### emacs24 (current stable release) is obtained from the ### cassou PPA: http://launchpad.net/~cassou/+archive/emacs ### ### emacs-snapshot (trunk) is obtained from the Ubuntu Emacs Lisp PPA: ### https://launchpad.net/~ubuntu-elisp/+archive/ppa ### For the emacs-snapshot build, bleeding-edge versions ### of all test dependencies are also used. ### before_install: - git submodule --quiet update --init --recursive install: #- if [ "$EMACS" = 'xemacs21' ]; then # sudo apt-get -qq update && # sudo apt-get -qq -f install && # sudo apt-get -qq install xemacs21-basesupport xemacs21-basesupport-el xemacs21-supportel xemacs21-support xemacs21-mulesupport-el xemacs21-mulesupport xemacs21-mule-canna-wnn xemacs21-mule-canna-wnn; # fi - if [ "$EMACS" = 'emacs22' ]; then curl -Os http://security.ubuntu.com/ubuntu/pool/universe/e/emacs22/emacs22_22.2-0ubuntu9_i386.deb && curl -Os http://security.ubuntu.com/ubuntu/pool/universe/e/emacs22/emacs22-bin-common_22.2-0ubuntu9_i386.deb && curl -Os http://security.ubuntu.com/ubuntu/pool/universe/e/emacs22/emacs22-common_22.2-0ubuntu9_all.deb && curl -Os http://security.ubuntu.com/ubuntu/pool/universe/e/emacs22/emacs22-el_22.2-0ubuntu9_all.deb && curl -Os http://security.ubuntu.com/ubuntu/pool/universe/e/emacs22/emacs22-gtk_22.2-0ubuntu9_i386.deb && sudo apt-get -qq update && sudo apt-get -qq remove emacs emacs23-bin-common emacs23-common emacs23-nox && sudo apt-get -qq --fix-missing install install-info emacsen-common libjpeg62:i386 xaw3dg:i386 liblockfile1:i386 libasound2:i386 libgif4:i386 libncurses5:i386 libpng12-0:i386 libtiff4:i386 libxpm4:i386 libxft2:i386 libglib2.0-0:i386 libgtk2.0-0:i386 && sudo apt-get -qq -f install && sudo dpkg -i emacs22-common_22.2-0ubuntu9_all.deb emacs22-el_22.2-0ubuntu9_all.deb && sudo dpkg -i --force-depends emacs22-bin-common_22.2-0ubuntu9_i386.deb && sudo dpkg -i emacs22_22.2-0ubuntu9_i386.deb emacs22-gtk_22.2-0ubuntu9_i386.deb && sudo update-alternatives --set emacs22 /usr/bin/emacs22-gtk; fi - if [ "$EMACS" = 'emacs23' ]; then sudo apt-get -qq update && sudo apt-get -qq -f install && sudo apt-get -qq install emacs23-gtk emacs23-el; fi - if [ "$EMACS" = 'emacs24' ]; then sudo add-apt-repository -y ppa:cassou/emacs && sudo apt-get -qq update && sudo apt-get -qq -f install && sudo apt-get -qq install emacs24 emacs24-el; fi - if [ "$EMACS" = 'emacs-snapshot' ]; then sudo add-apt-repository -y ppa:ubuntu-elisp/ppa && sudo apt-get -qq update && sudo apt-get -qq -f install && sudo apt-get -qq install emacs-snapshot && sudo apt-get -qq install emacs-snapshot-el; fi before_script: - if [ "$EMACS" = 'emacs-snapshot' ]; then make downloads-latest; else make downloads; fi ### ### the actual build/test command ### script: $EMACS --version && ( test "$EMACS" != "emacs22" && make test EMACS="$EMACS" || make test-batch EMACS="$EMACS" ) ### ### settings ### notifications: email: false # # Emacs # # Local Variables: # indent-tabs-mode: nil # mangle-whitespace: t # require-final-newline: t # coding: utf-8 # End: # rolandwalker-list-utils-cd0ec9b/Makefile000066400000000000000000000164201471273506700205400ustar00rootroot00000000000000EMACS=emacs # EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs # EMACS=/Applications/Aquamacs.app/Contents/MacOS/Aquamacs # EMACS=/Applications/Macmacs.app/Contents/MacOS/Emacs # EMACS=/usr/local/bin/emacs # EMACS=/opt/local/bin/emacs # EMACS=/usr/bin/emacs INTERACTIVE_EMACS=/usr/local/bin/emacs # can't find an OS X variant that works correctly for interactive tests: # INTERACTIVE_EMACS=open -a Emacs.app --new --args # INTERACTIVE_EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs # INTERACTIVE_EMACS=/Applications/Emacs.app/Contents/MacOS/bin/emacs EMACS_CLEAN=-Q EMACS_BATCH=$(EMACS_CLEAN) --batch # TESTS can be overridden to specify a subset of tests TESTS= WIKI_USERNAME=roland.walker CURL=curl --location --silent EDITOR=runemacs -no_wait WORK_DIR=$(shell pwd) PACKAGE_NAME=$(shell basename $(WORK_DIR)) PACKAGE_VERSION=$(shell perl -ne 'print "$$1\n" if m{^;+ *Version: *(\S+)}' $(PACKAGE_NAME).el) AUTOLOADS_FILE=$(PACKAGE_NAME)-autoloads.el TEST_DIR=ert-tests TEST_DEP_1=ert TEST_DEP_1_STABLE_URL=http://git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert.el?h=emacs-24.3 TEST_DEP_1_LATEST_URL=http://git.savannah.gnu.org/cgit/emacs.git/plain/lisp/emacs-lisp/ert.el?h=master .PHONY : build dist not-dirty pkg-version downloads downloads-latest autoloads \ test-autoloads test test-prep test-batch test-interactive \ test-tests clean edit run-pristine run-pristine-local upload-github \ upload-wiki upload-marmalade test-dep-1 test-dep-2 test-dep-3 test-dep-4 \ test-dep-5 test-dep-6 test-dep-7 test-dep-8 test-dep-9 build : $(EMACS) $(EMACS_BATCH) --eval \ "(progn \ (batch-byte-compile))" *.el not-dirty : @git diff --quiet '$(PACKAGE_NAME).el' || \ ( git --no-pager diff '$(PACKAGE_NAME).el'; \ echo "Uncommitted edits - do a git stash"; \ false ) pkg-version : @test -n '$(PACKAGE_VERSION)' || \ ( echo "No package version"; false ) test-dep-1 : @cd '$(TEST_DIR)' && \ $(EMACS) $(EMACS_BATCH) -L . -L .. -l '$(TEST_DEP_1)' || \ (echo "Can't load test dependency $(TEST_DEP_1).el, run 'make downloads' to fetch it" ; exit 1) downloads : $(CURL) '$(TEST_DEP_1_STABLE_URL)' > '$(TEST_DIR)/$(TEST_DEP_1).el' downloads-latest : $(CURL) '$(TEST_DEP_1_LATEST_URL)' > '$(TEST_DIR)/$(TEST_DEP_1).el' autoloads : $(EMACS) $(EMACS_BATCH) --eval \ "(progn \ (setq generated-autoload-file \"$(WORK_DIR)/$(AUTOLOADS_FILE)\") \ (update-directory-autoloads \"$(WORK_DIR)\"))" test-autoloads : autoloads @$(EMACS) $(EMACS_BATCH) -L . -l './$(AUTOLOADS_FILE)' || \ ( echo "failed to load autoloads: $(AUTOLOADS_FILE)" && false ) test-tests : @perl -ne 'if (m/^\s*\(\s*ert-deftest\s*(\S+)/) {die "$$1 test name duplicated in $$ARGV\n" if $$dupes{$$1}++}' '$(TEST_DIR)/'*-test.el test-prep : build test-dep-1 test-autoloads test-tests test-batch : @cd '$(TEST_DIR)' && \ (for test_lib in *-test.el; do \ $(EMACS) $(EMACS_BATCH) -L . -L .. -l cl-macs \ -l '$(TEST_DEP_1)' -l "$$test_lib" --eval \ "(progn \ (fset 'ert--print-backtrace 'ignore) \ (ert-run-tests-batch-and-exit '(and \"$(TESTS)\" (not (tag :interactive)))))" || exit 1; \ done) test-interactive : test-prep @cd '$(TEST_DIR)' && \ (for test_lib in *-test.el; do \ $(INTERACTIVE_EMACS) $(EMACS_CLEAN) --eval \ "(progn \ (cd \"$(WORK_DIR)/$(TEST_DIR)\") \ (setq dired-use-ls-dired nil) \ (setq frame-title-format \"TEST SESSION $$test_lib\") \ (setq enable-local-variables :safe))" \ -L . -L .. -l cl-macs -l '$(TEST_DEP_1)' -l "$$test_lib" \ --visit "$$test_lib" --eval \ "(progn \ (when (> (length \"$(TESTS)\") 0) \ (push \"\\\"$(TESTS)\\\"\" ert--selector-history)) \ (setq buffer-read-only t) \ (setq cursor-in-echo-area t) \ (call-interactively 'ert-run-tests-interactively) \ (ding) \ (when (y-or-n-p \"PRESS Y TO QUIT THIS TEST SESSION\") \ (with-current-buffer \"*ert*\" \ (kill-emacs \ (if (re-search-forward \"^Failed:[^\\n]+unexpected\" 500 t) 1 0)))))" || exit 1; \ done) test : test-prep test-batch run-pristine : @cd '$(TEST_DIR)' && \ $(EMACS) $(EMACS_CLEAN) --eval \ "(progn \ (setq package-enable-at-startup nil) \ (setq package-load-list nil) \ (when (fboundp 'package-initialize) \ (package-initialize)) \ (cd \"$(WORK_DIR)/$(TEST_DIR)\") \ (setq dired-use-ls-dired nil) \ (setq frame-title-format \"PRISTINE SESSION $(PACKAGE_NAME)\") \ (setq enable-local-variables :safe))" \ -L .. -l '$(PACKAGE_NAME)' . run-pristine-local : @cd '$(TEST_DIR)' && \ $(EMACS) $(EMACS_CLEAN) --eval \ "(progn \ (cd \"$(WORK_DIR)/$(TEST_DIR)\") \ (setq dired-use-ls-dired nil) \ (setq frame-title-format \"PRISTINE-LOCAL SESSION $(PACKAGE_NAME)\") \ (setq enable-local-variables :safe))" \ -L . -L .. -l '$(PACKAGE_NAME)' . clean : @rm -f '$(AUTOLOADS_FILE)' *.elc *~ */*.elc */*~ .DS_Store */.DS_Store *.bak */*.bak && \ cd '$(TEST_DIR)' && \ rm -f './$(TEST_DEP_1).el' './$(TEST_DEP_2).el' './$(TEST_DEP_3).el' './$(TEST_DEP_4).el' './$(TEST_DEP_5a).el' \ './$(TEST_DEP_5).el' './$(TEST_DEP_6).el' './$(TEST_DEP_7).el' './$(TEST_DEP_8).el' './$(TEST_DEP_9).el' edit : @$(EDITOR) `git ls-files` upload-github : @git push origin master upload-wiki : not-dirty @$(EMACS) $(EMACS_BATCH) --eval \ "(progn \ (setq package-load-list '((yaoddmuse t))) \ (when (fboundp 'package-initialize) \ (package-initialize)) \ (require 'yaoddmuse) \ (setq yaoddmuse-username \"$(WIKI_USERNAME)\") \ (yaoddmuse-post-file \ \"$(PACKAGE_NAME).el\" \ yaoddmuse-default-wiki \ \"$(PACKAGE_NAME).el\" \ \"updated version\") \ (sleep-for 5))" rolandwalker-list-utils-cd0ec9b/README.md000066400000000000000000000046421471273506700203620ustar00rootroot00000000000000[![Build Status](https://secure.travis-ci.org/rolandwalker/list-utils.png?branch=master)](http://travis-ci.org/rolandwalker/list-utils) # Overview List-manipulation utility functions for Emacs. * [Quickstart](#quickstart) * [Explanation](#explanation) * [Notes](#notes) * [Compatibility and Requirements](#compatibility-and-requirements) ## Quickstart ```elisp (require 'list-utils) (list-utils-flatten '(1 2 (3 4 (5 6 7)))) ;; '(1 2 3 4 5 6 7) (list-utils-depth '(1 2 (3 4 (5 6 7)))) ;; 3 (let ((cyclic-list '(1 2 3 4 5 6 7))) (nconc cyclic-list (cdr cyclic-list)) (list-utils-make-linear-inplace cyclic-list)) ;; '(1 2 3 4 5 6 7) (list-utils-cyclic-p '(1 2 3)) ;; nil (list-utils-plist-del '(:one 1 :two 2 :three 3) :two) ;; '(:one 1 :three 3) ``` ## Explanation List-utils is a collection of functions for list manipulation. This library has no user-level interface; it is only useful for programming in Emacs Lisp. Notable functionality includes * `list-utils-flatten`, a robust list-flattener which handles cyclic lists, non-nil-terminated lists, and preserves nils when they are found as list elements. * `tconc`, a simple data structure for efficiently appending to a list The following functions are provided: make-tconc tconc-p tconc-list tconc list-utils-cons-cell-p list-utils-cyclic-length list-utils-improper-p list-utils-make-proper-copy list-utils-make-proper-inplace list-utils-make-improper-copy list-utils-make-improper-inplace list-utils-linear-p list-utils-linear-subseq list-utils-cyclic-p list-utils-cyclic-subseq list-utils-make-linear-copy list-utils-make-linear-inplace list-utils-safe-length list-utils-safe-equal list-utils-depth list-utils-flat-length list-utils-flatten list-utils-alist-or-flat-length list-utils-alist-flatten list-utils-insert-before list-utils-insert-after list-utils-insert-before-pos list-utils-insert-after-pos list-utils-and list-utils-not list-utils-xor list-utils-uniq list-utils-dupes list-utils-singlets list-utils-partition-dupes list-utils-plist-reverse list-utils-plist-del To use list-utils, place the `list-utils.el` library somewhere Emacs can find it, and add the following to your `~/.emacs` file: ```elisp (require 'list-utils) ``` ## Notes This library includes an implementation of the classic Lisp `tconc` which is outside the `list-utils-` namespace. ## Compatibility and Requirements No external dependencies rolandwalker-list-utils-cd0ec9b/ert-tests/000077500000000000000000000000001471273506700210275ustar00rootroot00000000000000rolandwalker-list-utils-cd0ec9b/ert-tests/list-utils-test.el000066400000000000000000002410041471273506700244400ustar00rootroot00000000000000(require 'list-utils) (require 'cl-seq) (require 'cl-macs) ;;; utility functions for testing (defun list-utils-test-soft-string-lessp (x y) (string-lessp (if x (format "%s" x) "") (if y (format "%s" y) ""))) ;;; make-tconc (ert-deftest make-tconc-01 nil (should (equal #s(tconc nil nil) (make-tconc)))) (ert-deftest make-tconc-02 nil (should (equal #s(tconc (1 2 3) (3)) (let ((lst '(1 2 3))) (make-tconc :head lst :tail (last lst)))))) ;;; tconc-list (ert-deftest tconc-list-01 nil (should (equal '(1 2 3 4 5) (let ((tc (make-tconc))) (tconc-list tc '(1 2 3)) (tconc-list tc '(4 5)))))) (ert-deftest tconc-list-02 nil (should (equal #s(tconc (1 2 3 4 5) (5)) (let ((tc (make-tconc))) (tconc-list tc '(1 2 3)) (tconc-list tc '(4 5)) tc)))) ;;; tconc (ert-deftest tconc-01 nil (should (equal '(1 2 3 4 5) (let ((tc (make-tconc))) (tconc tc 1 2 3) (tconc tc 4 5))))) (ert-deftest tconc-02 nil (should (equal #s(tconc (1 2 3 4 5) (5)) (let ((tc (make-tconc))) (tconc tc 1 2 3) (tconc tc 4 5) tc)))) ;;; list-utils-cons-cell-p (ert-deftest list-utils-cons-cell-p-01 nil (should-not (list-utils-cons-cell-p '(a b c d e f)))) (ert-deftest list-utils-cons-cell-p-02 nil (should-not (list-utils-cons-cell-p nil))) (ert-deftest list-utils-cons-cell-p-03 nil (should-not (list-utils-cons-cell-p 1))) (ert-deftest list-utils-cons-cell-p-04 nil (should (= 2 (list-utils-cons-cell-p '(1 . 2))))) (ert-deftest list-utils-cons-cell-p-05 nil (should (= 6 (list-utils-cons-cell-p '(1 2 3 4 5 . 6))))) ;;; list-utils-make-proper-copy (ert-deftest list-utils-make-proper-copy-01 nil "Already proper" (let* ((proper '(a b c d e f)) (copy (copy-tree proper))) (should (equal proper copy)) (should (equal proper (list-utils-make-proper-copy copy))) (should (equal proper copy)))) (ert-deftest list-utils-make-proper-copy-02 nil "nil" (should-not (list-utils-make-proper-copy nil))) (ert-deftest list-utils-make-proper-copy-03 nil "Non-list" (let ((debug-on-error nil)) (should-error (list-utils-make-proper-copy 1)))) (ert-deftest list-utils-make-proper-copy-04 nil "Two elt cons" (let* ((proper '(1 2)) (improper (apply 'cl-list* proper)) (backup (copy-tree improper))) (should-not (equal proper improper)) (should (equal proper (list-utils-make-proper-copy improper))) (should ;; was not changed inplace (equal backup improper)))) (ert-deftest list-utils-make-proper-copy-05 nil "Multi-elt improper list" (let* ((proper '(a b c d e f)) (improper (apply 'cl-list* proper)) (backup (copy-tree improper))) (should-not (equal proper improper)) (should (equal proper (list-utils-make-proper-copy improper))) (should ;; was not changed inplace (equal backup improper)))) (ert-deftest list-utils-make-proper-copy-06 nil "Single-elt list" (let* ((proper '(1)) (copy (copy-tree proper))) (should (equal proper copy)) (should (equal proper (list-utils-make-proper-copy copy))) (should (equal proper copy)))) (ert-deftest list-utils-make-proper-copy-07 nil "With 'tree. Already proper" (let* ((proper '(a b c d e f)) (copy (copy-tree proper))) (should (equal proper copy)) (should (equal proper (list-utils-make-proper-copy copy 'tree))) (should (equal proper copy)))) (ert-deftest list-utils-make-proper-copy-08 nil "With 'tree. nil" (should-not (list-utils-make-proper-copy nil 'tree))) (ert-deftest list-utils-make-proper-copy-09 nil "With 'tree. Non-list" (let ((debug-on-error nil)) (should-error (list-utils-make-proper-copy 1)))) (ert-deftest list-utils-make-proper-copy-10 nil "With 'tree. Two elt cons" (let* ((proper '(1 2)) (improper (apply 'cl-list* proper)) (backup (copy-tree improper))) (should-not (equal proper improper)) (should (equal proper (list-utils-make-proper-copy improper 'tree))) (should ;; was not changed inplace (equal backup improper)))) (ert-deftest list-utils-make-proper-copy-11 nil "With 'tree. Multi-elt improper list" (let* ((proper '(a b c d e f)) (improper (apply 'cl-list* proper)) (backup (copy-tree improper))) (should-not (equal proper improper)) (should (equal proper (list-utils-make-proper-copy improper 'tree))) (should ;; was not changed inplace (equal backup improper)))) (ert-deftest list-utils-make-proper-copy-12 nil "With 'tree. Single-elt list" (let* ((proper '(1)) (copy (copy-tree proper))) (should (equal proper copy)) (should (equal proper (list-utils-make-proper-copy copy 'tree))) (should (equal proper copy)))) (ert-deftest list-utils-make-proper-copy-13 nil "With 'tree. Deep structure." (let* ((proper '(a (b) (c d) (e (f g h) i) ((j k) l) m)) (improper '(a (b) (c . d) (e (f g . h) . i) ((j . k) . l) . m)) (backup (copy-tree improper))) (should-not (equal proper improper)) (should (equal proper (list-utils-make-proper-copy improper 'tree))) (should ;; was not changed inplace (equal backup improper)))) ;;; list-utils-make-proper-inplace (ert-deftest list-utils-make-proper-inplace-01 nil "Already proper" (let* ((proper '(a b c d e f)) (copy (copy-tree proper))) (should (equal proper copy)) (should (equal proper (list-utils-make-proper-inplace copy))) (should (equal proper copy)))) (ert-deftest list-utils-make-proper-inplace-02 nil "nil" (should-not (list-utils-make-proper-inplace nil))) (ert-deftest list-utils-make-proper-inplace-03 nil "Non-list" (let ((debug-on-error nil)) (should-error (list-utils-make-proper-inplace 1)))) (ert-deftest list-utils-make-proper-inplace-04 nil "Two elt cons" (let* ((proper '(1 2)) (improper (apply 'cl-list* proper))) (should-not (equal proper improper)) (should (equal proper (list-utils-make-proper-inplace improper))) (should ;; was changed inplace (equal proper improper)))) (ert-deftest list-utils-make-proper-inplace-05 nil "Multi-elt improper list" (let* ((proper '(a b c d e f)) (improper (apply 'cl-list* proper))) (should-not (equal proper improper)) (should (equal proper (list-utils-make-proper-inplace improper))) (should ;; was changed inplace (equal proper improper)))) (ert-deftest list-utils-make-proper-inplace-06 nil "Single-elt list" (let* ((proper '(1)) (copy (copy-tree proper))) (should (equal proper copy)) (should (equal proper (list-utils-make-proper-inplace copy))) (should (equal proper copy)))) (ert-deftest list-utils-make-proper-inplace-07 nil "With 'tree. Already proper" (let* ((proper '(a b c d e f)) (copy (copy-tree proper))) (should (equal proper copy)) (should (equal proper (list-utils-make-proper-inplace copy 'tree))) (should (equal proper copy)))) (ert-deftest list-utils-make-proper-inplace-08 nil "With 'tree. nil" (should-not (list-utils-make-proper-inplace nil 'tree))) (ert-deftest list-utils-make-proper-inplace-09 nil "With 'tree. Non-list" (let ((debug-on-error nil)) (should-error (list-utils-make-proper-inplace 1 'tree)))) (ert-deftest list-utils-make-proper-inplace-10 nil "With 'tree. Two elt cons" (let* ((proper '(1 2)) (improper (apply 'cl-list* proper))) (should-not (equal proper improper)) (should (equal proper (list-utils-make-proper-inplace improper 'tree))) (should ;; was changed inplace (equal proper improper)))) (ert-deftest list-utils-make-proper-inplace-11 nil "With 'tree. Multi-elt improper list" (let* ((proper '(a b c d e f)) (improper (apply 'cl-list* proper))) (should-not (equal proper improper)) (should (equal proper (list-utils-make-proper-inplace improper 'tree))) (should ;; was changed inplace (equal proper improper)))) (ert-deftest list-utils-make-proper-inplace-12 nil "With 'tree. Single-elt list" (let* ((proper '(1)) (copy (copy-tree proper))) (should (equal proper copy)) (should (equal proper (list-utils-make-proper-inplace copy 'tree))) (should (equal proper copy)))) (ert-deftest list-utils-make-proper-inplace-13 nil "With 'tree. Deep structure." (let* ((proper '(a (b) (c d) (e (f g h) i) ((j k) l) m)) (improper '(a (b) (c . d) (e (f g . h) . i) ((j . k) . l) . m))) (should-not (equal proper improper)) (should (equal proper (list-utils-make-proper-inplace improper 'tree))) (should ;; was changed inplace (equal proper improper)))) ;;; list-utils-make-improper-copy (ert-deftest list-utils-make-improper-copy-01 nil "Already improper" (let* ((improper '(1 2 3 4 5 . 6)) (copy (copy-tree improper))) (should (equal improper copy)) (should (equal improper (list-utils-make-improper-copy copy))) (should (equal improper copy)))) (ert-deftest list-utils-make-improper-copy-02 nil "Nil" (let ((debug-on-error nil)) (should-error (list-utils-make-improper-copy nil)))) (ert-deftest list-utils-make-improper-copy-03 nil "Non-list" (let ((debug-on-error nil)) (should-error (list-utils-make-improper-copy 1)))) (ert-deftest list-utils-make-improper-copy-04 nil "Two elt list" (let* ((proper '(1 2)) (improper (apply 'cl-list* proper)) (backup (copy-tree proper))) (should-not (equal improper proper)) (should (equal improper (list-utils-make-improper-copy proper))) (should ;; was not changed inplace (equal backup proper)))) (ert-deftest list-utils-make-improper-copy-05 nil "Multi-elt list" (let* ((proper '(a b c d e f)) (improper (apply 'cl-list* proper)) (backup (copy-tree proper))) (should-not (equal improper proper)) (should (equal improper (list-utils-make-improper-copy proper))) (should ;; was not changed inplace (equal backup proper)))) (ert-deftest list-utils-make-improper-copy-06 nil "Single-elt list" (let* ((proper '(1)) (copy (copy-tree proper))) (should (equal proper copy)) (let ((debug-on-error nil)) (should-error (list-utils-make-improper-copy copy))))) (ert-deftest list-utils-make-improper-copy-07 nil "With 'tree. Already improper" (let* ((improper '(1 2 3 4 5 . 6)) (copy (copy-tree improper))) (should (equal improper copy)) (should (equal improper (list-utils-make-improper-copy copy 'tree))) (should (equal improper copy)))) (ert-deftest list-utils-make-improper-copy-08 nil "With 'tree. Nil" (let ((debug-on-error nil)) (should-error (list-utils-make-improper-copy nil 'tree)))) (ert-deftest list-utils-make-improper-copy-09 nil "With 'tree. Non-list" (let ((debug-on-error nil)) (should-error (list-utils-make-improper-copy 1 'tree)))) (ert-deftest list-utils-make-improper-copy-10 nil "With 'tree. Two elt list" (let* ((proper '(1 2)) (improper (apply 'cl-list* proper)) (backup (copy-tree proper))) (should-not (equal improper proper)) (should (equal improper (list-utils-make-improper-copy proper 'tree))) (should ;; was not changed inplace (equal backup proper)))) (ert-deftest list-utils-make-improper-copy-11 nil "With 'tree. Multi-elt list" (let* ((proper '(a b c d e f)) (improper (apply 'cl-list* proper)) (backup (copy-tree proper))) (should-not (equal improper proper)) (should (equal improper (list-utils-make-improper-copy proper 'tree))) (should ;; was not changed inplace (equal backup proper)))) (ert-deftest list-utils-make-improper-copy-12 nil "With 'tree. Single-elt list" (let* ((proper '(1)) (copy (copy-tree proper))) (should (equal proper copy)) (let ((debug-on-error nil)) (should-error (list-utils-make-improper-copy copy 'tree))))) (ert-deftest list-utils-make-improper-copy-13 nil "With 'tree. Deep structure." (let* ((proper '(a (b) (c d) (e (f g h) i) ((j k) l) m)) (improper '(a (b) (c . d) (e (f g . h) . i) ((j . k) . l) . m)) (backup (copy-tree proper))) (should-not (equal improper proper)) (should (equal improper (list-utils-make-improper-copy proper 'tree))) (should ;; was not changed inplace (equal backup proper)))) ;;; list-utils-make-improper-inplace (ert-deftest list-utils-make-improper-inplace-01 nil "Already improper" (let* ((improper '(1 2 3 4 5 . 6)) (copy (copy-tree improper))) (should (equal improper copy)) (should (equal improper (list-utils-make-improper-inplace copy))) (should (equal improper copy)))) (ert-deftest list-utils-make-improper-inplace-02 nil "Nil" (let ((debug-on-error nil)) (should-error (list-utils-make-improper-inplace nil)))) (ert-deftest list-utils-make-improper-inplace-03 nil "Non-list" (let ((debug-on-error nil)) (should-error (list-utils-make-improper-inplace 1)))) (ert-deftest list-utils-make-improper-inplace-04 nil "Two elt list" (let* ((proper '(1 2)) (improper (apply 'cl-list* proper))) (should-not (equal improper proper)) (should (equal improper (list-utils-make-improper-inplace proper))) (should ;; was changed inplace (equal improper proper)))) (ert-deftest list-utils-make-improper-inplace-05 nil "Multi-elt list" (let* ((proper '(a b c d e f)) (improper (apply 'cl-list* proper))) (should-not (equal improper proper)) (should (equal improper (list-utils-make-improper-inplace proper))) (should ;; was changed inplace (equal improper proper)))) (ert-deftest list-utils-make-improper-inplace-06 nil "Single-elt list" (let* ((proper '(1)) (copy (copy-tree proper))) (should (equal proper copy)) (let ((debug-on-error nil)) (should-error (list-utils-make-improper-inplace copy))))) (ert-deftest list-utils-make-improper-inplace-07 nil "With 'tree. Already improper" (let* ((improper '(1 2 3 4 5 . 6)) (copy (copy-tree improper))) (should (equal improper copy)) (should (equal improper (list-utils-make-improper-inplace copy 'tree))) (should (equal improper copy)))) (ert-deftest list-utils-make-improper-inplace-08 nil "With 'tree. Nil" (let ((debug-on-error nil)) (should-error (list-utils-make-improper-inplace nil 'tree)))) (ert-deftest list-utils-make-improper-inplace-09 nil "With 'tree. Non-list" (let ((debug-on-error nil)) (should-error (list-utils-make-improper-inplace 1 'tree)))) (ert-deftest list-utils-make-improper-inplace-10 nil "With 'tree. Two elt list" (let* ((proper '(1 2)) (improper (apply 'cl-list* proper))) (should-not (equal improper proper)) (should (equal improper (list-utils-make-improper-inplace proper 'tree))) (should ;; was changed inplace (equal improper proper)))) (ert-deftest list-utils-make-improper-inplace-11 nil "With 'tree. Multi-elt list" (let* ((proper '(a b c d e f)) (improper (apply 'cl-list* proper))) (should-not (equal improper proper)) (should (equal improper (list-utils-make-improper-inplace proper 'tree))) (should ;; was changed inplace (equal improper proper)))) (ert-deftest list-utils-make-improper-inplace-12 nil "With 'tree. Single-elt list" (let* ((proper '(1)) (copy (copy-tree proper))) (should (equal proper copy)) (let ((debug-on-error nil)) (should-error (list-utils-make-improper-inplace copy 'tree))))) (ert-deftest list-utils-make-improper-inplace-13 nil "With 'tree. Deep structure." (let* ((proper '(a (b) (c d) (e (f g h) i) ((j k) l) m)) (improper '(a (b) (c . d) (e (f g . h) . i) ((j . k) . l) . m))) (should-not (equal improper proper)) (should (equal improper (list-utils-make-improper-inplace proper 'tree))) (should ;; was not changed inplace (equal improper proper)))) ;;; list-utils-cyclic-length (ert-deftest list-utils-cyclic-length-01 nil (should (= 8 (let ((cyclic '(a b c d e f g h))) (nconc cyclic cyclic) (list-utils-cyclic-length cyclic))))) (ert-deftest list-utils-cyclic-length-02 nil (should (= 7 (let ((cyclic '(a b c d e f g h))) (nconc cyclic (cdr cyclic)) (list-utils-cyclic-length cyclic))))) (ert-deftest list-utils-cyclic-length-03 nil (should (= 1 (let ((cyclic '(a b c d e f g h))) (nconc cyclic (last cyclic)) (list-utils-cyclic-length cyclic))))) (ert-deftest list-utils-cyclic-length-04 nil (should (= 0 (list-utils-cyclic-length (cons 1 2))))) (ert-deftest list-utils-cyclic-length-05 nil (should (= 0 (list-utils-cyclic-length (cl-list* 1 2 3))))) (ert-deftest list-utils-cyclic-length-06 nil (let ((cyclic '(1))) (nconc cyclic cyclic) (should (= 1 (list-utils-cyclic-length cyclic))))) ;;; list-utils-cyclic-subseq (ert-deftest list-utils-cyclic-subseq-01 nil (should (equal '(1 2 3 4 5 6 7 8) (let ((cyclic '(1 2 3 4 5 6 7 8))) (nconc cyclic cyclic) (sort (list-utils-flatten (list-utils-cyclic-subseq cyclic)) '<))))) (ert-deftest list-utils-cyclic-subseq-02 nil (should (equal '(2 3 4 5 6 7 8) (let ((cyclic '(1 2 3 4 5 6 7 8))) (nconc cyclic (cdr cyclic)) (sort (list-utils-flatten (list-utils-cyclic-subseq cyclic)) '<))))) (ert-deftest list-utils-cyclic-subseq-03 nil (should (equal '(2 3 4 5 6 7 8) (let ((cyclic '(1 2 3 4 5 6 7 8))) (nconc cyclic (cdr cyclic)) (list-utils-flatten (list-utils-cyclic-subseq cyclic 'from-start)))))) (ert-deftest list-utils-cyclic-subseq-04 nil (should (equal '(8) (let ((cyclic '(1 2 3 4 5 6 7 8))) (nconc cyclic (last cyclic)) (list-utils-flatten (list-utils-cyclic-subseq cyclic)))))) (ert-deftest list-utils-cyclic-subseq-05 nil (should-not (list-utils-cyclic-subseq '(1 2 3)))) (ert-deftest list-utils-cyclic-subseq-06 nil (should-not (list-utils-cyclic-subseq nil))) (ert-deftest list-utils-cyclic-subseq-07 nil (should-not (list-utils-cyclic-subseq (cons 1 2)))) (ert-deftest list-utils-cyclic-subseq-08 nil (should-not (list-utils-cyclic-subseq (cl-list* 1 2 3)))) (ert-deftest list-utils-cyclic-subseq-09 nil (let ((cyclic '(1))) (nconc cyclic cyclic) (should (equal '(1) (list-utils-flatten (list-utils-cyclic-subseq cyclic)))))) ;;; list-utils-cyclic-p (ert-deftest list-utils-cyclic-p-01 nil (should (let ((cyclic '(1 2 3 4 5 6 7 8))) (nconc cyclic cyclic) (list-utils-cyclic-p cyclic)))) (ert-deftest list-utils-cyclic-p-02 nil (should (let ((cyclic '(1 2 3 4 5 6 7 8))) (nconc cyclic cyclic) (list-utils-cyclic-p cyclic 'perfect)))) (ert-deftest list-utils-cyclic-p-03 nil (should (let ((cyclic '(1 2 3 4 5 6 7 8))) (nconc cyclic (cdr cyclic)) (list-utils-cyclic-p cyclic)))) (ert-deftest list-utils-cyclic-p-04 nil (should-not (let ((cyclic '(1 2 3 4 5 6 7 8))) (nconc cyclic (cdr cyclic)) (list-utils-cyclic-p cyclic 'perfect)))) (ert-deftest list-utils-cyclic-p-05 nil (should (let ((cyclic '(1 2 3 4 5 6 7 8))) (nconc cyclic (last cyclic)) (list-utils-cyclic-p cyclic)))) (ert-deftest list-utils-cyclic-p-06 nil (should-not (list-utils-cyclic-p '(1 2 3)))) (ert-deftest list-utils-cyclic-p-07 nil (should-not (list-utils-cyclic-p nil))) (ert-deftest list-utils-cyclic-p-08 nil (should-not (list-utils-cyclic-p (cons 1 2)))) (ert-deftest list-utils-cyclic-p-09 nil (should-not (list-utils-cyclic-p (cl-list* 1 2 3)))) (ert-deftest list-utils-cyclic-p-10 nil (should (let ((cyclic '(1))) (nconc cyclic cyclic) (list-utils-cyclic-p cyclic)))) ;;; list-utils-linear-p (ert-deftest list-utils-linear-p-01 nil (should-not (let ((cyclic '(1 2 3 4 5 6 7 8))) (nconc cyclic cyclic) (list-utils-linear-p cyclic)))) (ert-deftest list-utils-linear-p-02 nil (should-not (let ((cyclic '(1 2 3 4 5 6 7 8))) (nconc cyclic (cdr cyclic)) (list-utils-linear-p cyclic)))) (ert-deftest list-utils-linear-p-03 nil (should-not (let ((cyclic '(1 2 3 4 5 6 7 8))) (nconc cyclic (last cyclic)) (list-utils-linear-p cyclic)))) (ert-deftest list-utils-linear-p-04 nil (should (list-utils-linear-p '(1 2 3)))) (ert-deftest list-utils-linear-p-05 nil (should (list-utils-linear-p nil))) (ert-deftest list-utils-linear-p-06 nil (should (list-utils-linear-p (cons 1 2)))) (ert-deftest list-utils-linear-p-07 nil (should (list-utils-linear-p (cl-list* 1 2 3)))) (ert-deftest list-utils-linear-p-08 nil (let ((cyclic '(1))) (nconc cyclic cyclic) (should-not (list-utils-linear-p cyclic)))) ;;; list-utils-linear-subseq (ert-deftest list-utils-linear-subseq-01 nil (should-not (let ((cyclic '(a b c d e f g h))) (nconc cyclic cyclic) (list-utils-linear-subseq cyclic)))) (ert-deftest list-utils-linear-subseq-02 nil (should (equal '(a) (let ((cyclic '(a b c d e f g h))) (nconc cyclic (cdr cyclic)) (list-utils-linear-subseq cyclic))))) (ert-deftest list-utils-linear-subseq-03 nil (should (equal '(a b c d e f g) (let ((cyclic '(a b c d e f g h))) (nconc cyclic (last cyclic)) (list-utils-linear-subseq cyclic))))) (ert-deftest list-utils-linear-subseq-04 nil (let ((improper (cons 1 2))) (should (equal improper (list-utils-linear-subseq improper))))) (ert-deftest list-utils-linear-subseq-05 nil (let ((improper (cl-list* 1 2 3))) (should (equal improper (list-utils-linear-subseq (cl-list* 1 2 3)))))) (ert-deftest list-utils-linear-subseq-06 nil (let ((cyclic '(1))) (nconc cyclic cyclic) (should-not (list-utils-linear-subseq cyclic)))) ;;; list-utils-safe-length (ert-deftest list-utils-safe-length-01 nil (should (= 8 (let ((cyclic '(a b c d e f g h))) (nconc cyclic cyclic) (list-utils-safe-length cyclic))))) (ert-deftest list-utils-safe-length-02 nil (should (= 8 (let ((cyclic '(a b c d e f g h))) (nconc cyclic (cdr cyclic)) (list-utils-safe-length cyclic))))) (ert-deftest list-utils-safe-length-03 nil (should (= 8 (let ((cyclic '(a b c d e f g h))) (nconc cyclic (last cyclic)) (list-utils-safe-length cyclic))))) (ert-deftest list-utils-safe-length-04 nil (should (= 8 (let ((cyclic '(a b c d e f g h))) (list-utils-safe-length cyclic))))) (ert-deftest list-utils-safe-length-05 nil (should (= 0 (list-utils-safe-length nil)))) (ert-deftest list-utils-safe-length-06 nil (should (= 0 (list-utils-safe-length :not-a-list)))) (ert-deftest list-utils-safe-length-07 nil (should (= 1 (list-utils-safe-length (cons 1 2))))) (ert-deftest list-utils-safe-length-08 nil (should (= 2 (list-utils-safe-length (cl-list* 1 2 3))))) (ert-deftest list-utils-safe-length-09 nil (let ((cyclic '(1))) (nconc cyclic cyclic) (should (= 1 (list-utils-safe-length cyclic))))) ;;; list-utils-flat-length (ert-deftest list-utils-flat-length-01 nil (let ((mixed '(1 2 3 nil 7 8 9 (4 . 0) 5 6 7 (8 9)))) (should (= 7 (list-utils-flat-length mixed))))) ;;; list-utils-make-linear-copy (ert-deftest list-utils-make-linear-copy-01 nil (let* ((value '(1 2 3 4 5)) (cyclic (copy-tree value))) (nconc cyclic cyclic) (should (equal value (list-utils-make-linear-copy cyclic))))) (ert-deftest list-utils-make-linear-copy-02 nil (let* ((value '(1 2 3 4 5)) (cyclic (copy-tree value))) (nconc cyclic (cdr cyclic)) (should (equal value (list-utils-make-linear-copy cyclic))))) (ert-deftest list-utils-make-linear-copy-03 nil (let* ((value '(1 2 3 (4 (5 6)))) (cyclic (copy-tree value))) (nconc cyclic (cdr cyclic)) (should (equal value (list-utils-make-linear-copy cyclic))))) (ert-deftest list-utils-make-linear-copy-04 nil "LIST argument is unchanged." (let* ((value '(1 2 3 (4 (5 6)))) (cyclic-1 (copy-tree value)) (cyclic-2 (copy-tree value))) (nconc cyclic-1 (cdr cyclic-1)) (nconc cyclic-2 (cdr cyclic-2)) (should (equal value (list-utils-make-linear-copy cyclic-1))) (should (list-utils-safe-equal cyclic-1 cyclic-2)))) (ert-deftest list-utils-make-linear-copy-05 nil "With 'tree" (let* ((value '(1 2 3 4 5)) (cyclic value) (list-val (list 'a 'b cyclic)) (list-copy (copy-tree list-val))) (nconc cyclic cyclic) (should (equal list-copy (list-utils-make-linear-copy list-val 'tree))))) (ert-deftest list-utils-make-linear-copy-06 nil "With 'tree" (let* ((value '(1 2 3 4 5)) (cyclic value) (list-val (list 'a 'b cyclic)) (list-copy (copy-tree list-val))) (nconc cyclic (cdr cyclic)) (should (equal list-copy (list-utils-make-linear-copy list-val 'tree))))) (ert-deftest list-utils-make-linear-copy-07 nil "With 'tree" (let* ((value '(1 2 3 4 5)) (cyclic value) (list-val (list 1 2 3 (list 4 (list 5 6 cyclic)))) (list-copy (copy-tree list-val))) (nconc cyclic (cdr cyclic)) (should (equal list-copy (list-utils-make-linear-copy list-val 'tree))))) (ert-deftest list-utils-make-linear-copy-08 nil "With 'tree" (let* ((value '(1 2 3 4 5)) (cyclic value) (list-val (list 1 2 3 (list 4 (list 5 6 cyclic)))) (list-copy (copy-tree list-val))) (nconc cyclic (cdr cyclic)) (nconc list-val list-val) (should (equal list-copy (list-utils-make-linear-copy list-val 'tree))))) (ert-deftest list-utils-make-linear-copy-09 nil "With 'tree. LIST argument is not altered." (let* ((value '(1 2 3 4 5)) (cyclic value) (list-val (list 'a 'b cyclic)) (list-copy (copy-tree list-val))) (nconc cyclic (cdr cyclic)) (should (equal list-copy (list-utils-make-linear-copy list-val 'tree))) (should-not (list-utils-safe-equal list-copy list-val)))) ;;; list-utils-make-linear-inplace (ert-deftest list-utils-make-linear-inplace-01 nil (let* ((value '(1 2 3 4 5)) (cyclic value)) (nconc cyclic cyclic) (should (equal value (list-utils-make-linear-inplace cyclic))))) (ert-deftest list-utils-make-linear-inplace-02 nil (let* ((value '(1 2 3 4 5)) (cyclic value)) (nconc cyclic (cdr cyclic)) (should (equal value (list-utils-make-linear-inplace cyclic))))) (ert-deftest list-utils-make-linear-inplace-03 nil (let* ((value '(1 2 3 (4 (5 6)))) (cyclic value)) (nconc cyclic (cdr cyclic)) (should (equal value (list-utils-make-linear-inplace cyclic))))) (ert-deftest list-utils-make-linear-inplace-04 nil "LIST argument is altered." (let* ((value '(1 2 3 (4 (5 6)))) (cyclic-1 (copy-tree value))) (nconc cyclic-1 (cdr cyclic-1)) (should (equal value (list-utils-make-linear-inplace cyclic-1))) (should (list-utils-safe-equal value cyclic-1)))) (ert-deftest list-utils-make-linear-inplace-05 nil "With 'tree" (let* ((value '(1 2 3 4 5)) (cyclic value) (list-val (list 'a 'b cyclic)) (list-copy (copy-tree list-val))) (nconc cyclic cyclic) (should (equal list-copy (list-utils-make-linear-inplace list-val 'tree))))) (ert-deftest list-utils-make-linear-inplace-06 nil "With 'tree" (let* ((value '(1 2 3 4 5)) (cyclic value) (list-val (list 'a 'b cyclic)) (list-copy (copy-tree list-val))) (nconc cyclic (cdr cyclic)) (should (equal list-copy (list-utils-make-linear-inplace list-val 'tree))))) (ert-deftest list-utils-make-linear-inplace-07 nil "With 'tree" (let* ((value '(1 2 3 4 5)) (cyclic value) (list-val (list 1 2 3 (list 4 (list 5 6 cyclic)))) (list-copy (copy-tree list-val))) (nconc cyclic (cdr cyclic)) (should (equal list-copy (list-utils-make-linear-inplace list-val 'tree))))) (ert-deftest list-utils-make-linear-inplace-08 nil "With 'tree" (let* ((value '(1 2 3 4 5)) (cyclic value) (list-val (list 1 2 3 (list 4 (list 5 6 cyclic)))) (list-copy (copy-tree list-val))) (nconc cyclic (cdr cyclic)) (nconc list-val list-val) (should (equal list-copy (list-utils-make-linear-inplace list-val 'tree))))) (ert-deftest list-utils-make-linear-inplace-09 nil "With 'tree. LIST argument is altered." (let* ((value '(1 2 3 4 5)) (cyclic value) (list-val (list 'a 'b cyclic)) (list-copy (copy-tree list-val))) (nconc cyclic (cdr cyclic)) (should (equal list-copy (list-utils-make-linear-inplace list-val 'tree))) (should (equal list-copy list-val)))) ;;; list-utils-safe-equal (ert-deftest list-utils-safe-equal-01 nil "Simple list" (let* ((value '(1 2 3 4 5)) (copy (copy-tree value))) (should (list-utils-safe-equal copy value)))) (ert-deftest list-utils-safe-equal-02 nil "Differ by length" (let* ((value '(1 2 3 4 5)) (copy (copy-tree value))) (pop copy) (should-not (list-utils-safe-equal copy value)))) (ert-deftest list-utils-safe-equal-03 nil "nonstandard TEST" (let* ((value-1 '(1 2 3 4 5)) (value-2 '(1.0 2.0 3.0 4.0 5.0))) (should-not (list-utils-safe-equal value-1 value-2)) (should-not (list-utils-safe-equal value-1 value-2 '=)))) (ert-deftest list-utils-safe-equal-04 nil "Cyclic 1" (let* ((value '(1 2 3 4 5)) (cyclic-1 (copy-tree value)) (cyclic-2 (copy-tree value))) (nconc cyclic-1 cyclic-1) (nconc cyclic-2 cyclic-2) (should (list-utils-safe-equal cyclic-1 cyclic-2)) ;; args remain unmodified (should-not (list-utils-safe-equal cyclic-1 value)) (should-not (list-utils-safe-equal cyclic-2 value)))) (ert-deftest list-utils-safe-equal-05 nil "Cyclic 2" (let* ((value '(1 2 3 4 5)) (cyclic-1 (copy-tree value)) (cyclic-2 (copy-tree value))) (nconc cyclic-1 (cdr cyclic-1)) (nconc cyclic-2 (cdr cyclic-2)) (should (list-utils-safe-equal cyclic-1 cyclic-2)) ;; args remain unmodified (should-not (list-utils-safe-equal cyclic-1 value)) (should-not (list-utils-safe-equal cyclic-2 value)))) (ert-deftest list-utils-safe-equal-06 nil "Differ only by cyclic structure" (let* ((value '(1 2 3 4 5)) (cyclic-1 (copy-tree value)) (cyclic-2 (copy-tree value))) (nconc cyclic-1 cyclic-1) (nconc cyclic-2 (cdr cyclic-2)) (should-not (list-utils-safe-equal cyclic-1 cyclic-2)) ;; args remain unmodified (should-not (list-utils-safe-equal cyclic-1 value)) (should-not (list-utils-safe-equal cyclic-2 value)))) (ert-deftest list-utils-safe-equal-07 nil "Tree with cycle" (let* ((value '(1 2 3 (4 (5 6)))) (cyclic-1 (copy-tree value)) (cyclic-2 (copy-tree value))) (nconc cyclic-1 (cdr cyclic-1)) (nconc cyclic-2 (cdr cyclic-2)) (should (list-utils-safe-equal cyclic-1 cyclic-2)) ;; args remain unmodified (should-not (list-utils-safe-equal cyclic-1 value)) (should-not (list-utils-safe-equal cyclic-2 value)))) (ert-deftest list-utils-safe-equal-08 nil "List containing other cycles" (let* ((value '(1 2 3 4 5)) (cyclic-1 (copy-tree value)) (cyclic-2 (copy-tree value)) (list-1 (list 'a 'b cyclic-1)) (list-2 (list 'a 'b cyclic-2))) (nconc cyclic-1 (cdr cyclic-1)) (nconc cyclic-2 (cdr cyclic-2)) (should (list-utils-safe-equal list-1 list-2)))) (ert-deftest list-utils-safe-equal-09 nil "Cyclic list of size one" (let* ((value '(1)) (cyclic-1 (copy-tree value)) (cyclic-2 (copy-tree value))) (nconc cyclic-1 cyclic-1) (nconc cyclic-2 cyclic-2) (should (list-utils-safe-equal cyclic-1 cyclic-2)) (should-not (list-utils-safe-equal cyclic-1 value)) (should-not (list-utils-safe-equal cyclic-2 value)))) (ert-deftest list-utils-safe-equal-10 nil "Improper list" (let* ((value (cl-list* 1 2 3)) (copy-1 (copy-tree value)) (copy-2 (copy-tree value))) (should (list-utils-safe-equal copy-1 copy-2)) (should (equal copy-1 value)))) (ert-deftest list-utils-safe-equal-11 nil "Improper list" (let* ((value-1 (cl-list* 1 2 3)) (value-2 (cl-list* 1 2))) (should-not (list-utils-safe-equal value-1 value-2)))) (ert-deftest list-utils-safe-equal-12 nil "Improper list" (let* ((value-1 (cl-list* 1 2 3)) (value-2 (cl-list* 1 2 4))) (should-not (list-utils-safe-equal value-1 value-2)))) (ert-deftest list-utils-safe-equal-13 nil "Non-list" (should (list-utils-safe-equal 1 1)) (should (list-utils-safe-equal "1" "1")) (should-not (list-utils-safe-equal 1 "1"))) (ert-deftest list-utils-safe-equal-14 nil "mixed list" (should-not (list-utils-safe-equal 1 (list 1)))) ;;; list-utils-flatten (ert-deftest list-utils-flatten-01 nil (should (equal '(a b c d e f) (list-utils-flatten '(a b c (d e (f))))))) (ert-deftest list-utils-flatten-02 nil (should (equal '(a nil b nil c nil d nil e nil f nil nil nil) (list-utils-flatten '(a nil b nil c nil (d nil e nil (f nil) nil) nil))))) (ert-deftest list-utils-flatten-03 nil (should (equal '(1 2 3 4 5) (list-utils-flatten '(1 2 3 4 . 5))))) (ert-deftest list-utils-flatten-04 nil (should (equal '(1 2 3 4 5) (list-utils-flatten '(1 2 3 (4 . 5)))))) (ert-deftest list-utils-flatten-05 nil (should (equal '(1 2 3 4 5) (let ((cyclic '(1 2 3 (4 5)))) (nconc cyclic (cdr cyclic)) (list-utils-flatten cyclic))))) (ert-deftest list-utils-flatten-06 nil (should (equal '(1 2) (list-utils-flatten (cons 1 2))))) (ert-deftest list-utils-flatten-07 nil (let ((cyclic '(1))) (nconc cyclic cyclic) (should (equal '(1) (list-utils-flatten cyclic))))) (ert-deftest list-utils-flatten-08 nil "Don't modifiy LIST" (let ((cyclic-1 '(1 2 3 (4 5))) (cyclic-2 '(1 2 3 (4 5)))) (nconc cyclic-1 (cdr cyclic-1)) (nconc cyclic-2 (cdr cyclic-2)) (should (equal '(1 2 3 4 5) (list-utils-flatten cyclic-1))) (should (equal (list-utils-linear-subseq cyclic-1) (list-utils-linear-subseq cyclic-2))) (should (equal (cl-subseq (list-utils-cyclic-subseq cyclic-1) 0 (list-utils-safe-length (list-utils-cyclic-subseq cyclic-1))) (cl-subseq (list-utils-cyclic-subseq cyclic-2) 0 (list-utils-safe-length (list-utils-cyclic-subseq cyclic-2))))))) ;;; list-utils-depth (ert-deftest list-utils-depth-01 nil (should (= 0 (list-utils-depth nil)))) (ert-deftest list-utils-depth-02 nil (should (= 0 (list-utils-depth "not a list")))) (ert-deftest list-utils-depth-03 nil (should (= 1 (list-utils-depth '(1 2 3))))) (ert-deftest list-utils-depth-04 nil (should (= 1 (list-utils-depth (cons 1 2))))) (ert-deftest list-utils-depth-05 nil (should (= 3 (list-utils-depth '(a b c (d e (f))))))) (ert-deftest list-utils-depth-06 nil (should (= 3 (list-utils-depth '(a nil b nil c nil (d nil e nil (f nil) nil) nil))))) (ert-deftest list-utils-depth-07 nil (should (= 1 (list-utils-depth '(1 2 3 4 . 5))))) (ert-deftest list-utils-depth-08 nil (should (= 2 (list-utils-depth '(1 2 3 (4 . 5)))))) (ert-deftest list-utils-depth-09 nil (should (= 1 (let ((cyclic '(1 2 3 4 5))) (nconc cyclic (cdr cyclic)) (list-utils-depth cyclic))))) (ert-deftest list-utils-depth-10 nil (should (= 2 (let ((cyclic '(1 2 3 (4 5)))) (nconc cyclic (cdr cyclic)) (list-utils-depth cyclic))))) (ert-deftest list-utils-depth-11 nil (let* ((value '(a nil (b . 1) nil (c 2 . 3) nil (d nil e nil (f nil) nil) nil)) (copy (copy-tree value))) (list-utils-depth value) (should (equal value copy)))) (ert-deftest list-utils-depth-12 nil (let ((cyclic '(1))) (nconc cyclic cyclic) (should (= 1 (list-utils-depth cyclic))))) (ert-deftest list-utils-depth-13 nil "Don't modifiy LIST" (let ((cyclic-1 '(1 2 3 (4 5))) (cyclic-2 '(1 2 3 (4 5)))) (nconc cyclic-1 (cdr cyclic-1)) (nconc cyclic-2 (cdr cyclic-2)) (should (= 2 (list-utils-depth cyclic-1))) (should (equal (list-utils-linear-subseq cyclic-1) (list-utils-linear-subseq cyclic-2))) (should (equal (cl-subseq (list-utils-cyclic-subseq cyclic-1) 0 (list-utils-safe-length (list-utils-cyclic-subseq cyclic-1))) (cl-subseq (list-utils-cyclic-subseq cyclic-2) 0 (list-utils-safe-length (list-utils-cyclic-subseq cyclic-2))))))) ;;; list-utils-alist-or-flat-length (ert-deftest list-utils-alist-or-flat-length-01 nil (let ((mixed '(1 2 3 nil 7 8 9 (4 . 0) 5 6 7 (8 9)))) (should (= 11 (list-utils-alist-or-flat-length mixed))))) ;;; list-utils-alist-flatten (ert-deftest list-utils-alist-flatten-01 nil (should (equal '(1 2 3 4 . 5) (list-utils-alist-flatten '(1 2 3 4 . 5))))) (ert-deftest list-utils-alist-flatten-02 nil (should (equal '(1 2 3 (4 . 5)) (list-utils-alist-flatten '(1 2 3 (4 . 5)))))) (ert-deftest list-utils-alist-flatten-03 nil (should (equal '(1 2 3 (4 . 5)) (list-utils-alist-flatten '(1 (2 3) (4 . 5)))))) (ert-deftest list-utils-alist-flatten-04 nil (should (equal '((1 . 2) (3 . 4) (5 . 6) (7 . 8)) (list-utils-alist-flatten '(((1 . 2) (3 . 4)) ((5 . 6) (7 . 8))))))) (ert-deftest list-utils-alist-flatten-05 nil (should (equal (cons 1 2) (list-utils-alist-flatten (cons 1 2))))) (ert-deftest list-utils-alist-flatten-06 nil "Don't modifiy LIST" (let ((cyclic-1 '(1 2 3 ((4 . 5) (6 . 7)))) (cyclic-2 '(1 2 3 ((4 . 5) (6 . 7))))) (nconc cyclic-1 (cdr cyclic-1)) (nconc cyclic-2 (cdr cyclic-2)) (should (equal '(1 2 3 (4 . 5) (6 . 7)) (list-utils-alist-flatten cyclic-1))) (should (equal (list-utils-linear-subseq cyclic-1) (list-utils-linear-subseq cyclic-2))) (should (equal (cl-subseq (list-utils-cyclic-subseq cyclic-1) 0 (list-utils-safe-length (list-utils-cyclic-subseq cyclic-1))) (cl-subseq (list-utils-cyclic-subseq cyclic-2) 0 (list-utils-safe-length (list-utils-cyclic-subseq cyclic-2))))))) ;;; list-utils-insert-before (ert-deftest list-utils-insert-before-01 nil (should (equal '(1 2 3 four 4 5) (list-utils-insert-before '(1 2 3 4 5) 4 'four)))) (ert-deftest list-utils-insert-before-02 nil (should (equal '(elt 1 2 3 4 5) (list-utils-insert-before '(1 2 3 4 5) 1 'elt)))) (ert-deftest list-utils-insert-before-03 nil (should (equal '(1 2 3 4 elt 5) (list-utils-insert-before '(1 2 3 4 5) 5 'elt)))) (ert-deftest list-utils-insert-before-04 nil (let ((debug-on-error nil)) (should-error (list-utils-insert-before '(1 2 3 4 5) 6 'elt)))) (ert-deftest list-utils-insert-before-05 nil (should (equal (cl-list* 'elt 1 2) (list-utils-insert-before (cons 1 2) 1 'elt)))) (ert-deftest list-utils-insert-before-06 nil (should (equal (cl-list* 1 'elt 2) (list-utils-insert-before (cons 1 2) 2 'elt)))) (ert-deftest list-utils-insert-before-07 nil (should (equal (cl-list* 1 'elt 2 3) (list-utils-insert-before (cl-list* 1 2 3) 2 'elt)))) (ert-deftest list-utils-insert-before-08 nil (should (equal (cl-list* 1 2 'elt 3) (list-utils-insert-before (cl-list* 1 2 3) 3 'elt)))) (ert-deftest list-utils-insert-before-09 nil "set TEST" (let ((debug-on-error nil)) (should-error (list-utils-insert-before '(1 2.0 3 4 5) 2 'elt))) (should (equal '(1 elt 2.0 3 4 5) (list-utils-insert-before '(1 2.0 3 4 5) 2 'elt '=)))) ;;; list-utils-insert-after (ert-deftest list-utils-insert-after-01 nil (should (equal '(1 2 3 4 four 5) (list-utils-insert-after '(1 2 3 4 5) 4 'four)))) (ert-deftest list-utils-insert-after-02 nil (should (equal '(1 elt 2 3 4 5) (list-utils-insert-after '(1 2 3 4 5) 1 'elt)))) (ert-deftest list-utils-insert-after-03 nil (should (equal '(1 2 3 4 5 elt) (list-utils-insert-after '(1 2 3 4 5) 5 'elt)))) (ert-deftest list-utils-insert-after-04 nil (let ((debug-on-error nil)) (should-error (list-utils-insert-after '(1 2 3 4 5) 6 'elt)))) (ert-deftest list-utils-insert-after-05 nil (should (equal (cl-list* 1 'elt 2) (list-utils-insert-after (cons 1 2) 1 'elt)))) (ert-deftest list-utils-insert-after-06 nil (should (equal (cl-list* 1 2 'elt) (list-utils-insert-after (cons 1 2) 2 'elt)))) (ert-deftest list-utils-insert-after-07 nil (should (equal (cl-list* 1 2 'elt 3) (list-utils-insert-after (cl-list* 1 2 3) 2 'elt)))) (ert-deftest list-utils-insert-after-08 nil (should (equal (cl-list* 1 2 3 'elt) (list-utils-insert-after (cl-list* 1 2 3) 3 'elt)))) (ert-deftest list-utils-insert-after-09 nil "set TEST" (let ((debug-on-error nil)) (should-error (list-utils-insert-after '(1 2.0 3 4 5) 2 'elt))) (should (equal '(1 2.0 elt 3 4 5) (list-utils-insert-after '(1 2.0 3 4 5) 2 'elt '=)))) ;;; list-utils-insert-before-pos (ert-deftest list-utils-insert-before-pos-01 nil (should (equal '(a b c three d e) (list-utils-insert-before-pos '(a b c d e) 3 'three)))) (ert-deftest list-utils-insert-before-pos-02 nil (should (equal '(elt a b c d e) (list-utils-insert-before-pos '(a b c d e) 0 'elt)))) (ert-deftest list-utils-insert-before-pos-03 nil (should (equal '(a b c d elt e) (list-utils-insert-before-pos '(a b c d e) 4 'elt)))) (ert-deftest list-utils-insert-before-pos-04 nil (let ((debug-on-error nil)) (should-error (list-utils-insert-before-pos '(a b c d e) 5 'elt)))) (ert-deftest list-utils-insert-before-pos-05 nil (should (equal (cl-list* 'elt 1 2) (list-utils-insert-before-pos (cons 1 2) 0 'elt)))) (ert-deftest list-utils-insert-before-pos-06 nil (should (equal (cl-list* 1 'elt 2) (list-utils-insert-before-pos (cons 1 2) 1 'elt)))) (ert-deftest list-utils-insert-before-pos-07 nil (let ((debug-on-error nil)) (should-error (list-utils-insert-before-pos (cons 1 2) 2 'elt)))) (ert-deftest list-utils-insert-before-pos-08 nil (should (equal (cl-list* 1 'elt 2 3) (list-utils-insert-before-pos (cl-list* 1 2 3) 1 'elt)))) (ert-deftest list-utils-insert-before-pos-09 nil (should (equal (cl-list* 1 2 'elt 3) (list-utils-insert-before-pos (cl-list* 1 2 3) 2 'elt)))) (ert-deftest list-utils-insert-before-pos-10 nil (let ((debug-on-error nil)) (should-error (list-utils-insert-before-pos (cl-list* 1 2 3) 3 'elt)))) ;;; list-utils-insert-after-pos (ert-deftest list-utils-insert-after-pos-01 nil (should (equal '(a b c d three e) (list-utils-insert-after-pos '(a b c d e) 3 'three)))) (ert-deftest list-utils-insert-after-pos-02 nil (should (equal '(a elt b c d e) (list-utils-insert-after-pos '(a b c d e) 0 'elt)))) (ert-deftest list-utils-insert-after-pos-03 nil (should (equal '(a b c d e elt) (list-utils-insert-after-pos '(a b c d e) 4 'elt)))) (ert-deftest list-utils-insert-after-pos-04 nil (let ((debug-on-error nil)) (should-error (list-utils-insert-after-pos '(a b c d e) 5 'elt)))) (ert-deftest list-utils-insert-after-pos-05 nil (should (equal (cl-list* 1 'elt 2) (list-utils-insert-after-pos (cons 1 2) 0 'elt)))) (ert-deftest list-utils-insert-after-pos-06 nil (should (equal (cl-list* 1 2 'elt) (list-utils-insert-after-pos (cons 1 2) 1 'elt)))) (ert-deftest list-utils-insert-after-pos-07 nil (let ((debug-on-error nil)) (should-error (list-utils-insert-after-pos (cons 1 2) 2 'elt)))) (ert-deftest list-utils-insert-after-pos-08 nil (should (equal (cl-list* 1 2 'elt 3) (list-utils-insert-after-pos (cl-list* 1 2 3) 1 'elt)))) (ert-deftest list-utils-insert-after-pos-09 nil (should (equal (cl-list* 1 2 3 'elt) (list-utils-insert-after-pos (cl-list* 1 2 3) 2 'elt)))) (ert-deftest list-utils-insert-after-pos-10 nil (let ((debug-on-error nil)) (should-error (list-utils-insert-after-pos (cl-list* 1 2 3) 3 'elt)))) ;;; list-utils-and (ert-deftest list-utils-and-01 nil "Logical AND operation on two lists" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(a a 1 2 3 3 3) (list-utils-and list-1 list-2))))) (ert-deftest list-utils-and-02 nil "Logical AND operation with size hint, should be identical" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal (list-utils-and list-1 list-2) (list-utils-and list-1 list-2 nil 17))))) (ert-deftest list-utils-and-03 nil "Logical AND operation with FLIP param" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(a 1 2 3) (list-utils-and list-1 list-2 nil nil 'flip))))) (ert-deftest list-utils-and-04 nil "Logical AND operation with FLIP param should be the same as reversing order of list args" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal (list-utils-and list-2 list-1) (list-utils-and list-1 list-2 nil nil 'flip))))) (ert-deftest list-utils-and-05 nil "Logical AND operation with numeric hash-table-test" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(a a 1 2 3 3 3 4.0) (list-utils-and list-1 list-2 'list-utils-htt-=))))) (ert-deftest list-utils-and-06 nil "Logical AND operation with numeric hash-table-test and FLIP param" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(a 1 2 3 4) (list-utils-and list-1 list-2 'list-utils-htt-= nil 'flip))))) (ert-deftest list-utils-and-07 nil "Logical AND operation with case-insensitive hash-table-test" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(A a a 1 2 3 3 3) (list-utils-and list-1 list-2 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-and-08 nil "Logical AND operation with case-insensitive hash-table-test and FLIP param" (let ((list-1 '(A 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) ; note different list-1 (list-2 '(a b c d 1 2 3 4))) (should (equal '(a 1 2 3) ; element a is still present (list-utils-and list-1 list-2 'list-utils-htt-case-fold-equal nil 'flip))))) (ert-deftest list-utils-and-09 nil "Logical AND operation should be identical to `cl-intersection' after sort/uniq" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal (sort (list-utils-uniq (cl-intersection list-1 list-2)) 'list-utils-test-soft-string-lessp) (sort (list-utils-uniq (list-utils-and list-1 list-2)) 'list-utils-test-soft-string-lessp))))) (ert-deftest list-utils-and-10 nil "Logical AND operation with two large lists" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (number-sequence 4 10000) (list-utils-and list-1 list-2))))) (ert-deftest list-utils-and-11 nil "Logical AND operation with large lists and size hint, should be identical" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (list-utils-and list-1 list-2) (list-utils-and list-1 list-2 nil 10000))))) (ert-deftest list-utils-and-12 nil "Logical AND operation with large lists and FLIP param" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (reverse (number-sequence 4 10000)) (list-utils-and list-1 list-2 nil nil 'flip))))) (ert-deftest list-utils-and-13 nil "Logical AND operation with large lists and FLIP param should be the same as reversing order of list args" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (list-utils-and list-2 list-1) (list-utils-and list-1 list-2 nil nil 'flip))))) (ert-deftest list-utils-and-14 nil "Logical AND operation with large lists and numeric hash-table-test" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (mapcar 'float (number-sequence 4 10009))))) (should (equal (number-sequence 4 10000) (list-utils-and list-1 list-2 'list-utils-htt-=))))) (ert-deftest list-utils-and-15 nil "Logical AND operation with large lists and case-insensitive hash-table-test" (let ((list-1 (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (number-sequence 1 10000))) (list-2 (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (reverse (number-sequence 4 10009))))) (should (equal (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (number-sequence 4 10000)) (list-utils-and list-1 list-2 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-and-16 nil "Logical AND operation with large lists should be identical to `cl-intersection' after sort/uniq" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (sort (list-utils-uniq (cl-intersection list-1 list-2)) 'list-utils-test-soft-string-lessp) (sort (list-utils-uniq (list-utils-and list-1 list-2)) 'list-utils-test-soft-string-lessp))))) ;;; list-utils-not (ert-deftest list-utils-not-01 nil "Logical NOT operation on two lists" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(A 8 8 4.0 5 6 7 9 9 5) (list-utils-not list-1 list-2))))) (ert-deftest list-utils-not-02 nil "Logical NOT operation with size hint, should be identical" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal (list-utils-not list-1 list-2) (list-utils-not list-1 list-2 nil 17))))) (ert-deftest list-utils-not-03 nil "Logical NOT operation with FLIP param" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(b c d 4) (list-utils-not list-1 list-2 nil nil 'flip))))) (ert-deftest list-utils-not-04 nil "Logical NOT operation with FLIP param should be the same as reversing order of list args" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal (list-utils-not list-2 list-1) (list-utils-not list-1 list-2 nil nil 'flip))))) (ert-deftest list-utils-not-05 nil "Logical NOT operation with numeric hash-table-test" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(A 8 8 5 6 7 9 9 5) ; no element 4.0 (list-utils-not list-1 list-2 'list-utils-htt-=))))) (ert-deftest list-utils-not-06 nil "Logical NOT operation with numeric hash-table-test and FLIP param" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(b c d) ; no element 4 (list-utils-not list-1 list-2 'list-utils-htt-= nil 'flip))))) (ert-deftest list-utils-not-07 nil "Logical NOT operation with case-insensitive hash-table-test" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(8 8 4.0 5 6 7 9 9 5) ; no element A (list-utils-not list-1 list-2 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-not-08 nil "Logical NOT operation with case-insensitive hash-table-test and FLIP param" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(b c d 4) (list-utils-not list-1 list-2 'list-utils-htt-case-fold-equal nil 'flip))))) (ert-deftest list-utils-not-09 nil "Logical NOT operation should be identical to `cl-set-difference' after sort/uniq" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal (sort (list-utils-uniq (cl-set-difference list-1 list-2)) 'list-utils-test-soft-string-lessp) (sort (list-utils-uniq (list-utils-not list-1 list-2)) 'list-utils-test-soft-string-lessp))))) (ert-deftest list-utils-not-10 nil "Logical NOT operation with two large lists" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (number-sequence 1 3) (list-utils-not list-1 list-2))))) (ert-deftest list-utils-not-11 nil "Logical NOT operation with large lists and size hint, should be identical" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (list-utils-not list-1 list-2) (list-utils-not list-1 list-2 nil 10000))))) (ert-deftest list-utils-not-12 nil "Logical NOT operation with large lists and FLIP param" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (reverse (number-sequence 10001 10009)) (list-utils-not list-1 list-2 nil nil 'flip))))) (ert-deftest list-utils-not-13 nil "Logical NOT operation with large lists and FLIP param should be the same as reversing order of list args" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (list-utils-not list-2 list-1) (list-utils-not list-1 list-2 nil nil 'flip))))) (ert-deftest list-utils-not-14 nil "Logical NOT operation with large lists and numeric hash-table-test" (let ((list-1 (number-sequence 1 10000)) (list-2 (mapcar 'float (reverse (number-sequence 4 10009))))) (should (equal (number-sequence 1 3) (list-utils-not list-1 list-2 'list-utils-htt-=))))) (ert-deftest list-utils-not-15 nil "Logical NOT operation with large lists and case-insensitive hash-table-test" (let ((list-1 (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (number-sequence 1 10000))) (list-2 (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (reverse (number-sequence 4 10009))))) (should (equal (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (number-sequence 1 3)) (list-utils-not list-1 list-2 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-not-16 nil "Logical NOT operation with large lists should be identical to `cl-set-difference' after sort/uniq" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (sort (list-utils-uniq (cl-set-difference list-1 list-2)) 'list-utils-test-soft-string-lessp) (sort (list-utils-uniq (list-utils-not list-1 list-2)) 'list-utils-test-soft-string-lessp))))) ;;; list-utils-xor (ert-deftest list-utils-xor-01 nil "Logical XOR operation on two lists" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(A 8 8 4.0 5 6 7 9 9 5 b c d 4) (list-utils-xor list-1 list-2))))) (ert-deftest list-utils-xor-02 nil "Logical XOR operation with size hint, should be identical" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal (list-utils-xor list-1 list-2) (list-utils-xor list-1 list-2 nil 17))))) (ert-deftest list-utils-xor-03 nil "Logical XOR operation with FLIP param" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(b c d 4 A 8 8 4.0 5 6 7 9 9 5) (list-utils-xor list-1 list-2 nil nil 'flip))))) (ert-deftest list-utils-xor-04 nil "Logical XOR operation with FLIP param should be the same as reversing order of list args" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal (list-utils-xor list-2 list-1) (list-utils-xor list-1 list-2 nil nil 'flip))))) (ert-deftest list-utils-xor-05 nil "Logical XOR operation with numeric hash-table-test" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(A 8 8 5 6 7 9 9 5 b c d) ; no element 4 (list-utils-xor list-1 list-2 'list-utils-htt-=))))) (ert-deftest list-utils-xor-06 nil "Logical XOR operation with numeric hash-table-test and FLIP param" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(b c d A 8 8 5 6 7 9 9 5) ; no element 4 (list-utils-xor list-1 list-2 'list-utils-htt-= nil 'flip))))) (ert-deftest list-utils-xor-07 nil "Logical XOR operation with case-insensitive hash-table-test" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(8 8 4.0 5 6 7 9 9 5 b c d 4) (list-utils-xor list-1 list-2 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-xor-08 nil "Logical XOR operation with case-insensitive hash-table-test and FLIP param" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal '(b c d 4 8 8 4.0 5 6 7 9 9 5) (list-utils-xor list-1 list-2 'list-utils-htt-case-fold-equal nil 'flip))))) (ert-deftest list-utils-xor-09 nil "Logical XOR operation should be identical to `cl-set-exclusive-or' after sort/uniq" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal (sort (list-utils-uniq (cl-set-exclusive-or list-1 list-2)) 'list-utils-test-soft-string-lessp) (sort (list-utils-uniq (list-utils-xor list-1 list-2)) 'list-utils-test-soft-string-lessp))))) (ert-deftest list-utils-xor-10 nil "Logical XOR operation should be identical to itself with FLIP param after sort/uniq" (let ((list-1 '(A a a 8 8 1 2 3 3 3 4.0 5 6 7 9 9 5)) (list-2 '(a b c d 1 2 3 4))) (should (equal (sort (list-utils-uniq (list-utils-xor list-2 list-1)) 'list-utils-test-soft-string-lessp) (sort (list-utils-uniq (list-utils-xor list-1 list-2)) 'list-utils-test-soft-string-lessp))))) (ert-deftest list-utils-xor-11 nil "Logical XOR operation with two large lists" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (append (number-sequence 1 3) (reverse (number-sequence 10001 10009))) (list-utils-xor list-1 list-2))))) (ert-deftest list-utils-xor-12 nil "Logical XOR operation with large lists and size hint, should be identical" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (list-utils-xor list-1 list-2) (list-utils-xor list-1 list-2 nil 10000))))) (ert-deftest list-utils-xor-13 nil "Logical XOR operation with large lists and FLIP param" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (append (reverse (number-sequence 10001 10009)) (number-sequence 1 3)) (list-utils-xor list-1 list-2 nil nil 'flip))))) (ert-deftest list-utils-xor-14 nil "Logical XOR operation with large lists and FLIP param should be the same as reversing order of list args" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (list-utils-xor list-2 list-1) (list-utils-xor list-1 list-2 nil nil 'flip))))) (ert-deftest list-utils-xor-15 nil "Logical XOR operation with large lists and numeric hash-table-test" (let ((list-1 (number-sequence 1 10000)) (list-2 (mapcar 'float (reverse (number-sequence 4 10009))))) (should (equal (append (number-sequence 1 3) (mapcar 'float (reverse (number-sequence 10001 10009)))) (list-utils-xor list-1 list-2 'list-utils-htt-=))))) ;; todo: use characters relevant to case-insensitivity (ert-deftest list-utils-xor-16 nil "Logical XOR operation with large lists and case-insensitive hash-table-test" (let ((list-1 (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (number-sequence 1 10))) (list-2 (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (reverse (number-sequence 4 19))))) (should (equal (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (append (number-sequence 1 3) (reverse (number-sequence 11 19)))) (list-utils-xor list-1 list-2 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-xor-17 nil "Logical XOR operation with large lists should be identical to `cl-set-exclusive-or' after sort/uniq" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (sort (list-utils-uniq (cl-set-exclusive-or list-1 list-2)) 'list-utils-test-soft-string-lessp) (sort (list-utils-uniq (list-utils-xor list-1 list-2)) 'list-utils-test-soft-string-lessp))))) (ert-deftest list-utils-xor-18 nil "Logical XOR operation with large lists should be identical to reverse-XOR-operation after sort/uniq" (let ((list-1 (number-sequence 1 10000)) (list-2 (reverse (number-sequence 4 10009)))) (should (equal (sort (list-utils-uniq (list-utils-xor list-2 list-1)) 'list-utils-test-soft-string-lessp) (sort (list-utils-uniq (list-utils-xor list-1 list-2)) 'list-utils-test-soft-string-lessp))))) ;;; list-utils-uniq (ert-deftest list-utils-uniq-01 nil "UNIQ operation on a list" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal '(A a 8 1 2 4 3 4.0 5 6 7 9) (list-utils-uniq list))))) (ert-deftest list-utils-uniq-02 nil "UNIQ operation with size hint, should be identical" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal (list-utils-uniq list) (list-utils-uniq list nil 17))))) (ert-deftest list-utils-uniq-03 nil "UNIQ operation with numeric hash-table-test" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal '(A a 8 1 2 4 3 5 6 7 9) ; no element 4.0 (list-utils-uniq list 'list-utils-htt-=))))) (ert-deftest list-utils-uniq-04 nil "UNIQ operation with case-insensitive hash-table-test" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal '(A 8 1 2 4 3 4.0 5 6 7 9) ; no element a (list-utils-uniq list 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-uniq-05 nil "UNIQ operation should be identical to `cl-remove-duplicates' after sort" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal (sort (cl-remove-duplicates list) 'list-utils-test-soft-string-lessp) (sort (list-utils-uniq list) 'list-utils-test-soft-string-lessp))))) (ert-deftest list-utils-uniq-06 nil "UNIQ operation with a large list" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (append (number-sequence 1 10000) (reverse (number-sequence 10001 10009))) (list-utils-uniq list))))) (ert-deftest list-utils-uniq-07 nil "UNIQ operation with large list and size hint, should be identical" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (list-utils-uniq list) (list-utils-uniq list nil 10000))))) (ert-deftest list-utils-uniq-08 nil "UNIQ operation with large list and numeric hash-table-test" (let ((list (append (number-sequence 1 10000) (mapcar 'float (reverse (number-sequence 4 10009)))))) (should (equal (append (number-sequence 1 10000) (mapcar 'float (reverse (number-sequence 10001 10009)))) (list-utils-uniq list 'list-utils-htt-=))))) ;; @@@ Todo: figure out what is really the expected result, when casefolding ;; across so many characters/languages. That's a complex task, but can ;; be defined against the results of some other runtime. The result from ;; Emacs is only 1674 chars, which seems quite low. In any case, no ;; case-folding was applied against the test target set, so in principle ;; this should not be expected to pass. (ert-deftest list-utils-uniq-09 nil "UNIQ operation with large list and case-insensitive hash-table-test" :expected-result :failed (let ((list (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (append (number-sequence 1 10000) (reverse (number-sequence 4 10009)))))) (should (equal (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (append (number-sequence 1 10000) (reverse (number-sequence 10001 10009)))) (list-utils-uniq list 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-uniq-10 nil "UNIQ operation with large list should be identical to `cl-remove-duplicates' after sort" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (sort (cl-remove-duplicates list) 'list-utils-test-soft-string-lessp) (sort (list-utils-uniq list) 'list-utils-test-soft-string-lessp))))) ;;; list-utils-dupes (ert-deftest list-utils-dupes-01 nil "DUPES operation on a list" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal '(a a 8 8 3 3 3 5 9 9 5) (list-utils-dupes list))))) (ert-deftest list-utils-dupes-02 nil "DUPES operation with size hint, should be identical" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal (list-utils-dupes list) (list-utils-dupes list nil 17))))) (ert-deftest list-utils-dupes-03 nil "DUPES operation with numeric hash-table-test" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal '(a a 8 8 4 3 3 3 4.0 5 9 9 5) ; elements 4 / 4.0 present (list-utils-dupes list 'list-utils-htt-=))))) (ert-deftest list-utils-dupes-04 nil "DUPES operation with case-insensitive hash-table-test" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal '(A a a 8 8 3 3 3 5 9 9 5) ; element A present (list-utils-dupes list 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-dupes-05 nil "DUPES operation should be identical to result composed of other list operations" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal (list-utils-and list (list-utils-singlets (append (list-utils-singlets list) (cl-remove-duplicates list)))) (list-utils-dupes list))))) (ert-deftest list-utils-dupes-06 nil "DUPES operation with a large list" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (append (number-sequence 4 10000) (reverse (number-sequence 4 10000))) (list-utils-dupes list))))) (ert-deftest list-utils-dupes-07 nil "DUPES operation with large list and size hint, should be identical" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (list-utils-dupes list) (list-utils-dupes list nil 10000))))) (ert-deftest list-utils-dupes-08 nil "DUPES operation with large list and numeric hash-table-test" (let ((list (append (number-sequence 1 10000) (mapcar 'float (reverse (number-sequence 4 10009)))))) (should (equal (append (number-sequence 4 10000) (mapcar 'float (reverse (number-sequence 4 10000)))) (list-utils-dupes list 'list-utils-htt-=))))) ;; todo: use characters relevant to case-insensitivity (ert-deftest list-utils-dupes-09 nil "DUPES operation with large list and case-insensitive hash-table-test" (let ((list (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (append (number-sequence 1 10000) (reverse (number-sequence 4 10000)))))) (should (equal (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (append (number-sequence 4 10000) (reverse (number-sequence 4 10000)))) (list-utils-dupes list 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-dupes-10 nil "DUPES operation with large list should be identical to result composed of other list operations" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (list-utils-and list (list-utils-singlets (append (list-utils-singlets list) (cl-remove-duplicates list)))) (list-utils-dupes list))))) ;;; list-utils-singlets (ert-deftest list-utils-singlets-01 nil "SINGLETS operation on a list" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal '(A 1 2 4 4.0 6 7) (list-utils-singlets list))))) (ert-deftest list-utils-singlets-02 nil "SINGLETS operation with size hint, should be identical" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal (list-utils-singlets list) (list-utils-singlets list nil 17))))) (ert-deftest list-utils-singlets-03 nil "SINGLETS operation with numeric hash-table-test" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal '(A 1 2 6 7) ; no elements 4 4.0 (list-utils-singlets list 'list-utils-htt-=))))) (ert-deftest list-utils-singlets-04 nil "SINGLETS operation with case-insensitive hash-table-test" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal '(1 2 4 4.0 6 7) ; no elements A a (list-utils-singlets list 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-singlets-05 nil "SINGLETS operation should be identical to result composed of other list operations" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal (list-utils-not list (list-utils-dupes list)) (list-utils-singlets list))))) (ert-deftest list-utils-singlets-06 nil "SINGLETS operation with a large list" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (append (number-sequence 1 3) (reverse (number-sequence 10001 10009))) (list-utils-singlets list))))) (ert-deftest list-utils-singlets-07 nil "SINGLETS operation with large list and size hint, should be identical" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (list-utils-singlets list) (list-utils-singlets list nil 10000))))) (ert-deftest list-utils-singlets-08 nil "SINGLETS operation with large list and numeric hash-table-test" (let ((list (append (number-sequence 1 10000) (mapcar 'float (reverse (number-sequence 4 10009)))))) (should (equal (append (number-sequence 1 3) (mapcar 'float (reverse (number-sequence 10001 10009)))) (list-utils-singlets list 'list-utils-htt-=))))) ;; todo: use characters relevant to case-insensitivity (ert-deftest list-utils-singlets-09 nil "SINGLETS operation with large list and case-insensitive hash-table-test" (let ((list (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (append (number-sequence 1 10000) (reverse (number-sequence 4 10000)))))) (should (equal (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (append (number-sequence 1 3))) (list-utils-singlets list 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-singlets-10 nil "SINGLETS operation with large list should be identical to result composed of other list operations" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (list-utils-not list (list-utils-dupes list)) (list-utils-singlets list))))) ;;; list-utils-partition-dupes (ert-deftest list-utils-partition-dupes-01 nil "PARTITION DUPES operation on a list" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal '((dupes . (a a 8 8 3 3 3 5 9 9 5)) (singlets . (A 1 2 4 4.0 6 7))) (list-utils-partition-dupes list))))) (ert-deftest list-utils-partition-dupes-02 nil "PARTITION DUPES operation with size hint, should be identical" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal (list-utils-partition-dupes list) (list-utils-partition-dupes list nil 17))))) (ert-deftest list-utils-partition-dupes-03 nil "PARTITION DUPES operation with numeric hash-table-test" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal '((dupes . (a a 8 8 4 3 3 3 4.0 5 9 9 5)) ; elements 4 4.0 now in dupes (singlets . (A 1 2 6 7))) (list-utils-partition-dupes list 'list-utils-htt-=))))) (ert-deftest list-utils-partition-dupes-04 nil "PARTITION DUPES operation with case-insensitive hash-table-test" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal '((dupes . (A a a 8 8 3 3 3 5 9 9 5)) ; elements A a now in dupes (singlets . (1 2 4 4.0 6 7))) (list-utils-partition-dupes list 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-partition-dupes-05 nil "PARTITION DUPES operation should be identical to result composed of other list operations" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal (list (cons 'dupes (list-utils-dupes list)) (cons 'singlets (list-utils-singlets list))) (list-utils-partition-dupes list))))) (ert-deftest list-utils-partition-dupes-06 nil "PARTITION DUPES operation should not remove any values" (let ((list '(A a a 8 8 1 2 4 3 3 3 4.0 5 6 7 9 9 5))) (should (equal (sort (copy-sequence list) 'list-utils-test-soft-string-lessp) (sort (apply 'append (mapcar 'cdr (list-utils-partition-dupes list))) 'list-utils-test-soft-string-lessp))))) (ert-deftest list-utils-partition-dupes-07 nil "PARTITION DUPES operation with a large list" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (list (cons 'dupes (append (number-sequence 4 10000) (reverse (number-sequence 4 10000)))) (cons 'singlets (append (number-sequence 1 3) (reverse (number-sequence 10001 10009))))) (list-utils-partition-dupes list))))) (ert-deftest list-utils-partition-dupes-08 nil "PARTITION DUPES operation with large list and size hint, should be identical" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (list-utils-partition-dupes list) (list-utils-partition-dupes list nil 10000))))) (ert-deftest list-utils-partition-dupes-09 nil "PARTITION DUPES operation with large list and numeric hash-table-test" (let ((list (append (number-sequence 1 10000) (mapcar 'float (reverse (number-sequence 4 10009)))))) (should (equal (list (cons 'dupes (append (number-sequence 4 10000) (mapcar 'float (reverse (number-sequence 4 10000))))) (cons 'singlets (append (number-sequence 1 3) (mapcar 'float (reverse (number-sequence 10001 10009)))))) (list-utils-partition-dupes list 'list-utils-htt-=))))) ;; todo: use characters relevant to case-insensitivity (ert-deftest list-utils-partition-dupes-10 nil "PARTITION DUPES operation with large list and case-insensitive hash-table-test" (let ((list (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (append (number-sequence 1 10) (reverse (number-sequence 4 19)))))) (should (equal (list (cons 'dupes (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (append (number-sequence 4 10) (reverse (number-sequence 4 10))))) (cons 'singlets (mapcar #'(lambda (x) (char-to-string (decode-char 'ucs x))) (append (number-sequence 1 3) (reverse (number-sequence 11 19)))))) (list-utils-partition-dupes list 'list-utils-htt-case-fold-equal))))) (ert-deftest list-utils-partition-dupes-11 nil "PARTITION DUPES operation with large list should be identical to result composed of other list operations" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (list (cons 'dupes (list-utils-dupes list)) (cons 'singlets (list-utils-singlets list))) (list-utils-partition-dupes list))))) (ert-deftest list-utils-partition-dupes-12 nil "PARTITION DUPES operation with large list should not remove any values" (let ((list (append (number-sequence 1 10000) (reverse (number-sequence 4 10009))))) (should (equal (sort (copy-sequence list) '<) (sort (apply 'append (mapcar 'cdr (list-utils-partition-dupes list))) '<))))) ;;; list-utils-plist-reverse (ert-deftest list-utils-plist-reverse-01 nil (should (equal '(:four 4 :three 3 :two 2 :one 1) (list-utils-plist-reverse '(:one 1 :two 2 :three 3 :four 4))))) (ert-deftest list-utils-plist-reverse-02 nil (let ((debug-on-error nil)) (should-error (list-utils-plist-reverse '(:one 1 :two 2 :three 3 :four))))) (ert-deftest list-utils-plist-reverse-03 nil (should (equal '(:four 4 :three 3 :two 2 :one (1 (1 (1)))) (list-utils-plist-reverse '(:one (1 (1 (1))) :two 2 :three 3 :four 4))))) ;;; list-utils-plist-del (ert-deftest list-utils-plist-del-01 nil (should (equal '(:one 1 :two 2 :three 3 :four 4) (list-utils-plist-del '(:one 1 :two 2 :three 3 :four 4) :six)))) (ert-deftest list-utils-plist-del-02 nil (should (equal '(:one 1 :two 2 :three 3 :four 4) (list-utils-plist-del '(:one 1 :two 2 :three 3 :four 4) 4)))) (ert-deftest list-utils-plist-del-03 nil (should (equal '(:one 1 :two 2 :three 3 :four 4) (list-utils-plist-del '(:one 1 :two 2 :three 3 :four 4) 2)))) (ert-deftest list-utils-plist-del-04 nil (should (equal '(:one 1 :three 3 :four 4) (list-utils-plist-del '(:one 1 :two 2 :three 3 :four 4) :two)))) (ert-deftest list-utils-plist-del-05 nil (should (equal '(:two 2 :three 3 :four 4) (list-utils-plist-del '(:one 1 :two 2 :three 3 :four 4) :one)))) (ert-deftest list-utils-plist-del-06 nil (should (equal '(:one 1 :two 2 :three 3) (list-utils-plist-del '(:one 1 :two 2 :three 3 :four 4) :four)))) ;; ;; Emacs ;; ;; Local Variables: ;; indent-tabs-mode: nil ;; mangle-whitespace: t ;; require-final-newline: t ;; coding: utf-8 ;; byte-compile-warnings: (not cl-functions) ;; End: ;; ;;; list-utils-test.el ends here rolandwalker-list-utils-cd0ec9b/list-utils.el000066400000000000000000001127101471273506700215320ustar00rootroot00000000000000;;; list-utils.el --- List-manipulation utility functions ;; ;; Copyright (c) 2012-2024 Roland Walker ;; ;; Author: Roland Walker ;; Homepage: http://github.com/rolandwalker/list-utils ;; URL: http://raw.githubusercontent.com/rolandwalker/list-utils/master/list-utils.el ;; Version: 0.4.7 ;; Last-Updated: 6 Nov 2024 ;; EmacsWiki: ListUtils ;; Keywords: extensions ;; ;; Simplified BSD License ;; ;;; Commentary: ;; ;; Quickstart ;; ;; (require 'list-utils) ;; ;; (list-utils-flatten '(1 2 (3 4 (5 6 7)))) ;; ;; '(1 2 3 4 5 6 7) ;; ;; (list-utils-depth '(1 2 (3 4 (5 6 7)))) ;; ;; 3 ;; ;; (let ((cyclic-list '(1 2 3 4 5 6 7))) ;; (nconc cyclic-list (cdr cyclic-list)) ;; (list-utils-make-linear-inplace cyclic-list)) ;; ;; '(1 2 3 4 5 6 7) ;; ;; (list-utils-cyclic-p '(1 2 3)) ;; ;; nil ;; ;; (list-utils-plist-del '(:one 1 :two 2 :three 3) :two) ;; ;; '(:one 1 :three 3) ;; ;; Explanation ;; ;; List-utils is a collection of functions for list manipulation. ;; This library has no user-level interface; it is only useful ;; for programming in Emacs Lisp. ;; ;; Notable functionality includes ;; ;; * `list-utils-flatten', a robust list-flattener which handles ;; cyclic lists, non-nil-terminated lists, and preserves nils ;; when they are found as list elements. ;; ;; * `tconc', a simple data structure for efficiently appending ;; to a list ;; ;; The following functions are provided: ;; ;; `make-tconc' ;; `tconc-p' ;; `tconc-list' ;; `tconc' ;; `list-utils-cons-cell-p' ;; `list-utils-cyclic-length' ;; `list-utils-improper-p' ;; `list-utils-make-proper-copy' ;; `list-utils-make-proper-inplace' ;; `list-utils-make-improper-copy' ;; `list-utils-make-improper-inplace' ;; `list-utils-linear-p' ;; `list-utils-linear-subseq' ;; `list-utils-cyclic-p' ;; `list-utils-cyclic-subseq' ;; `list-utils-make-linear-copy' ;; `list-utils-make-linear-inplace' ;; `list-utils-safe-length' ;; `list-utils-safe-equal' ;; `list-utils-depth' ;; `list-utils-flat-length' ;; `list-utils-flatten' ;; `list-utils-alist-or-flat-length' ;; `list-utils-alist-flatten' ;; `list-utils-insert-before' ;; `list-utils-insert-after' ;; `list-utils-insert-before-pos' ;; `list-utils-insert-after-pos' ;; `list-utils-and' ;; `list-utils-not' ;; `list-utils-xor' ;; `list-utils-uniq' ;; `list-utils-dupes' ;; `list-utils-singlets' ;; `list-utils-partition-dupes' ;; `list-utils-plist-reverse' ;; `list-utils-plist-del' ;; ;; To use list-utils, place the list-utils.el library somewhere ;; Emacs can find it, and add the following to your ~/.emacs file: ;; ;; (require 'list-utils) ;; ;; Notes ;; ;; This library includes an implementation of the classic Lisp ;; `tconc' which is outside the "list-utils-" namespace. ;; ;; Compatibility and Requirements ;; ;; No external dependencies ;; ;; Bugs ;; ;; TODO ;; ;; @@@ spin out hash-table tests into separate library ;; ;; test cyclic inputs to all ;; test improper inputs to all ;; test single-element lists as inputs to all ;; test cyclic single-element lists as inputs to all ;; ;; should list-utils-make-improper-inplace accept nil as a special case? ;; ;; could do -copy/-inplace variants for more functions, consider doing ;; so for flatten ;; ;; cl-list* returns a non-list on single elt, our function throws an error ;; ;;; License ;; ;; Simplified BSD License: ;; ;; Redistribution and use in source and binary forms, with or ;; without modification, are permitted provided that the following ;; conditions are met: ;; ;; 1. Redistributions of source code must retain the above ;; copyright notice, this list of conditions and the following ;; disclaimer. ;; ;; 2. Redistributions in binary form must reproduce the above ;; copyright notice, this list of conditions and the following ;; disclaimer in the documentation and/or other materials ;; provided with the distribution. ;; ;; This software is provided by Roland Walker "AS IS" and any express ;; or implied warranties, including, but not limited to, the implied ;; warranties of merchantability and fitness for a particular ;; purpose are disclaimed. In no event shall Roland Walker or ;; contributors be liable for any direct, indirect, incidental, ;; special, exemplary, or consequential damages (including, but not ;; limited to, procurement of substitute goods or services; loss of ;; use, data, or profits; or business interruption) however caused ;; and on any theory of liability, whether in contract, strict ;; liability, or tort (including negligence or otherwise) arising in ;; any way out of the use of this software, even if advised of the ;; possibility of such damage. ;; ;; The views and conclusions contained in the software and ;; documentation are those of the authors and should not be ;; interpreted as representing official policies, either expressed ;; or implied, of Roland Walker. ;; ;;; Code: ;; ;;; requirements ;; for cl-defstruct, cl-assert, cl-setf, cl-callf, cl-loop (require 'cl-lib) ;;; declarations (declare-function list-utils-cyclic-length "list-utils.el") (declare-function string-utils-compress-whitespace "string-utils.el") ;;;###autoload (defgroup list-utils nil "List-manipulation utility functions." :version "0.4.7" :link '(emacs-commentary-link :tag "Commentary" "list-utils") :link '(url-link :tag "GitHub" "http://github.com/rolandwalker/list-utils") :link '(url-link :tag "EmacsWiki" "http://emacswiki.org/emacs/ListUtils") :prefix "list-utils-" :group 'extensions) ;;; compatibility functions (unless (fboundp 'string-utils-compress-whitespace) (defvar string-utils-whitespace (concat (apply 'vector (delq nil (mapcar #'(lambda (x) (decode-char 'ucs x)) '(#x00009 #x0000a #x0000b #x0000c #x0000d #x00020 #x00085 #x00088 #x00089 #x0008a #x000a0 #x01680 #x0180e #x02000 #x02001 #x02002 #x02003 #x02004 #x02005 #x02006 #x02007 #x02008 #x02009 #x0200a #x0200b #x02028 #x02029 #x0202f #x0205f #x02060 #x03000 #x0feff #xe0020))))) "Definition of whitespace characters used by string-utils. Includes Unicode whitespace characters.") ;; simplified version of function from string-utils (defun string-utils-compress-whitespace (str-val &optional whitespace-type separator) "Return STR-VAL with all contiguous whitespace compressed to a single space. WHITESPACE-TYPE is ignored. SEPARATOR is the string with which to replace any whitespace." (cl-callf or separator " ") (let ((whitespace-regexp (concat "[" string-utils-whitespace "]"))) (save-match-data (replace-regexp-in-string (concat whitespace-regexp "+") separator str-val))))) ;;; hash-table tests (defun list-utils-htt-= (x y) "A comparison function in which `=' floats and integers are identical. Non-numeric arguments are permitted and will be compared by `equal'. A hash-table-test is defined with the same name." (if (and (numberp x) (numberp y)) (= x y) ;; else (equal x y))) (define-hash-table-test 'list-utils-htt-= 'list-utils-htt-= #'(lambda (x) (sxhash (if (numberp x) (float x) ;; else x)))) (defun list-utils-htt-case-fold-equal (x y) "A string comparison function which ignores case. Non-string arguments are permitted, and will be compared after stringification by `format'. A hash-table-test is defined with the same name." (eq t (compare-strings (if x (format "%s" x) "") nil nil (if y (format "%s" y) "") nil nil 'ignore-case))) (define-hash-table-test 'list-utils-htt-case-fold-equal 'list-utils-htt-case-fold-equal #'(lambda (x) (sxhash (upcase (if x (format "%s" x) ""))))) (defun list-utils-htt-ignore-whitespace-equal (x y) "A string comparison function which ignores whitespace. Non-string arguments are permitted, and will be compared after stringification by `format'. A hash-table-test is defined with the same name." (string-equal (string-utils-compress-whitespace (if x (format "%s" x) "") nil "") (string-utils-compress-whitespace (if y (format "%s" y) "") nil ""))) (define-hash-table-test 'list-utils-htt-ignore-whitespace-equal 'list-utils-htt-ignore-whitespace-equal #'(lambda (x) (sxhash (string-utils-compress-whitespace (if x (format "%s" x) "") nil "")))) ;;; tconc - this section of code is in the public domain ;;;###autoload (progn (require 'cl-macs) (cl-defstruct tconc head tail)) ;;;###autoload (defun tconc-list (tc list) "Efficiently append LIST to TC. TC is a data structure created by `make-tconc'." (cl-assert (tconc-p tc) nil "TC must be created by `make-tconc'.") (when list (if (null (tconc-tail tc)) (setf (tconc-head tc) list) ;; else (setcdr (tconc-tail tc) list)) (setf (tconc-tail tc) (last list))) (tconc-head tc)) ;;;###autoload (defun tconc (tc &rest args) "Efficiently append ARGS to TC. TC is a data structure created by `make-tconc' Without ARGS, return the list held by TC." (tconc-list tc args)) ;;; lists ;;;###autoload (defun list-utils-cons-cell-p (cell) "Return non-nil if CELL holds a cons cell rather than a proper list. A proper list is defined as a series of cons cells in which the cdr slot of each cons holds a pointer to the next element of the list, and the cdr slot in the final cons holds nil. A plain cons cell, for the purpose of this function, is a single cons in which the cdr holds data rather than a pointer to the next cons cell, eg '(1 . 2) In addition, a list which is not nil-terminated is not a proper list and will be recognized by this function as a cons cell. Such a list is printed using dot notation for the last two elements, eg '(1 2 3 4 . 5) Such improper lists are produced by `cl-list*'." (let ((len (safe-length cell))) (when (and (consp cell) (> len 0) (not (listp (nthcdr len cell)))) (nthcdr len cell)))) ;;;###autoload (defun list-utils-make-proper-copy (list &optional tree recur-internal) "Copy a cons cell or improper LIST into a proper list. If optional TREE is non-nil, traverse LIST, making proper copies of any improper lists contained within. Optional RECUR-INTERNAL is for internal use only. Improper lists consist of proper lists consed to a final element, and are produced by `cl-list*'." (cl-assert (or recur-internal (listp list)) nil "LIST is not a list") (cond ((not tree) (let ((tail (list-utils-cons-cell-p list))) (cond (tail (append (cl-subseq list 0 (safe-length list)) (list tail))) (t (copy-sequence list))))) ((consp list) (mapcar #'(lambda (elt) (list-utils-make-proper-copy elt 'tree 'recur)) (list-utils-make-proper-copy list nil 'recur))) (t list))) ;;;###autoload (defun list-utils-make-proper-inplace (list &optional tree recur-internal) "Make a cons cell or improper LIST into a proper list. Improper lists consist of proper lists consed to a final element, and are produced by `cl-list*'. If optional TREE is non-nil, traverse LIST, making any improper lists contained within into proper lists. Optional RECUR-INTERNAL is for internal use only. Modifies LIST and returns the modified value." (cl-assert (or recur-internal (listp list)) nil "LIST is not a list") (cond ((not tree) (when (list-utils-cons-cell-p list) (cl-callf list (nthcdr (safe-length list) list))) list) ((consp list) (cl-loop for elt in (list-utils-make-proper-inplace list nil 'recur) do (list-utils-make-proper-inplace elt 'tree 'recur)) list) (t list))) (define-obsolete-function-alias 'list-utils-make-proper 'list-utils-make-proper-inplace "v0.4.2") ;;;###autoload (defun list-utils-make-improper-copy (list &optional tree recur-internal) "Copy a proper LIST into an improper list. Improper lists consist of proper lists consed to a final element, and are produced by `cl-list*'. If optional TREE is non-nil, traverse LIST, making proper copies of any improper lists contained within. Optional RECUR-INTERNAL is for internal use only." (cl-assert (or recur-internal (listp list)) nil "LIST is not a list") (cl-assert (or recur-internal (> (safe-length list) 1)) nil "LIST has only one element") (cond ((not tree) (let ((tail (list-utils-cons-cell-p list))) (cond (tail (cl-copy-list list)) (t (apply 'cl-list* list))))) ((and (consp list) (> (safe-length list) 1)) (apply 'cl-list* (mapcar #'(lambda (elt) (list-utils-make-improper-copy elt 'tree 'recur)) (list-utils-make-proper-copy list nil 'recur)))) (t list))) ;;;###autoload (defun list-utils-make-improper-inplace (list &optional tree recur-internal) "Make proper LIST into an improper list. Improper lists consist of proper lists consed to a final element, and are produced by `cl-list*'. If optional TREE is non-nil, traverse LIST, making any proper lists contained within into improper lists. Optional RECUR-INTERNAL is for internal use only. Modifies LIST and returns the modified value." (cl-assert (or recur-internal (listp list)) nil "LIST is not a list") (cl-assert (or recur-internal (> (safe-length list) 1)) nil "LIST has only one element") (cond ((not tree) (unless (list-utils-cons-cell-p list) (setcdr (last list 2) (car (last list)))) list) ((and (consp list) (> (safe-length list) 1)) (cl-loop for elt in (list-utils-make-improper-inplace list nil 'recur) do (list-utils-make-improper-inplace elt 'tree 'recur)) list) (t list))) (define-obsolete-function-alias 'list-utils-make-improper 'list-utils-make-improper-inplace "v0.4.2") ;;;###autoload (defun list-utils-linear-subseq (list &optional cycle-length) "Return the linear elements from a partially cyclic LIST. If there is no cycle in LIST, return LIST. If all elements of LIST are included in a cycle, return nil. As an optimization, CYCLE-LENGTH may be specified if the length of the cyclic portion is already known. Otherwise it will be calculated from LIST." (cl-callf or cycle-length (list-utils-cyclic-length list)) (if (= 0 cycle-length) list ;; else (let ((behind list) (ahead (nthcdr cycle-length list)) (linear-subseq nil)) (catch 'cycle (while behind (when (eq ahead behind) (throw 'cycle t)) (push (car behind) linear-subseq) (setq ahead (cdr ahead)) (setq behind (cdr behind)))) (nreverse linear-subseq)))) ;;;###autoload (defun list-utils-cyclic-subseq (list &optional from-start) "Return any cyclic elements from LIST as a circular list. The first element of the cyclic structure is not guaranteed to be first element of the return value unless FROM-START is non-nil. To linearize the return value, use `list-utils-make-linear-inplace'. If there is no cycle in LIST, return nil." (cond ((list-utils-cons-cell-p list) nil) (from-start (nthcdr (length (list-utils-linear-subseq list)) list)) (t (let ((fast list) (slow list)) (catch 'cycle (while (cdr fast) (setq fast (cdr (cdr fast))) (setq slow (cdr slow)) (when (eq slow fast) (throw 'cycle slow)))))))) ;;;###autoload (defun list-utils-cyclic-length (list) "Return the number of cyclic elements in LIST. If some portion of LIST is linear, only the cyclic elements will be counted. If LIST is completely linear, return 0." (if (list-utils-cons-cell-p list) 0 ;;else (let ((fast list) (slow list) (counter 0)) (catch 'cycle (while slow (cl-incf counter) (setq slow (cdr slow)) (setq fast (cdr (cdr fast))) (when (eq slow list) (throw 'cycle t)) (when (eq slow fast) (setq list slow) (setq counter 0) (setq fast nil)))) counter))) ;;;###autoload (defun list-utils-cyclic-p (list &optional perfect) "Return non-nil if LIST contains any cyclic structures. If optional PERFECT is set, only return non-nil if LIST is a perfect non-branching cycle in which the last element points to the first." (let ((cycle (list-utils-cyclic-subseq list))) (when (or (not perfect) (not (list-utils-linear-subseq list (list-utils-cyclic-length cycle)))) cycle))) ;;;###autoload (defun list-utils-linear-p (list) "Return non-nil if LIST is linear (no cyclic structure)." (not (list-utils-cyclic-subseq list))) ;;;###autoload (defalias 'list-utils-improper-p 'list-utils-cons-cell-p) ;;;###autoload (defun list-utils-safe-length (list) "Return the number of elements in LIST. LIST may be linear or cyclic. If LIST is not really a list, returns 0. If LIST is an improper list, return the number of proper list elements, like `safe-length'." (if (not (listp list)) 0 ;; else (let ((cycle-length (list-utils-cyclic-length list))) (+ cycle-length (safe-length (list-utils-linear-subseq list cycle-length)))))) ;;;###autoload (defun list-utils-flat-length (list) "Count simple elements from the beginning of LIST. Stop counting when a cons is reached. nil is not a cons, and is considered to be a \"simple\" element. If the car of LIST is a cons, return 0." (let ((counter 0)) (ignore-errors (catch 'saw-depth (dolist (elt list) (when (consp elt) (throw 'saw-depth t)) (cl-incf counter)))) counter)) ;;;###autoload (defun list-utils-make-linear-copy (list &optional tree) "Return a linearized copy of LIST, which may be cyclic. If optional TREE is non-nil, traverse LIST, substituting linearized copies of any cyclic lists contained within." (cond ((not tree) (cl-subseq list 0 (list-utils-safe-length list))) ((consp list) (mapcar #'(lambda (elt) (list-utils-make-linear-copy elt 'tree)) (list-utils-make-linear-copy list))) (t list))) ;;;###autoload (defun list-utils-make-linear-inplace (list &optional tree) "Linearize LIST, which may be cyclic. Modifies LIST and returns the modified value. If optional TREE is non-nil, traverse LIST, linearizing any cyclic lists contained within." (cond ((not tree) (setf (nthcdr (list-utils-safe-length list) list) nil) list) ((consp list) (mapcar #'(lambda (elt) (list-utils-make-linear-inplace elt 'tree)) (list-utils-make-linear-inplace list))) (t list))) ;;;###autoload (defun list-utils-safe-equal (list-1 list-2 &optional test) "Compare LIST-1 and LIST-2, which may be cyclic lists. LIST-1 and LIST-2 may also contain cyclic lists, which are each traversed and compared. This function will not infloop when cyclic lists are encountered. Non-nil is returned only if the leaves of LIST-1 and LIST-2 are `equal' and the structure is identical. Optional TEST specifies a test, defaulting to `equal'. If LIST-1 and LIST-2 are not actually lists, they are still compared according to TEST." (cl-callf or test 'equal) (cond ((and (not (listp list-1)) (not (listp list-2))) (funcall test list-1 list-2)) ((or (not (listp list-1)) (not (listp list-2))) nil) (t (catch 'match (let* ((cyclic-1 (list-utils-make-linear-copy (list-utils-cyclic-subseq list-1 'from-start))) (cyclic-2 (list-utils-make-linear-copy (list-utils-cyclic-subseq list-2 'from-start))) (clen-1 (list-utils-safe-length cyclic-1)) (clen-2 (list-utils-safe-length cyclic-2)) (linear-1 nil) (linear-2 nil) (last-cdr-1 nil) (last-cdr-2 nil)) (unless (= clen-1 clen-2) (throw 'match nil)) (cl-loop for a in cyclic-1 for b in cyclic-2 unless (list-utils-safe-equal a b) do (throw 'match nil)) (setq linear-1 (list-utils-linear-subseq list-1 clen-1)) (setq linear-2 (list-utils-linear-subseq list-2 clen-2)) (unless (= (list-utils-safe-length linear-1) (list-utils-safe-length linear-2)) (throw 'match nil)) (cl-loop for a in linear-1 for b in linear-2 unless (list-utils-safe-equal a b) do (throw 'match nil)) (setq last-cdr-1 (list-utils-improper-p linear-1)) (setq last-cdr-2 (list-utils-improper-p linear-2)) (when (or (if last-cdr-1 (not last-cdr-2) last-cdr-2) (and last-cdr-1 (not (funcall test last-cdr-1 last-cdr-2)))) (throw 'match nil))) t)))) ;;;###autoload (defun list-utils-depth (list) "Find the depth of LIST, which may contain other lists. If LIST is not a list or is an empty list, returns a depth of 0. If LIST is a cons cell or a list which does not contain other lists, returns a depth of 1." (cond ((or (not (listp list)) (null list)) 0) ((and (listp list) (list-utils-cyclic-p list)) (list-utils-depth (list-utils-make-linear-copy list))) ((list-utils-cons-cell-p list) (+ 1 (apply 'max (mapcar 'list-utils-depth (list-utils-make-proper-copy list))))) (t (+ 1 (apply 'max (mapcar 'list-utils-depth list)))))) ;;;###autoload (defun list-utils-flatten (list) "Return a flattened copy of LIST, which may contain other lists. This function flattens cons cells as lists, and flattens circular list structures." (cond ((null list) nil) ((and (listp list) (list-utils-cyclic-p list)) (list-utils-flatten (list-utils-make-linear-copy list))) ((and (listp list) (consp (car list))) (append (list-utils-flatten (car list)) (list-utils-flatten (cdr list)))) ((listp list) (let ((extent (list-utils-flat-length list))) (append (cl-subseq list 0 extent) (list-utils-flatten (nthcdr extent list))))) (t (list list)))) ;;;###autoload (defun list-utils-insert-before (list element new-element &optional test) "Look in LIST for ELEMENT and insert NEW-ELEMENT before it. Optional TEST sets the test used for a matching element, and defaults to `equal'. LIST is modified and the new value is returned." (cl-callf or test 'equal) (let ((improper (list-utils-improper-p list)) (pos nil)) (when improper (cl-callf list-utils-make-proper-inplace list)) (setq pos (cl-position element list :test test)) (cl-assert pos nil "Element not found: %s" element) (push new-element (nthcdr pos list)) (when improper (cl-callf list-utils-make-improper-inplace list))) list) ;;;###autoload (defun list-utils-insert-after (list element new-element &optional test) "Look in LIST for ELEMENT and insert NEW-ELEMENT after it. Optional TEST sets the test used for a matching element, and defaults to `equal'. LIST is modified and the new value is returned." (cl-callf or test 'equal) (let ((improper (list-utils-improper-p list)) (pos nil)) (when improper (cl-callf list-utils-make-proper-inplace list)) (setq pos (cl-position element list :test test)) (cl-assert pos nil "Element not found: %s" element) (push new-element (cdr (nthcdr pos list))) (when improper (cl-callf list-utils-make-improper-inplace list))) list) ;;;###autoload (defun list-utils-insert-before-pos (list pos new-element) "Look in LIST for position POS, and insert NEW-ELEMENT before. POS is zero-indexed. LIST is modified and the new value is returned." (let ((improper (list-utils-improper-p list))) (when improper (cl-callf list-utils-make-proper-inplace list)) (cl-assert (and (integerp pos) (>= pos 0) (< pos (length list))) nil "No such position %s" pos) (push new-element (nthcdr pos list)) (when improper (cl-callf list-utils-make-improper-inplace list))) list) ;;;###autoload (defun list-utils-insert-after-pos (list pos new-element) "Look in LIST for position POS, and insert NEW-ELEMENT after. LIST is modified and the new value is returned." (let ((improper (list-utils-improper-p list))) (when improper (cl-callf list-utils-make-proper-inplace list)) (cl-assert (and (integerp pos) (>= pos 0) (< pos (length list))) nil "No such position %s" pos) (push new-element (cdr (nthcdr pos list))) (when improper (cl-callf list-utils-make-improper-inplace list))) list) ;;;###autoload (defun list-utils-and (list1 list2 &optional test hint flip) "Return the elements of LIST1 which are present in LIST2. This is similar to `cl-intersection' (or `intersection') from the cl library, except that `list-utils-and' preserves order, does not uniquify the results, and exhibits more predictable performance for large lists. Order will follow LIST1. Duplicates may be present in the result as in LIST1. TEST is an optional comparison function in the form of a hash-table-test. The default is `equal'. Other valid values include `eq' (built-in), `eql' (built-in), `list-utils-htt-=' \(numeric), `list-utils-htt-case-fold-equal' (case-insensitive). See `define-hash-table-test' to define your own tests. HINT is an optional micro-optimization, predicting the size of the list to be hashed (LIST2 unless FLIP is set). When optional FLIP is set, the sense of the comparison is reversed. When FLIP is set, LIST2 will be the guide for the order of the result, and will determine whether duplicates may be returned. Since this function preserves duplicates, setting FLIP can change the number of elements in the result. Performance: `list-utils-and' and friends use a general-purpose hashing approach. `intersection' and friends use pure iteration. Iteration can be much faster in a few special cases, especially when the number of elements is small. In other scenarios, iteration can be much slower. Hashing has no worst-case performance scenario, although it uses much more memory. For heavy-duty list operations, performance may be improved by `let'ing `gc-cons-threshold' to a high value around sections that make frequent use of this function." (when flip (cl-psetq list1 list2 list2 list1)) (cond ((null list1) list2) ((null list2) list1) ((equal list1 list2) list1) (t (let ((saw (make-hash-table :test (or test 'equal) :size (or hint (safe-length (if flip list1 list2)))))) (mapc #'(lambda (elt) (puthash elt t saw)) list2) (delq nil (mapcar #'(lambda (elt) (when (gethash elt saw) elt)) list1)))))) ;;;###autoload (defun list-utils-not (list1 list2 &optional test hint flip) "Return the elements of LIST1 which are not present in LIST2. This is similar to `cl-set-difference' (or `set-difference') from the cl library, except that `list-utils-not' preserves order and exhibits more predictable performance for large lists. Order will follow LIST1. Duplicates may be present as in LIST1. TEST is an optional comparison function in the form of a hash-table-test. The default is `equal'. Other valid values include `eq' (built-in), `eql' (built-in), `list-utils-htt-=' \(numeric), `list-utils-htt-case-fold-equal' (case-insensitive). See `define-hash-table-test' to define your own tests. HINT is an optional micro-optimization, predicting the size of the list to be hashed (LIST2 unless FLIP is set). When optional FLIP is set, the sense of the comparison is reversed, returning elements of LIST2 which are not present in LIST1. When FLIP is set, LIST2 will be the guide for the order of the result, and will determine whether duplicates may be returned. Performance: see notes under `list-utils-and'." (when flip (cl-psetq list1 list2 list2 list1)) (cond ((null list1) nil) ((null list2) list1) ((equal list1 list2) nil) ;; Todo, for some cases iteration is faster, but is there any ;; heuristic for following this path that isn't itself too ;; expensive? Example where iteration is faster: ;; list1 is (1 2 3), list2 is (1 2 3 ... 1000) ;; ((and nil ;; (setq member-fn (cdr (assq test list-utils-fast-member-fns)))) ;; (delq nil (mapcar #'(lambda (elt) ;; (unless (funcall member-fn elt list2) ;; elt)) ;; list1))) (t (let ((saw (make-hash-table :test (or test 'equal) :size (or hint (safe-length list2))))) (mapc #'(lambda (elt) (puthash elt t saw)) list2) (delq nil (mapcar #'(lambda (elt) (unless (gethash elt saw) elt)) list1)))))) ;;;###autoload (defun list-utils-xor (list1 list2 &optional test hint flip) "Return elements which are only present in either LIST1 or LIST2. This is similar to `cl-set-exclusive-or' (or `set-exclusive-or') from the cl library, except that `list-utils-xor' preserves order, and exhibits more predictable performance for large lists. Order will follow LIST1, then LIST2. Duplicates may be present as in LIST1 or LIST2. TEST is an optional comparison function in the form of a hash-table-test. The default is `equal'. Other valid values include `eq' (built-in), `eql' (built-in), `list-utils-htt-=' \(numeric), `list-utils-htt-case-fold-equal' (case-insensitive). See `define-hash-table-test' to define your own tests. HINT is an optional micro-optimization, predicting the size of the list to be hashed (LIST2 unless FLIP is set). When optional FLIP is set, the sense of the comparison is reversed, causing order and duplicates to follow LIST2, then LIST1. Performance: see notes under `list-utils-and'." (append (list-utils-not list1 list2 test hint flip) (list-utils-not list2 list1 test nil flip))) ;;;###autoload (defun list-utils-uniq (list &optional test hint) "Return a uniquified copy of LIST, preserving order. This is similar to `cl-remove-duplicates' (or `remove-duplicates') from the cl library, except that `list-utils-uniq' preserves order, and exhibits more predictable performance for large lists. Order will follow LIST. TEST is an optional comparison function in the form of a hash-table-test. The default is `equal'. Other valid values include `eq' (built-in), `eql' (built-in), `list-utils-htt-=' \(numeric), `list-utils-htt-case-fold-equal' (case-insensitive). See `define-hash-table-test' to define your own tests. HINT is an optional micro-optimization, predicting the size of LIST. Performance: see notes under `list-utils-and'." (let ((saw (make-hash-table :test (or test 'equal) :size (or hint (safe-length list))))) (delq nil (mapcar #'(lambda (elt) (unless (gethash elt saw) (progn (puthash elt t saw) elt))) list)))) ;;;###autoload (defun list-utils-dupes (list &optional test hint) "Return only duplicated elements from LIST, preserving order. Duplicated elements may still exist in the result: this function removes singlets. TEST is an optional comparison function in the form of a hash-table-test. The default is `equal'. Other valid values include `eq' (built-in), `eql' (built-in), `list-utils-htt-=' \(numeric), `list-utils-htt-case-fold-equal' (case-insensitive). See `define-hash-table-test' to define your own tests. HINT is an optional micro-optimization, predicting the size of LIST. Performance: see notes under `list-utils-and'." (let ((saw (make-hash-table :test (or test 'equal) :size (or hint (safe-length list))))) (mapc #'(lambda (elt) (puthash elt (if (gethash elt saw) 2 1) saw)) list) (delq nil (mapcar #'(lambda (elt) (when (> (gethash elt saw) 1) elt)) list)))) ;;;###autoload (defun list-utils-singlets (list &optional test hint) "Return only singlet elements from LIST, preserving order. Duplicated elements may not exist in the result. TEST is an optional comparison function in the form of a hash-table-test. The default is `equal'. Other valid values include `eq' (built-in), `eql' (built-in), `list-utils-htt-=' \(numeric), `list-utils-htt-case-fold-equal' (case-insensitive). See `define-hash-table-test' to define your own tests. HINT is an optional micro-optimization, predicting the size of LIST. Performance: see notes under `list-utils-and'." (let ((saw (make-hash-table :test (or test 'equal) :size (or hint (safe-length list))))) (mapc #'(lambda (elt) (puthash elt (if (gethash elt saw) 2 1) saw)) list) (delq nil (mapcar #'(lambda (elt) (when (= (gethash elt saw) 1) elt)) list)))) ;;;###autoload (defun list-utils-partition-dupes (list &optional test hint) "Partition LIST into duplicates and singlets, preserving order. The return value is an alist with two keys: 'dupes and 'singlets. The two values of the alist are lists which, if combined, comprise a complete copy of the elements of LIST. Duplicated elements may still exist in the 'dupes partition. TEST is an optional comparison function in the form of a hash-table-test. The default is `equal'. Other valid values include `eq' (built-in), `eql' (built-in), `list-utils-htt-=' \(numeric), `list-utils-htt-case-fold-equal' (case-insensitive). See `define-hash-table-test' to define your own tests. HINT is an optional micro-optimization, predicting the size of LIST. Performance: see notes under `list-utils-and'." (let ((saw (make-hash-table :test (or test 'equal) :size (or hint (safe-length list))))) (mapc #'(lambda (elt) (puthash elt (if (gethash elt saw) 2 1) saw)) list) (list (cons 'dupes (delq nil (mapcar #'(lambda (elt) (when (> (gethash elt saw) 1) elt)) list))) (cons 'singlets (delq nil (mapcar #'(lambda (elt) (when (= (gethash elt saw) 1) elt)) list)))))) ;;; alists ;;;###autoload (defun list-utils-alist-or-flat-length (list) "Count simple or cons-cell elements from the beginning of LIST. Stop counting when a proper list of non-zero length is reached. If the car of LIST is a list, return 0." (let ((counter 0)) (ignore-errors (catch 'saw-depth (dolist (elt list) (when (and (consp elt) (not (list-utils-cons-cell-p elt))) (throw 'saw-depth t)) (cl-incf counter)))) counter)) ;;;###autoload (defun list-utils-alist-flatten (list) "Flatten LIST, which may contain other lists. Do not flatten cons cells. It is not guaranteed that the result contains *only* cons cells. The result could contain other data types present in LIST. This function simply avoids flattening single conses or improper lists where the last two elements would be expressed as a dotted pair." (cond ((null list) nil) ((and (listp list) (list-utils-cyclic-p list)) (list-utils-alist-flatten (list-utils-make-linear-copy list))) ((list-utils-cons-cell-p list) list) ((and (listp list) (consp (car list)) (not (list-utils-cons-cell-p (car list)))) (append (list-utils-alist-flatten (car list)) (list-utils-alist-flatten (cdr list)))) ((listp list) (let ((extent (list-utils-alist-or-flat-length list))) (append (cl-subseq list 0 extent) (list-utils-alist-flatten (nthcdr extent list))))) (t (list list)))) ;;; plists ;;;###autoload (defun list-utils-plist-reverse (plist) "Return reversed copy of property-list PLIST, maintaining pair associations." (cl-assert (= 0 (% (length plist) 2)) nil "Not a PLIST") (cl-loop for (a b) on (reverse plist) by 'cddr collect b collect a)) ;;;###autoload (defun list-utils-plist-del (plist prop) "Delete from PLIST the property PROP and its associated value. When PROP is not present in PLIST, there is no effect. The new plist is returned; use `(setq x (list-utils-plist-del x prop))' to be sure to use the new value. This functionality overlaps with the undocumented `cl-do-remf'." (let ((prop-pos (cl-position prop plist))) (when (and prop-pos (= 0 (% prop-pos 2))) (cl-callf cddr (nthcdr prop-pos plist)))) plist) (provide 'list-utils) ;; ;; Emacs ;; ;; Local Variables: ;; indent-tabs-mode: nil ;; mangle-whitespace: t ;; require-final-newline: t ;; coding: utf-8 ;; byte-compile-warnings: (not cl-functions redefine) ;; End: ;; ;; LocalWords: ListUtils ARGS alist utils nconc tconc defstruct setf ;; LocalWords: plists PLIST setq autoloading plist callf alists ;; LocalWords: inplace ;; ;;; list-utils.el ends here