[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#24603: [RFC 01/18] Add tests for casefiddle.c
From: |
Michal Nazarewicz |
Subject: |
bug#24603: [RFC 01/18] Add tests for casefiddle.c |
Date: |
Tue, 4 Oct 2016 03:10:24 +0200 |
Fixes cases marked FIXME upcoming in followup commits.
* test/src/casefiddle-tests.el (casefiddle-tests-char-properties,
casefiddle-tests-case-table, casefiddle-tests-casing-character,
casefiddle-tests-casing): New test cases.
---
test/src/casefiddle-tests.el | 190 +++++++++++++++++++++++++++++++++++++++++++
1 file changed, 190 insertions(+)
create mode 100644 test/src/casefiddle-tests.el
diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el
new file mode 100644
index 0000000..4b2eeaf
--- /dev/null
+++ b/test/src/casefiddle-tests.el
@@ -0,0 +1,190 @@
+;;; casefiddle-tests.el --- tests for casefiddle.c functions -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2015-2016 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest casefiddle-tests-char-properties ()
+ "Sanity check of character Unicode properties."
+ (should-not
+ (let (errors)
+ ;; character uppercase lowercase titlecase
+ (dolist (test '((?A nil ?a nil)
+ (?a ?A nil ?A)
+ (?Ł nil ?ł nil)
+ (?ł ?Ł nil ?Ł)
+
+ (?DŽ nil ?dž ?Dž)
+ (?Dž ?DŽ ?dž ?Dž)
+ (?dž ?DŽ nil ?Dž)
+
+ (?Σ nil ?σ nil)
+ (?σ ?Σ nil ?Σ)
+ (?ς ?Σ nil ?Σ)
+
+ (?ⅷ ?Ⅷ nil ?Ⅷ)
+ (?Ⅷ nil ?ⅷ nil)))
+ (let ((ch (car test))
+ (expected (cdr test))
+ (props '(uppercase lowercase titlecase)))
+ (while props
+ (let ((got (get-char-code-property ch (car props))))
+ (unless (equal (car expected) got)
+ (push (format "\n%c %s; expected: %s but got: %s"
+ ch (car props) (car expected) got)
+ errors)))
+ (setq props (cdr props) expected (cdr expected)))))
+ (when errors
+ (mapconcat (lambda (line) line) (nreverse errors) "")))))
+
+
+(defconst casefiddle-tests--characters
+ ;; character uppercase lowercase titlecase
+ '((?A ?A ?a ?A)
+ (?a ?A ?a ?A)
+ (?Ł ?Ł ?ł ?Ł)
+ (?ł ?Ł ?ł ?Ł)
+
+ ;; FIXME: We should have:
+ ;;(?DŽ ?DŽ ?dž ?Dž)
+ ;; but instead we have:
+ (?DŽ ?DŽ ?dž ?DŽ)
+ ;; FIXME: Those two are broken at the moment:
+ ;;(?Dž ?DŽ ?dž ?Dž)
+ ;;(?dž ?DŽ ?dž ?Dž)
+
+ (?Σ ?Σ ?σ ?Σ)
+ (?σ ?Σ ?σ ?Σ)
+ ;; FIXME: Another broken one:
+ ;;(?ς ?Σ ?ς ?Σ)
+
+ (?Ⅷ ?Ⅷ ?ⅷ ?Ⅷ)
+ (?ⅷ ?Ⅷ ?ⅷ ?Ⅷ)))
+
+
+(ert-deftest casefiddle-tests-case-table ()
+ "Sanity check of down and up case tables."
+ (should-not
+ (let (errors
+ (up (case-table-get-table (current-case-table) 'up))
+ (down (case-table-get-table (current-case-table) 'down)))
+ (dolist (test casefiddle-tests--characters)
+ (let ((ch (car test))
+ (expected (cdr test))
+ (props '(uppercase lowercase))
+ (tabs (list up down)))
+ (while props
+ (let ((got (aref (car tabs) ch)))
+ (unless (equal (car expected) got)
+ (push (format "\n%c %s; expected: %s but got: %s"
+ ch (car props) (car expected) got)
+ errors)))
+ (setq props (cdr props) tabs (cdr tabs) expected (cdr expected)))))
+ (when errors
+ (mapconcat (lambda (line) line) (nreverse errors) "")))))
+
+
+(ert-deftest casefiddle-tests-casing-character ()
+ (should-not
+ (let (errors)
+ (dolist (test casefiddle-tests--characters)
+ (let ((ch (car test))
+ (expected (cdr test))
+ (funcs '(upcase downcase capitalize)))
+ (while funcs
+ (let ((got (funcall (car funcs) ch)))
+ (unless (equal (car expected) got)
+ (push (format "\n%c %s; expected: %s but got: %s"
+ ch (car funcs) (car expected) got)
+ errors)))
+ (setq funcs (cdr funcs) expected (cdr expected)))))
+ (when errors
+ (mapconcat (lambda (line) line) (nreverse errors) "")))))
+
+
+(ert-deftest casefiddle-tests-casing-word ()
+ (with-temp-buffer
+ (dolist (test '((upcase-word . "FOO Bar")
+ (downcase-word . "foo Bar")
+ (capitalize-word . "Foo Bar")))
+ (dolist (back '(nil t))
+ (delete-region (point-min) (point-max))
+ (insert "foO Bar")
+ (goto-char (+ (if back 4 0) (point-min)))
+ (funcall (car test) (if back -1 1))
+ (should (string-equal (cdr test) (buffer-string)))
+ (should (equal (+ (if back 4 3) (point-min)) (point)))))))
+
+
+(ert-deftest casefiddle-tests-casing ()
+ (should-not
+ (let (errors)
+ (with-temp-buffer
+ (dolist
+ (test
+ ;; input upcase downcase capitalize upcase-initials
+ '(("Foo baR" "FOO BAR" "foo bar" "Foo Bar" "Foo BaR")
+ ("Ⅷ ⅷ" "Ⅷ Ⅷ" "ⅷ ⅷ" "Ⅷ Ⅷ" "Ⅷ Ⅷ")
+ ;; FIXME: Everything below is broken at the moment. Here’s what
+ ;; should happen:
+ ;;("DŽUNGLA" "DŽUNGLA" "džungla" "Džungla" "DžUNGLA")
+ ;;("Džungla" "DŽUNGLA" "džungla" "Džungla" "Džungla")
+ ;;("džungla" "DŽUNGLA" "džungla" "Džungla" "Džungla")
+ ;;("define" "DEFINE" "define" "Define" "Define")
+ ;;("fish" "FIsh" "fish" "Fish" "Fish")
+ ;;("Straße" "STRASSE" "straße" "Straße" "Straße")
+ ;;("ΌΣΟΣ" "ΌΣΟΣ" "όσος" "Όσος" "Όσος")
+ ;;("όσος" "ΌΣΟΣ" "όσος" "Όσος" "Όσος")
+ ;; And here’s what is actually happening:
+ ("DŽUNGLA" "DŽUNGLA" "džungla" "DŽungla" "DŽUNGLA")
+ ("Džungla" "DžUNGLA" "džungla" "Džungla" "Džungla")
+ ("džungla" "DŽUNGLA" "džungla" "DŽungla" "DŽungla")
+ ("define" "DEfiNE" "define" "Define" "Define")
+ ("fish" "fiSH" "fish" "fish" "fish")
+ ("Straße" "STRAßE" "straße" "Straße" "Straße")
+ ("ΌΣΟΣ" "ΌΣΟΣ" "όσοσ" "Όσοσ" "ΌΣΟΣ")
+ ("όσος" "ΌΣΟς" "όσος" "Όσος" "Όσος"))
+ (nreverse errors))
+ (let* ((input (car test))
+ (expected (cdr test))
+ (check (lambda (func got)
+ (unless (string-equal got (car expected))
+ (let ((fmt (length (symbol-name func))))
+ (setq fmt (format "\n%%%ds: %%s" (max fmt 8)))
+ (push (format (concat fmt fmt fmt)
+ func input
+ "expected" (car expected)
+ "but got" got)
+ errors))))))
+ (dolist (func '((upcase . upcase-region)
+ (downcase . downcase-region)
+ (capitalize . capitalize-region)
+ (upcase-initials . upcase-initials-region)))
+ (funcall check (car func) (funcall (car func) input))
+ (funcall check (cdr func) (progn
+ (delete-region (point-min)
(point-max))
+ (insert input)
+ (funcall (cdr func)
+ (point-min) (point-max))
+ (buffer-string)))
+ (setq expected (cdr expected)))))))))
+
+
+;;; casefiddle-tests.el ends here
--
2.8.0.rc3.226.g39d4020
- bug#24603: [RFC 00/18] Improvement to casing, Michal Nazarewicz, 2016/10/03
- bug#24603: [RFC 01/18] Add tests for casefiddle.c,
Michal Nazarewicz <=
- bug#24603: [RFC 05/18] Introduce case_character function, Michal Nazarewicz, 2016/10/03
- bug#24603: [RFC 06/18] Add support for title-casing letters, Michal Nazarewicz, 2016/10/03
- bug#24603: [RFC 13/18] Add some tricky Unicode characters to regex test, Michal Nazarewicz, 2016/10/03
- bug#24603: [RFC 15/18] Base lower- and upper-case tests on Unicode properties, Michal Nazarewicz, 2016/10/03
- bug#24603: [RFC 04/18] Split casify_object into multiple functions, Michal Nazarewicz, 2016/10/03
- bug#24603: [RFC 03/18] Don’t assume character can be either upper- or lower-case when casing, Michal Nazarewicz, 2016/10/03
- bug#24603: [RFC 12/18] Implement rules for title-casing Dutch ij ‘letter’, Michal Nazarewicz, 2016/10/03
- bug#24603: [RFC 11/18] Implement casing rules for Lithuanian, Michal Nazarewicz, 2016/10/03
- bug#24603: [RFC 16/18] Refactor character class checking; optimise ASCII case, Michal Nazarewicz, 2016/10/03