Do not allow out-of-range character position in Fcompare_strings.

* src/fns.c (validate_subarray): Add prototype.
(Fcompare_substring): Use validate_subarray to check ranges.
Adjust comment to mention that the semantics was changed.  Also see
http://lists.gnu.org/archive/html/emacs-devel/2014-06/msg00447.html.
* lisp/files.el (dir-locals-find-file, file-relative-name):
* lisp/info.el (Info-complete-menu-item):
* lisp/minibuffer.el (completion-table-subvert): Prefer string-prefix-p
to compare-strings to avoid out-of-range errors.
* lisp/subr.el (string-prefix-p): Adjust to match strict range
checking in compare-strings.
* test/automated/fns-tests.el (fns-tests-compare-string): New test.

5 files changed, 24 insertions, 22 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 80cdb66425c..c3951a08c0a 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2014-06-25  Dmitry Antipov  <dmantipov@yandex.ru>
+
+        * files.el (dir-locals-find-file, file-relative-name):
+        * info.el (Info-complete-menu-item):
+        * minibuffer.el (completion-table-subvert): Prefer string-prefix-p
+        to compare-strings to avoid out-of-range errors.
+        * subr.el (string-prefix-p): Adjust to match strict range
+        checking in compare-strings.
+
 2014-06-24  Leonard Randall  <leonard.a.randall@gmail.com>  (tiny change)
 
         * textmodes/reftex-parse.el (reftex-using-biblatex-p): Make search
diff --git a/lisp/files.el b/lisp/files.el
index 9017cc96703..65f2009c7ce 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -3659,10 +3659,9 @@ of no valid cache entry."
 ;;;      (setq locals-file nil))
     ;; Find the best cached value in `dir-locals-directory-cache'.
     (dolist (elt dir-locals-directory-cache)
-      (when (and (eq t (compare-strings file nil (length (car elt))
-                                        (car elt) nil nil
-                                        (memq system-type
-                                              '(windows-nt cygwin ms-dos))))
+      (when (and (string-prefix-p (car elt) file
+                                  (memq system-type
+                                        '(windows-nt cygwin ms-dos)))
                  (> (length (car elt)) (length (car dir-elt))))
         (setq dir-elt elt)))
     (if (and dir-elt
@@ -4507,18 +4506,14 @@ on a DOS/Windows machine, it returns FILENAME in expanded form."
         (let ((ancestor ".")
               (filename-dir (file-name-as-directory filename)))
           (while (not
-                  (or
-                   (eq t (compare-strings filename-dir nil (length directory)
-                                          directory nil nil fold-case))
-                   (eq t (compare-strings filename nil (length directory)
-                                          directory nil nil fold-case))))
+                  (or (string-prefix-p directory filename-dir fold-case)
+                      (string-prefix-p directory filename fold-case)))
             (setq directory (file-name-directory (substring directory 0 -1))
                   ancestor (if (equal ancestor ".")
                                ".."
                              (concat "../" ancestor))))
           ;; Now ancestor is empty, or .., or ../.., etc.
-          (if (eq t (compare-strings filename nil (length directory)
-                                     directory nil nil fold-case))
+          (if (string-prefix-p directory filename fold-case)
               ;; We matched within FILENAME's directory part.
               ;; Add the rest of FILENAME onto ANCESTOR.
               (let ((rest (substring filename (length directory))))
diff --git a/lisp/info.el b/lisp/info.el
index 89ca8bdbe33..405d6a22449 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -2691,9 +2691,7 @@ Because of ambiguities, this should be concatenated with something like
                      (equal (nth 1 Info-complete-cache) Info-current-node)
                      (equal (nth 2 Info-complete-cache) Info-complete-next-re)
                      (equal (nth 5 Info-complete-cache) Info-complete-nodes)
-                     (let ((prev (nth 3 Info-complete-cache)))
-                       (eq t (compare-strings string 0 (length prev)
-                                              prev 0 nil t))))
+                     (string-prefix-p (nth 3 Info-complete-cache) string) t)
                 ;; We can reuse the previous list.
                 (setq completions (nth 4 Info-complete-cache))
               ;; The cache can't be used.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 7b252b4d46d..e7e08342b47 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -244,8 +244,7 @@ The result is a completion table which completes strings of the
 form (concat S1 S) in the same way as TABLE completes strings of
 the form (concat S2 S)."
   (lambda (string pred action)
-    (let* ((str (if (eq t (compare-strings string 0 (length s1) s1 nil nil
-                                           completion-ignore-case))
+    (let* ((str (if (string-prefix-p s1 string completion-ignore-case)
                     (concat s2 (substring string (length s1)))))
            (res (if str (complete-with-action action table str pred))))
       (when res
@@ -257,8 +256,7 @@ the form (concat S2 S)."
                     (+ beg (- (length s1) (length s2))))
               . ,(and (eq (car-safe res) 'boundaries) (cddr res)))))
          ((stringp res)
-          (if (eq t (compare-strings res 0 (length s2) s2 nil nil
-                                     completion-ignore-case))
+          (if (string-prefix-p s2 string completion-ignore-case)
               (concat s1 (substring res (length s2)))))
          ((eq action t)
           (let ((bounds (completion-boundaries str table pred "")))
diff --git a/lisp/subr.el b/lisp/subr.el
index 524b7954b7e..09a085288a5 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3677,12 +3677,14 @@ and replace a sub-expression, e.g.
       (setq matches (cons (substring string start l) matches)) ; leftover
       (apply #'concat (nreverse matches)))))
 
-(defun string-prefix-p (str1 str2 &optional ignore-case)
-  "Return non-nil if STR1 is a prefix of STR2.
+(defun string-prefix-p (prefix string &optional ignore-case)
+  "Return non-nil if PREFIX is a prefix of STRING.
 If IGNORE-CASE is non-nil, the comparison is done without paying attention
 to case differences."
-  (eq t (compare-strings str1 nil nil
-                         str2 0 (length str1) ignore-case)))
+  (let ((prefix-length (length prefix)))
+    (if (> prefix-length (length string)) nil
+      (eq t (compare-strings prefix 0 prefix-length string
+                             0 prefix-length ignore-case)))))
 
 (defun string-suffix-p (suffix string  &optional ignore-case)
   "Return non-nil if SUFFIX is a suffix of STRING.