168 lines
6.6 KiB
EmacsLisp
168 lines
6.6 KiB
EmacsLisp
;;; cl-print-tests.el --- Test suite for the cl-print facility. -*- lexical-binding:t -*-
|
|
|
|
;; Copyright (C) 2017-2024 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 <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; See test/src/print-tests.el for tests which apply to both
|
|
;; cl-print.el and src/print.c.
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert)
|
|
(require 'cl-print)
|
|
|
|
(cl-defstruct (cl-print-tests-struct
|
|
(:constructor cl-print-tests-con))
|
|
a b c d e)
|
|
|
|
(ert-deftest cl-print-tests-ellipsis-cons ()
|
|
"Ellipsis expansion works in conses."
|
|
(let ((print-length 4)
|
|
(print-level 3))
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
'(0 1 2 3 4 5) "(0 1 2 3 ...)" "4 5")
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
'(0 1 2 3 4 5 6 7 8 9) "(0 1 2 3 ...)" "4 5 6 7 ...")
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
'(a (b (c (d (e))))) "(a (b (c ...)))" "(d (e))")
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
(let ((x (make-list 6 'b)))
|
|
(setf (nthcdr 6 x) 'c)
|
|
x)
|
|
"(b b b b ...)" "b b . c")))
|
|
|
|
(ert-deftest cl-print-tests-ellipsis-vector ()
|
|
"Ellipsis expansion works in vectors."
|
|
(let ((print-length 4)
|
|
(print-level 3))
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
[0 1 2 3 4 5] "[0 1 2 3 ...]" "4 5")
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
[0 1 2 3 4 5 6 7 8 9] "[0 1 2 3 ...]" "4 5 6 7 ...")
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
[a [b [c [d [e]]]]] "[a [b [c ...]]]" "[d [e]]")))
|
|
|
|
(ert-deftest cl-print-tests-ellipsis-string ()
|
|
"Ellipsis expansion works in strings."
|
|
(let ((cl-print-string-length 4))
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
"abcdefg" "\"abcd...\"" "efg")
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
"abcdefghijk" "\"abcd...\"" "efgh...")
|
|
(let ((print-length 4)
|
|
(print-level 3))
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
'(1 (2 (3 #("abcde" 0 5 (test t)))))
|
|
"(1 (2 (3 ...)))" "#(\"abcd...\" 0 5 (test t))"))
|
|
(let ((print-length 4))
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
#("abcd" 0 1 (bold t) 1 2 (invisible t) 3 4 (italic t))
|
|
"#(\"abcd\" 0 1 (bold t) ...)" "1 2 (invisible t) ..."))))
|
|
|
|
(ert-deftest cl-print-tests-ellipsis-struct ()
|
|
"Ellipsis expansion works in structures."
|
|
(let ((print-length 4)
|
|
(print-level 3)
|
|
(struct (cl-print-tests-con)))
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
struct "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)" ":e nil")
|
|
(let ((print-length 2))
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
struct "#s(cl-print-tests-struct :a nil :b nil ...)" ":c nil :d nil ..."))
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
`(a (b (c ,struct)))
|
|
"(a (b (c ...)))"
|
|
"#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)")))
|
|
|
|
(ert-deftest cl-print-tests-ellipsis-circular ()
|
|
"Ellipsis expansion works with circular objects."
|
|
(let ((wide-obj (list 0 1 2 3 4))
|
|
(deep-obj (list 0 (list 1 (list 2 (list 3 (list 4))))))
|
|
(print-length 4)
|
|
(print-level 3))
|
|
(setf (nth 4 wide-obj) wide-obj)
|
|
(setf (car (cadadr (cadadr deep-obj))) deep-obj)
|
|
(let ((print-circle nil))
|
|
(cl-print-tests-check-ellipsis-expansion-rx
|
|
wide-obj (regexp-quote "(0 1 2 3 ...)") "\\`#[0-9]\\'")
|
|
(cl-print-tests-check-ellipsis-expansion-rx
|
|
deep-obj (regexp-quote "(0 (1 (2 ...)))") "\\`(3 (#[0-9]))\\'"))
|
|
(let ((print-circle t))
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
wide-obj "#1=(0 1 2 3 ...)" "#1#")
|
|
(cl-print-tests-check-ellipsis-expansion
|
|
deep-obj "#1=(0 (1 (2 ...)))" "(3 (#1#))"))))
|
|
|
|
(defun cl-print-tests-check-ellipsis-expansion (obj expected expanded)
|
|
(let* ((result (cl-prin1-to-string obj))
|
|
(pos (next-single-property-change 0 'cl-print-ellipsis result))
|
|
value)
|
|
(should pos)
|
|
(setq value (get-text-property pos 'cl-print-ellipsis result))
|
|
(should (equal expected result))
|
|
(should (equal expanded (with-output-to-string (cl-print--expand-ellipsis
|
|
value nil))))))
|
|
|
|
(defun cl-print-tests-check-ellipsis-expansion-rx (obj expected expanded)
|
|
(let* ((result (cl-prin1-to-string obj))
|
|
(pos (next-single-property-change 0 'cl-print-ellipsis result))
|
|
(value (get-text-property pos 'cl-print-ellipsis result)))
|
|
(should (string-match expected result))
|
|
(should (string-match expanded (with-output-to-string
|
|
(cl-print--expand-ellipsis value nil))))))
|
|
|
|
(ert-deftest cl-print-tests-print-to-string-with-limit ()
|
|
(let* ((thing10 (make-list 10 'a))
|
|
(thing100 (make-list 100 'a))
|
|
(thing10x10 (make-list 10 thing10))
|
|
(nested-thing (let ((val 'a))
|
|
(dotimes (_i 20)
|
|
(setq val (list val)))
|
|
val))
|
|
;; Make a consistent environment for this test.
|
|
(print-circle nil)
|
|
(print-level nil)
|
|
(print-length nil))
|
|
|
|
;; Print something that fits in the space given.
|
|
(should (string= (cl-prin1-to-string thing10)
|
|
(cl-print-to-string-with-limit #'cl-prin1 thing10 100)))
|
|
|
|
;; Print something which needs to be abbreviated and which can be.
|
|
(should (< (length (cl-print-to-string-with-limit #'cl-prin1 thing100 100))
|
|
100
|
|
(length (cl-prin1-to-string thing100))))
|
|
|
|
;; Print something resistant to easy abbreviation.
|
|
(should (string= (cl-prin1-to-string thing10x10)
|
|
(cl-print-to-string-with-limit #'cl-prin1 thing10x10 100)))
|
|
|
|
;; Print something which should be abbreviated even if the limit is large.
|
|
(should (< (length (cl-print-to-string-with-limit #'cl-prin1 nested-thing 1000))
|
|
(length (cl-prin1-to-string nested-thing))))
|
|
|
|
;; Print with no limits.
|
|
(dolist (thing (list thing10 thing100 thing10x10 nested-thing))
|
|
(let ((rep (cl-prin1-to-string thing)))
|
|
(should (string= rep (cl-print-to-string-with-limit #'cl-prin1 thing 0)))
|
|
(should (string= rep (cl-print-to-string-with-limit #'cl-prin1 thing nil)))))))
|
|
|
|
|
|
;;; cl-print-tests.el ends here.
|