More correctness tesrs for orinitives from fns.c.

1 files changed, 127 insertions, 0 deletions

diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 955b3cbe7fb..d0cb11c2305 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -64,6 +64,133 @@
 (ert-deftest fns-tests-string-bytes ()
   (should (= (string-bytes "abc") 3)))
 
+(ert-deftest fns-tests-string-make-multibyte ()
+  (let* ((ascii (string-make-unibyte "abc"))
+         (ascii-mb (string-make-multibyte ascii)))
+    (should (string= ascii-mb "abc"))
+    (should-not (multibyte-string-p ascii-mb)))
+  (let* ((u (string-make-unibyte "é"))
+         (m (string-make-multibyte u)))
+    (should (multibyte-string-p m))
+    (should (string= (string-as-unibyte m) u))))
+
+(ert-deftest fns-tests-string-make-unibyte ()
+  (let ((s (propertize "é" 'foo 'bar)))
+    (let ((u (string-make-unibyte s)))
+      (should-not (multibyte-string-p u))
+      (should (equal (aref u 0) ?\xE9))
+      (should-not (text-properties-at 0 u)))))
+
+(ert-deftest fns-tests-string-as-multibyte ()
+  (let* ((u (string-make-unibyte "abc"))
+         (m (string-as-multibyte u)))
+    (should (string= m "abc"))
+    (should (multibyte-string-p m))
+    (should-not (text-properties-at 0 m)))
+  (let ((m "abc"))
+    (should (string= (string-as-multibyte m) m))))
+
+(ert-deftest fns-tests-fillarray ()
+  (let ((v (vector 1 2 3)))
+    (fillarray v 'x)
+    (should (equal v [x x x])))
+  (let ((s (string-make-unibyte "aaa")))
+    (fillarray s ?b)
+    (should (string= s "bbb"))
+    (should-not (multibyte-string-p s)))
+  (let ((bv (make-bool-vector 4 nil)))
+    (fillarray bv t)
+    (should (equal bv (make-bool-vector 4 t))))
+  (let ((ct (make-char-table 'fns-tests)))
+    (fillarray ct 'z)
+    (should (eq (char-table-range ct ?a) 'z))))
+
+(ert-deftest fns-tests-clear-string ()
+  (let ((s (propertize "é" 'foo 'bar)))
+    (clear-string s)
+    (should-not (multibyte-string-p s))
+    (should (equal s (make-string 2 0)))
+    (should-not (text-properties-at 0 s))))
+
+(ert-deftest fns-tests-load-average ()
+  (let ((res (condition-case err
+                 (list :ok (load-average) (load-average t))
+               (error (list :error err)))))
+    (pcase res
+      (`(:ok ,ints ,floats)
+       (should (listp ints))
+       (should (<= 1 (length ints) 3))
+       (dolist (v ints)
+         (should (integerp v))
+         (should (>= v 0)))
+       (should (listp floats))
+       (should (<= 1 (length floats) 3))
+       (dolist (v floats)
+         (should (floatp v))
+         (should (>= v 0.0))))
+      (`(:error ,err)
+       (should (string-match-p "load-average not implemented"
+                               (error-message-string err)))))))
+
+(ert-deftest fns-tests-locale-info ()
+  (let ((codeset (locale-info 'codeset)))
+    (should (or (null codeset) (stringp codeset))))
+  (let ((days (locale-info 'days)))
+    (should (or (null days) (and (vectorp days) (= (length days) 7)))))
+  (let ((months (locale-info 'months)))
+    (should (or (null months) (and (vectorp months) (= (length months) 12)))))
+  (let ((paper (locale-info 'paper)))
+    (should (or (null paper)
+                (and (consp paper)
+                     (= (length paper) 2)
+                     (integerp (car paper))
+                     (integerp (cadr paper))))))
+  (should-not (locale-info 'fns-tests-no-such-item)))
+
+(ert-deftest fns-tests-sxhash-eql ()
+  (let* ((a (1+ most-positive-fixnum))
+         (b (+ most-positive-fixnum 1)))
+    (should (eql a b))
+    (should (integerp (sxhash-eql a)))
+    (should (= (sxhash-eql a) (sxhash-eql b)))))
+
+(ert-deftest fns-tests-sxhash-equal-including-properties ()
+  (let ((a (propertize "foo" 'face 'bold))
+        (b (propertize "foo" 'face 'bold)))
+    (should (equal-including-properties a b))
+    (should (integerp (sxhash-equal-including-properties a)))
+    (should (= (sxhash-equal-including-properties a)
+               (sxhash-equal-including-properties b)))))
+
+(ert-deftest fns-tests-hash-table-metadata ()
+  (let ((h (make-hash-table :test 'equal)))
+    (puthash "a" 1 h)
+    (puthash "b" 2 h)
+    (should (= (hash-table-rehash-size h) 1.5))
+    (should (= (hash-table-rehash-threshold h) 0.8125))
+    (should (integerp (hash-table-size h)))
+    (should (>= (hash-table-size h) (hash-table-count h)))
+    (should (integerp (internal--hash-table-index-size h)))
+    (let ((hist (internal--hash-table-histogram h)))
+      (should (or (null hist)
+                  (and (consp hist)
+                       (consp (car hist))
+                       (integerp (caar hist))
+                       (integerp (cdar hist))))))
+    (let ((buckets (internal--hash-table-buckets h)))
+      (should (listp buckets))
+      (let ((keys (cl-loop for bucket in buckets
+                           append (mapcar #'car bucket))))
+        (should (member "a" keys))
+        (should (member "b" keys))))))
+
+(ert-deftest fns-tests-secure-hash-algorithms ()
+  (let ((algs (secure-hash-algorithms)))
+    (should (listp algs))
+    (should (memq 'md5 algs))
+    (should (memq 'sha1 algs))
+    (should (memq 'sha256 algs))))
+
 ;; Test that equality predicates work correctly on NaNs when combined
 ;; with hash tables based on those predicates.  This was not the case
 ;; for eql in Emacs 26.