; Merge from master.

6 files changed, 187 insertions, 6 deletions

diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 723ef4c710f..c080c483927 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -130,6 +130,49 @@
     (should (equal [nil nil nil nil nil t t t t t] (vconcat A)))
     (should (equal [t t t t t nil nil nil nil nil] (vconcat (nreverse A))))))
 
+(defconst fns-tests--string-lessp-cases
+  '((a 97 error)
+    (97 "a" error)
+    ("abc" "abd" t)
+    ("abd" "abc" nil)
+    (abc "abd" t)
+    ("abd" abc nil)
+    (abc abd t)
+    (abd abc nil)
+    ("" "" nil)
+    ("" " " t)
+    (" " "" nil)
+    ("abc" "abcd" t)
+    ("abcd" "abc" nil)
+    ("abc" "abc" nil)
+    (abc abc nil)
+    ("\0" "" nil)
+    ("" "\0" t)
+    ("~" "\x80" t)
+    ("\x80" "\x80" nil)
+    ("\xfe" "\xff" t)
+    ("Munchen" "München" t)
+    ("München" "Munchen" nil)
+    ("München" "München" nil)
+    ("Ré" "Réunion" t)))
+
+
+(ert-deftest fns-tests-string-lessp ()
+  ;; Exercise both `string-lessp' and its alias `string<', both directly
+  ;; and in a function (exercising its bytecode).
+  (dolist (lessp (list #'string-lessp #'string<
+                       (lambda (a b) (string-lessp a b))
+                       (lambda (a b) (string< a b))))
+    (ert-info ((prin1-to-string lessp) :prefix "function: ")
+      (dolist (case fns-tests--string-lessp-cases)
+        (ert-info ((prin1-to-string case) :prefix "case: ")
+          (pcase case
+            (`(,x ,y error)
+             (should-error (funcall lessp x y)))
+            (`(,x ,y ,expected)
+             (should (equal (funcall lessp x y) expected)))))))))
+
+
 (ert-deftest fns-tests-compare-strings ()
   (should-error (compare-strings))
   (should-error (compare-strings "xyzzy" "xyzzy"))
@@ -204,6 +247,76 @@
                  [-1 2 3 4 5 5 7 8 9]))
   (should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
                  [9 8 7 5 5 4 3 2 -1]))
