From 40ff4512ad12fd29a5bea887fe77c3bddfa4caec Mon Sep 17 00:00:00 2001 From: "Eric S. Raymond" Date: Wed, 25 Feb 2026 18:25:58 -0500 Subject: [PATCH] More correctness tesrs for orinitives from fns.c. --- test/src/fns-tests.el | 127 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 127 insertions(+) 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.