From 5697ca55cb79817a6704c344cc76d866ee2e1699 Mon Sep 17 00:00:00 2001 From: Dmitry Antipov Date: Wed, 25 Jun 2014 14:36:51 +0400 Subject: [PATCH] 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. --- lisp/ChangeLog | 9 +++++ lisp/files.el | 17 ++++------ lisp/info.el | 4 +-- lisp/minibuffer.el | 6 ++-- lisp/subr.el | 10 +++--- src/ChangeLog | 8 +++++ src/fns.c | 65 +++++++++++++------------------------ test/ChangeLog | 4 +++ test/automated/fns-tests.el | 31 ++++++++++++++++++ 9 files changed, 90 insertions(+), 64 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 + + * 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 (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. diff --git a/src/ChangeLog b/src/ChangeLog index 9f676a6518d..fc47fbc8978 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2014-06-25 Dmitry Antipov + + Do not allow out-of-range character position in Fcompare_strings. + * 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. + 2014-06-24 Paul Eggert Be more consistent about the 'Qfoo' naming convention. diff --git a/src/fns.c b/src/fns.c index 5074ae3b41b..85e9f482fc1 100644 --- a/src/fns.c +++ b/src/fns.c @@ -50,7 +50,9 @@ static Lisp_Object Qcodeset, Qdays, Qmonths, Qpaper; static Lisp_Object Qmd5, Qsha1, Qsha224, Qsha256, Qsha384, Qsha512; static bool internal_equal (Lisp_Object, Lisp_Object, int, bool, Lisp_Object); - +static void validate_subarray (Lisp_Object, Lisp_Object, Lisp_Object, + ptrdiff_t, EMACS_INT *, EMACS_INT *); + DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0, doc: /* Return the argument unchanged. */) (Lisp_Object arg) @@ -232,6 +234,7 @@ string STR1, compare the part between START1 (inclusive) and END1 \(exclusive). If START1 is nil, it defaults to 0, the beginning of the string; if END1 is nil, it defaults to the length of the string. Likewise, in string STR2, compare the part between START2 and END2. +Like in `substring', negative values are counted from the end. The strings are compared by the numeric values of their characters. For instance, STR1 is "less than" STR2 if its first differing @@ -244,43 +247,25 @@ If string STR1 is less, the value is a negative number N; - 1 - N is the number of characters that match at the beginning. If string STR1 is greater, the value is a positive number N; N - 1 is the number of characters that match at the beginning. */) - (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case) + (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, + Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case) { - register ptrdiff_t end1_char, end2_char; - register ptrdiff_t i1, i1_byte, i2, i2_byte; + EMACS_INT from1, to1, from2, to2; + ptrdiff_t i1, i1_byte, i2, i2_byte; CHECK_STRING (str1); CHECK_STRING (str2); - if (NILP (start1)) - start1 = make_number (0); - if (NILP (start2)) - start2 = make_number (0); - CHECK_NATNUM (start1); - CHECK_NATNUM (start2); - if (! NILP (end1)) - CHECK_NATNUM (end1); - if (! NILP (end2)) - CHECK_NATNUM (end2); - - end1_char = SCHARS (str1); - if (! NILP (end1) && end1_char > XINT (end1)) - end1_char = XINT (end1); - if (end1_char < XINT (start1)) - args_out_of_range (str1, start1); - - end2_char = SCHARS (str2); - if (! NILP (end2) && end2_char > XINT (end2)) - end2_char = XINT (end2); - if (end2_char < XINT (start2)) - args_out_of_range (str2, start2); - - i1 = XINT (start1); - i2 = XINT (start2); + + validate_subarray (str1, start1, end1, SCHARS (str1), &from1, &to1); + validate_subarray (str2, start2, end2, SCHARS (str2), &from2, &to2); + + i1 = from1; + i2 = from2; i1_byte = string_char_to_byte (str1, i1); i2_byte = string_char_to_byte (str2, i2); - while (i1 < end1_char && i2 < end2_char) + while (i1 < to1 && i2 < to2) { /* When we find a mismatch, we must compare the characters, not just the bytes. */ @@ -307,12 +292,8 @@ If string STR1 is greater, the value is a positive number N; if (! NILP (ignore_case)) { - Lisp_Object tem; - - tem = Fupcase (make_number (c1)); - c1 = XINT (tem); - tem = Fupcase (make_number (c2)); - c2 = XINT (tem); + c1 = XINT (Fupcase (make_number (c1))); + c2 = XINT (Fupcase (make_number (c2))); } if (c1 == c2) @@ -322,15 +303,15 @@ If string STR1 is greater, the value is a positive number N; past the character that we are comparing; hence we don't add or subtract 1 here. */ if (c1 < c2) - return make_number (- i1 + XINT (start1)); + return make_number (- i1 + from1); else - return make_number (i1 - XINT (start1)); + return make_number (i1 - from1); } - if (i1 < end1_char) - return make_number (i1 - XINT (start1) + 1); - if (i2 < end2_char) - return make_number (- i1 + XINT (start1) - 1); + if (i1 < to1) + return make_number (i1 - from1 + 1); + if (i2 < to2) + return make_number (- i1 + from1 - 1); return Qt; } diff --git a/test/ChangeLog b/test/ChangeLog index 08492dd4c8f..3cb03b9f2f4 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,7 @@ +2014-06-25 Dmitry Antipov + + * automated/fns-tests.el (fns-tests-compare-string): New test. + 2014-06-24 Michael Albinus * automated/tramp-tests.el (tramp-test26-process-file): Extend test diff --git a/test/automated/fns-tests.el b/test/automated/fns-tests.el index 21a9e4536af..461995b602e 100644 --- a/test/automated/fns-tests.el +++ b/test/automated/fns-tests.el @@ -69,3 +69,34 @@ (nreverse A) (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)))))) + +(ert-deftest fns-tests-compare-strings () + (should-error (compare-strings)) + (should-error (compare-strings "xyzzy" "xyzzy")) + (should-error (compare-strings "xyzzy" 0 10 "zyxxy" 0 5)) + (should-error (compare-strings "xyzzy" 0 5 "zyxxy" -1 2)) + (should-error (compare-strings "xyzzy" 'foo nil "zyxxy" 0 1)) + (should-error (compare-strings "xyzzy" 0 'foo "zyxxy" 2 3)) + (should-error (compare-strings "xyzzy" 0 2 "zyxxy" 'foo 3)) + (should-error (compare-strings "xyzzy" nil 3 "zyxxy" 4 'foo)) + (should (compare-strings "" nil nil "" nil nil)) + (should (compare-strings "" 0 0 "" 0 0)) + (should (compare-strings "test" nil nil "test" nil nil)) + (should (compare-strings "test" nil nil "test" nil nil t)) + (should (compare-strings "test" nil nil "test" nil nil nil)) + (should (compare-strings "Test" nil nil "test" nil nil t)) + (should (= (compare-strings "Test" nil nil "test" nil nil) -1)) + (should (= (compare-strings "Test" nil nil "test" nil nil) -1)) + (should (= (compare-strings "test" nil nil "Test" nil nil) 1)) + (should (= (compare-strings "foobaz" nil nil "barbaz" nil nil) 1)) + (should (= (compare-strings "barbaz" nil nil "foobar" nil nil) -1)) + (should (= (compare-strings "foobaz" nil nil "farbaz" nil nil) 2)) + (should (= (compare-strings "farbaz" nil nil "foobar" nil nil) -2)) + (should (compare-strings "abcxyz" 0 2 "abcprq" 0 2)) + (should (compare-strings "abcxyz" 0 -3 "abcprq" 0 -3)) + (should (= (compare-strings "abcxyz" 0 6 "abcprq" 0 6) 4)) + (should (= (compare-strings "abcprq" 0 6 "abcxyz" 0 6) -4)) + (should (compare-strings "xyzzy" -3 4 "azza" -3 3)) + (should (compare-strings "こんにちはｺﾝﾆﾁﾊ" nil nil "こんにちはｺﾝﾆﾁﾊ" nil nil)) + (should (= (compare-strings "んにちはｺﾝﾆﾁﾊこ" nil nil "こんにちはｺﾝﾆﾁﾊ" nil nil) 1)) + (should (= (compare-strings "こんにちはｺﾝﾆﾁﾊ" nil nil "んにちはｺﾝﾆﾁﾊこ" nil nil) -1))) -- 2.39.2