+  ;; Sort a reversed list and vector.
+  (should (equal
+         (sort (reverse (number-sequence 1 1000)) (lambda (x y) (< x y)))
+         (number-sequence 1 1000)))
+  (should (equal
+           (sort (reverse (vconcat (number-sequence 1 1000)))
+                 (lambda (x y) (< x y)))
+         (vconcat (number-sequence 1 1000))))
+  ;; Sort a constant list and vector.
+  (should (equal
+           (sort (make-vector 100 1) (lambda (x y) (> x y)))
+           (make-vector 100 1)))
+  (should (equal
+           (sort (append (make-vector 100 1) nil) (lambda (x y) (> x y)))
+           (append (make-vector 100 1) nil)))
+  ;; Sort a long list and vector with every pair reversed.
+  (let ((vec (make-vector 100000 nil))
+        (logxor-vec (make-vector 100000 nil)))
+    (dotimes (i 100000)
+      (aset logxor-vec i  (logxor i 1))
+      (aset vec i i))
+    (should (equal
+             (sort logxor-vec (lambda (x y) (< x y)))
+             vec))
+    (should (equal
+             (sort (append logxor-vec nil) (lambda (x y) (< x y)))
+             (append vec nil))))
+  ;; Sort a list and vector with seven swaps.
+  (let ((vec (make-vector 100 nil))
+        (swap-vec (make-vector 100 nil)))
+    (dotimes (i 100)
+      (aset vec i (- i 50))
+      (aset swap-vec i (- i 50)))
+    (mapc (lambda (p)
+        (let ((tmp (elt swap-vec (car p))))
+          (aset swap-vec (car p) (elt swap-vec (cdr p)))
+          (aset swap-vec (cdr p) tmp)))
+          '((48 . 94) (75 . 77) (33 . 41) (92 . 52)
+            (10 . 96) (1 . 14) (43 . 81)))
+    (should (equal
+             (sort (copy-sequence swap-vec) (lambda (x y) (< x y)))
+             vec))
+    (should (equal
+             (sort (append swap-vec nil) (lambda (x y) (< x y)))
+             (append vec nil))))
+  ;; Check for possible corruption after GC.
+  (let* ((size 3000)
+         (complex-vec (make-vector size nil))
+         (vec (make-vector size nil))
+         (counter 0)
+         (my-counter (lambda ()
+                       (if (< counter 500)
+                           (cl-incf counter)
+                         (setq counter 0)
+                         (garbage-collect))))
+         (rand 1)
+         (generate-random
+          (lambda () (setq rand
+                           (logand (+ (* rand 1103515245) 12345)  2147483647)))))
+    ;; Make a complex vector and its sorted version.
+    (dotimes (i size)
+      (let ((r (funcall generate-random)))
+        (aset complex-vec i (cons r "a"))
+        (aset vec i (cons r "a"))))
+    ;; Sort it.
+    (should (equal
+             (sort complex-vec
+                   (lambda (x y) (funcall my-counter) (< (car x) (car y))))
+             (sort vec 'car-less-than-car))))
+  ;; Check for sorting stability.
   (should (equal
            (sort
             (vector
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 862f6a6595f..9ec54c719c8 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -258,5 +258,27 @@ literals (Bug#20852)."
   (should (equal (read "-0.e-5") -0.0))
   )
 
+(defun lread-test-read-and-print (str)
+  (let* ((read-circle t)
+         (print-circle t)
+         (val (read-from-string str)))
+    (if (consp val)
+        (prin1-to-string (car val))
+      (error "reading %S failed: %S" str val))))
+
+(defconst lread-test-circle-cases
+  '("#1=(#1# . #1#)"
+    "#1=[#1# a #1#]"
+    "#1=(#2=[#1# #2#] . #1#)"
+    "#1=(#2=[#1# #2#] . #2#)"
+    "#1=[#2=(#1# . #2#)]"
+    "#1=(#2=[#3=(#1# . #2#) #4=(#3# . #4#)])"
+    ))
+
+(ert-deftest lread-circle ()
+  (dolist (str lread-test-circle-cases)
+    (ert-info (str :prefix "input: ")
+      (should (equal (lread-test-read-and-print str) str))))
+  (should-error (read-from-string "#1=#1#") :type 'invalid-read-syntax))
 
 ;;; lread-tests.el ends here
diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 1ef0caf1a46..0bae1959d1b 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -417,5 +417,13 @@ otherwise, use a different charset."
            t)))
     (should (equal (prin1-to-string (make-marker)) ""))))
 
+(ert-deftest test-dots ()
+  (should (equal (prin1-to-string 'foo.bar) "foo.bar"))
+  (should (equal (prin1-to-string '.foo) "\\.foo"))
+  (should (equal (prin1-to-string '.foo.) "\\.foo."))
+  (should (equal (prin1-to-string 'bar?bar) "bar?bar"))
+  (should (equal (prin1-to-string '\?bar) "\\?bar"))
+  (should (equal (prin1-to-string '\?bar?) "\\?bar?")))
+
 (provide 'print-tests)
 ;;; print-tests.el ends here
diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el
index e6288d1fc9b..ff0d6be3f5d 100644
--- a/test/src/regex-emacs-tests.el
+++ b/test/src/regex-emacs-tests.el
@@ -157,8 +157,8 @@ are known failures, and are skipped."
 
 (defun regex-tests-compare (string what-failed bounds-ref &optional substring-ref)
   "I just ran a search, looking at STRING.  WHAT-FAILED describes
-what failed, if anything; valid values are 'search-failed,
-'compilation-failed and nil.  I compare the beginning/end of each
+what failed, if anything; valid values are `search-failed',
+`compilation-failed' and nil.  I compare the beginning/end of each
 group with their expected values.  This is done with either
 BOUNDS-REF or SUBSTRING-REF; one of those should be non-nil.
 BOUNDS-REF is a sequence [start-ref0 end-ref0 start-ref1
@@ -166,9 +166,9 @@ end-ref1 ....] while SUBSTRING-REF is the expected substring
 obtained by indexing the input string by start/end-ref.
 
 If the search was supposed to fail then start-ref0/substring-ref0
-is 'search-failed.  If the search wasn't even supposed to compile
+is `search-failed'.  If the search wasn't even supposed to compile
 successfully, then start-ref0/substring-ref0 is
-'compilation-failed.  If I only care about a match succeeding,
+`compilation-failed'.  If I only care about a match succeeding,
 this can be set to t.
 
 This function returns a string that describes the failure, or nil
@@ -259,8 +259,8 @@ BOUNDS-REF is a sequence [start-ref0 end-ref0 start-ref1 end-ref1
 ....].
 
 If the search was supposed to fail then start-ref0 is
-'search-failed.  If the search wasn't even supposed to compile
-successfully, then start-ref0 is 'compilation-failed.
+`search-failed'.  If the search wasn't even supposed to compile
+successfully, then start-ref0 is `compilation-failed'.
 
 This function returns a string that describes the failure, or nil
 on success"
diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el
index 6e44300f3ad..5af43923012 100644
--- a/test/src/sqlite-tests.el
+++ b/test/src/sqlite-tests.el
@@ -216,4 +216,29 @@
        db "/usr/lib/x86_64-linux-gnu/libsqlite3_mod_csvtable.so")
       '(nil t)))))
 
+(ert-deftest sqlite-blob ()
+  (skip-unless (sqlite-available-p))
+  (let (db)
+    (progn
+      (setq db (sqlite-open))
+      (sqlite-execute
+       db "create table if not exists test10 (col1 text, col2 blob, col3 numbre)")
+      (let ((string (with-temp-buffer
+                      (set-buffer-multibyte nil)
+                      (insert 0 1 2)
+                      (buffer-string))))
+        (should-not (multibyte-string-p string))
+        (sqlite-execute
+         db "insert into test10 values (?, ?, 1)"
+         (list string
+               (propertize string
+                           'coding-system 'binary)))
+        (cl-destructuring-bind
+            (c1 c2 _)
+            (car (sqlite-select db "select * from test10 where col3 = 1"))
+          (should (equal c1 string))
+          (should (equal c2 string))
+          (should (multibyte-string-p c1))
+          (should-not (multibyte-string-p c2)))))))
+
 ;;; sqlite-tests.el ends here
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index 1b49e0622f5..08d06f27d9e 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -169,6 +169,10 @@ a fixed place on the right and are padded on the left."
 (ert-deftest time-equal-p-nil-nil ()
   (should (time-equal-p nil nil)))
 
+(ert-deftest time-equal-p-NaN-NaN ()
+  (let ((x 0.0e+NaN))
+    (should (not (time-equal-p x x)))))
+
 (ert-deftest time-arith-tests ()
   (let ((time-values (list 0 -1 1 0.0 -0.0 -1.0 1.0
                            most-negative-fixnum most-positive-fixnum
@@ -221,6 +225,15 @@ a fixed place on the right and are padded on the left."
              (encode-time '(29 31 17 30 4 2019 2 t 7200))
              '(23752 27217))))
 
+(ert-deftest encode-time-alternate-apis ()
+  (let* ((time '(30 30 12 15 6 1970))
+         (time-1 (append time '(nil -1 nil)))
+         (etime (encode-time time)))
+    (should (time-equal-p etime (encode-time time-1)))
+    (should (time-equal-p etime (apply #'encode-time time)))
+    (should (time-equal-p etime (apply #'encode-time time-1)))
+    (should (time-equal-p etime (apply #'encode-time (append time '(nil)))))))
+
 (ert-deftest float-time-precision ()
   (should (= (float-time '(0 1 0 4025)) 1.000000004025))
   (should (= (float-time '(1000000004025 . 1000000000000)) 1.000000004025))