Tests for the lreaf.c amd print.c primitives.

2 files changed, 86 insertions, 0 deletions

diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index e621a9d58b9..50281471389 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -504,4 +504,50 @@ literals (Bug#20852)."
       (should (equal (oa-syms oa) (list s2))))
     ))
 
+(ert-deftest lread-tests--get-load-suffixes ()
+  (let ((load-suffixes '(".el" ".elc"))
+        (load-file-rep-suffixes '("" ".gz")))
+    (should (equal (get-load-suffixes)
+                   '(".el" ".el.gz" ".elc" ".elc.gz")))))
+
+(ert-deftest lread-tests--locate-file-internal ()
+  (let* ((dir (make-temp-file "lread-tests" t))
+         (file (expand-file-name "foo.el" dir))
+         (subdir (expand-file-name "bar" dir)))
+    (unwind-protect
+        (progn
+          (with-temp-file file)
+          (make-directory subdir)
+          (should (equal (locate-file-internal "foo" (list dir) '(".el") nil)
+                         file))
+          (should-not (locate-file-internal "bar" (list dir) nil nil))
+          (should (equal (locate-file-internal
+                          "bar" (list dir) nil
+                          (lambda (path)
+                            (if (file-directory-p path) 'dir-ok
+                              (file-readable-p path))))
+                         subdir)))
+      (ignore-errors (delete-file file))
+      (ignore-errors (delete-directory subdir))
+      (ignore-errors (delete-directory dir)))))
+
+(ert-deftest lread-tests--internal-obarray-buckets ()
+  (let* ((oa (obarray-make 7))
+         (s1 (intern "alpha" oa))
+         (s2 (intern "beta" oa))
+         (s3 (intern "gamma" oa))
+         (buckets (internal--obarray-buckets oa))
+         (flat nil)
+         (expected (list s1 s2 s3)))
+    (dolist (bucket buckets)
+      (dolist (sym bucket)
+        (push sym flat)))
+    (should (= (length flat) (length (delete-dups (copy-sequence flat)))))
+    (setq flat (sort flat (lambda (a b)
+                            (string< (symbol-name a) (symbol-name b)))))
+    (setq expected (sort (copy-sequence expected)
+                         (lambda (a b)
+                           (string< (symbol-name a) (symbol-name b)))))
+    (should (equal flat expected))))
+
 ;;; lread-tests.el ends here
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 1485e063ab3..033049afbdf 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -570,5 +570,45 @@ otherwise, use a different charset."
   (should (equal (prin1-to-string (make-symbol "th\303\251"))
                  (string-to-multibyte "th\303\251"))))
 
+(ert-deftest print-tests--write-char ()
+  (should (equal (with-output-to-string (write-char ?A)) "A"))
+  (let (out)
+    (should (= (write-char ?Z (lambda (c)
+                                (setq out (concat out (string c)))))
+               ?Z))
+    (should (equal out "Z"))))
+
+(ert-deftest print-tests--redirect-debugging-output ()
+  (let ((file (make-temp-file "print-tests-debug")))
+    (unwind-protect
+        (progn
+          (redirect-debugging-output file nil)
+          (external-debugging-output ?A)
+          (external-debugging-output ?B)
+          (redirect-debugging-output nil)
+          (should (equal (with-temp-buffer
+                           (insert-file-contents file)
+                           (buffer-string))
+                         "AB")))
+      (ignore-errors (redirect-debugging-output nil))
+      (ignore-errors (delete-file file)))))
+
+(ert-deftest print-tests--preprocess ()
+  (let* ((x (list 1 2))
+         (obj (list x x))
+         (print-circle t)
+         (print-number-table nil))
+    (print--preprocess obj)
+    (should (hash-table-p print-number-table))
+    (should (> (hash-table-count print-number-table) 0))
+    (should (gethash x print-number-table)))
+  (let* ((x (list 1 2))
+         (obj (list x x))
+         (print-circle nil)
+         (print-number-table (make-hash-table :test 'eq)))
+    (puthash 'sentinel 'value print-number-table)
+    (print--preprocess obj)
+    (should (eq (gethash 'sentinel print-number-table) 'value))))
+
 (provide 'print-tests)
 ;;; print-tests.el ends here