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.
This commit is contained in:
Dmitry Antipov
parent
9a214b9800
commit
5697ca55cb
9 changed files with 88 additions and 62 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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 "")))
|
||||
|
|
|
|||
10
lisp/subr.el
10
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.
|
||||
|
|
|
|||
|
|
@ -1,3 +1,11 @@
|
|||
2014-06-25 Dmitry Antipov <dmantipov@yandex.ru>
|
||||
|
||||
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 <eggert@cs.ucla.edu>
|
||||
|
||||
Be more consistent about the 'Qfoo' naming convention.
|
||||
|
|
|
|||
61
src/fns.c
61
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);
|
||||
validate_subarray (str1, start1, end1, SCHARS (str1), &from1, &to1);
|
||||
validate_subarray (str2, start2, end2, SCHARS (str2), &from2, &to2);
|
||||
|
||||
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);
|
||||
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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,3 +1,7 @@
|
|||
2014-06-25 Dmitry Antipov <dmantipov@yandex.ru>
|
||||
|
||||
* automated/fns-tests.el (fns-tests-compare-string): New test.
|
||||
|
||||
2014-06-24 Michael Albinus <michael.albinus@gmx.de>
|
||||
|
||||
* automated/tramp-tests.el (tramp-test26-process-file): Extend test
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue