sort-tests.el 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109
  1. ;;; sort-tests.el --- Tests for sort.el -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
  3. ;; Author: Artur Malabarba <bruce.connor.am@gmail.com>
  4. ;; This program is free software; you can redistribute it and/or modify
  5. ;; it under the terms of the GNU General Public License as published by
  6. ;; the Free Software Foundation, either version 3 of the License, or
  7. ;; (at your option) any later version.
  8. ;; This program is distributed in the hope that it will be useful,
  9. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. ;; GNU General Public License for more details.
  12. ;; You should have received a copy of the GNU General Public License
  13. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  14. ;;; Code:
  15. (require 'ert)
  16. (require 'sort)
  17. (defun sort-tests-random-word (n)
  18. (mapconcat (lambda (_) (string (let ((c (random 52)))
  19. (+ (if (> c 25) 71 65)
  20. c))))
  21. (make-list n nil) ""))
  22. (defun sort-tests--insert-words-sort-and-compare (words separator function reverse less-predicate)
  23. (with-temp-buffer
  24. (let ((aux words))
  25. (while aux
  26. (insert (pop aux))
  27. (when aux
  28. (insert separator))))
  29. ;; Final newline.
  30. (insert "\n")
  31. (funcall function reverse (point-min) (point-max))
  32. (let ((sorted-words
  33. (mapconcat #'identity
  34. (sort (copy-sequence words)
  35. (if reverse
  36. (lambda (a b) (funcall less-predicate b a))
  37. less-predicate))
  38. separator)))
  39. (should (string= (substring (buffer-string) 0 -1) sorted-words)))))
  40. ;;; This function uses randomly generated tests and should satisfy
  41. ;;; most needs for this lib.
  42. (cl-defun sort-tests-test-sorter-function (separator function &key generator less-pred noreverse)
  43. "Check that FUNCTION correctly sorts words separated by SEPARATOR.
  44. This checks whether it is equivalent to sorting a list of such
  45. words via LESS-PREDICATE, and then inserting them separated by
  46. SEPARATOR.
  47. LESS-PREDICATE defaults to `string-lessp'.
  48. GENERATOR is a function called with one argument that returns a
  49. word, it defaults to `sort-tests-random-word'.
  50. NOREVERSE means that the first arg of FUNCTION is not used for
  51. reversing the sort."
  52. (dotimes (n 20)
  53. ;; Sort n words of length n.
  54. (let ((words (mapcar (or generator #'sort-tests-random-word) (make-list n n)))
  55. (sort-fold-case nil)
  56. (less-pred (or less-pred #'string<)))
  57. (sort-tests--insert-words-sort-and-compare words separator function nil less-pred)
  58. (unless noreverse
  59. (sort-tests--insert-words-sort-and-compare
  60. words separator function 'reverse less-pred))
  61. (let ((less-pred-case (lambda (a b) (funcall less-pred (downcase a) (downcase b))))
  62. (sort-fold-case t))
  63. (sort-tests--insert-words-sort-and-compare words separator function nil less-pred-case)
  64. (unless noreverse
  65. (sort-tests--insert-words-sort-and-compare
  66. words separator function 'reverse less-pred-case))))))
  67. (ert-deftest sort-tests--lines ()
  68. (sort-tests-test-sorter-function "\n" #'sort-lines))
  69. (ert-deftest sort-tests--paragraphs ()
  70. (let ((paragraph-separate "[\s\t\f]*$"))
  71. (sort-tests-test-sorter-function "\n\n" #'sort-paragraphs)))
  72. (ert-deftest sort-tests--numeric-fields ()
  73. (cl-labels ((field-to-number (f) (string-to-number (car (split-string f)))))
  74. (sort-tests-test-sorter-function "\n" (lambda (_ l r) (sort-numeric-fields 1 l (1- r)))
  75. :noreverse t
  76. :generator (lambda (_) (format "%s %s" (random) (sort-tests-random-word 20)))
  77. :less-pred (lambda (a b) (< (field-to-number a)
  78. (field-to-number b))))))
  79. (ert-deftest sort-tests--fields-1 ()
  80. (cl-labels ((field-n (f n) (elt (split-string f) (1- n))))
  81. (sort-tests-test-sorter-function "\n" (lambda (_ l r) (sort-fields 1 l (1- r)))
  82. :noreverse t
  83. :generator (lambda (n) (concat (sort-tests-random-word n) " " (sort-tests-random-word n)))
  84. :less-pred (lambda (a b) (string< (field-n a 1) (field-n b 1))))))
  85. (ert-deftest sort-tests--fields-2 ()
  86. (cl-labels ((field-n (f n) (elt (split-string f) (1- n))))
  87. (sort-tests-test-sorter-function "\n" (lambda (_ l r) (sort-fields 2 l (1- r)))
  88. :noreverse t
  89. :generator (lambda (n) (concat (sort-tests-random-word n) " " (sort-tests-random-word n)))
  90. :less-pred (lambda (a b) (string< (field-n a 2) (field-n b 2))))))
  91. (provide 'sort-tests)
  92. ;;; sort-tests.el ends here