commit 01030eed9395f5004e7d0721394697d1ca90cc2f (HEAD, refs/remotes/origin/master) Author: Paul Eggert Date: Mon May 30 23:19:54 2016 -0700 ; Spelling fixes diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index afd8e4e..424b8e3 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -967,7 +967,7 @@ write its autoloads into the specified file instead." t files-re)) dirs))) (done ()) ;Files processed; to remove duplicates. - (changed nil) ;Non-nil if some change occured. + (changed nil) ;Non-nil if some change occurred. (last-time) ;; Files with no autoload cookies or whose autoloads go to other ;; files because of file-local autoload-generated-file settings. diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el index a6984b8..d4b5cd2 100644 --- a/lisp/emacs-lisp/radix-tree.el +++ b/lisp/emacs-lisp/radix-tree.el @@ -38,7 +38,7 @@ ;; of array, so every level's lookup is O(N) rather than O(1). We could easily ;; solve this by using char-tables instead of alists, but that would make every ;; level take up a lot more memory, and it would make the resulting -;; datastructure harder to read (by a human) when printed out. +;; data structure harder to read (by a human) when printed out. ;;; Code: diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 9677392..ac390e5 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -410,7 +410,7 @@ Every entry is a list (NAME ADDRESS).") (defconst tramp-gvfs-file-attributes '("type" "standard::display-name" - ;; We don't need this one. It is used as delimeter in case the + ;; We don't need this one. It is used as delimiter in case the ;; display name contains spaces, which is hard to parse. "standard::icon" "standard::symlink-target" diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index bfa3cc6..e9f78b7 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -4717,7 +4717,7 @@ connection if a previous connection has died for some reason." (options (tramp-ssh-controlmaster-options vec)) (process-connection-type tramp-process-connection-type) (process-adaptive-read-buffering nil) - ;; There are unfortune settings for "cmdproxy" on + ;; There are unfortunate settings for "cmdproxy" on ;; W32 systems. (process-coding-system-alist nil) (coding-system-for-read nil) commit 0c26f14b7e200b39134ec70c77fab8c467cf3290 Author: Stefan Monnier Date: Mon May 30 23:22:49 2016 -0400 * lisp/emacs-lisp/autoload.el: Use radix-tree. (autoload--make-defs-autoload): Rewrite. (autoload--split-prefixes-1): Remove. (autoload-def-prefixes-max-entries): Rename from autoload-defs-autoload-max-size. (autoload-popular-prefixes): Remove. (autoload-def-prefixes-max-length): New const. * lisp/emacs-lisp/radix-tree.el: New file. diff --git a/etc/NEWS b/etc/NEWS index 185b1a4..80b8036 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -360,6 +360,8 @@ See the 'vc-faces' customization group. * New Modes and Packages in Emacs 25.2 +** New Elisp data-structure library `radix-tree'. + * Incompatible Lisp Changes in Emacs 25.2 diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index 11316f1..afd8e4e 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -500,41 +500,26 @@ Return non-nil in the case where no autoloads were added at point." (let ((generated-autoload-file buffer-file-name)) (autoload-generate-file-autoloads file (current-buffer)))) -(defun autoload--split-prefixes-1 (strs) - (let ((prefixes ())) - (dolist (str strs) - (string-match "\\`[^-:/_]*[-:/_]*" str) - (let* ((prefix (match-string 0 str)) - (tail (substring str (match-end 0))) - (cell (assoc prefix prefixes))) - (cond - ((null cell) (push (list prefix tail) prefixes)) - ((equal (cadr cell) tail) nil) - (t (setcdr cell (cons tail (cdr cell))))))) - prefixes)) - (defvar autoload-compute-prefixes t "If non-nil, autoload will add code to register the prefixes used in a file. Standard prefixes won't be registered anyway. I.e. if a file \"foo.el\" defines variables or functions that use \"foo-\" as prefix, that will not be registered. But all other prefixes will be included.") -(defconst autoload-defs-autoload-max-size 5 +(defconst autoload-def-prefixes-max-entries 5 "Target length of the list of definition prefixes per file. If set too small, the prefixes will be too generic (i.e. they'll use little memory, we'll end up looking in too many files when we need a particular prefix), and if set too large, they will be too specific (i.e. they will cost more memory use).") -(defvar autoload-popular-prefixes nil) +(defconst autoload-def-prefixes-max-length 12 + "Target size of definition prefixes. +Don't try to split prefixes that are already longer than that.") + +(require 'radix-tree) (defun autoload--make-defs-autoload (defs file) - ;; FIXME: avoid redundant entries. E.g. opascal currently has - ;; "opascal-" "opascal--literal-start-re" "opascal--syntax-propertize" - ;; where only the first one should be kept. - ;; FIXME: Avoid keeping too-long-prefixes. E.g. ob-scheme currently has - ;; "org-babel-scheme-" "org-babel-default-header-args:scheme" - ;; "org-babel-expand-body:scheme" "org-babel-execute:scheme". ;; Remove the defs that obey the rule that file foo.el (or ;; foo-mode.el) uses "foo-" as prefix. @@ -548,39 +533,32 @@ cost more memory use).") ;; Then compute a small set of prefixes that cover all the ;; remaining definitions. - (let ((prefixes (autoload--split-prefixes-1 defs)) - (again t)) - ;; (message "Initial prefixes %s : %S" file (mapcar #'car prefixes)) - (while again - (setq again nil) - (let ((newprefixes - (sort - (mapcar (lambda (cell) - (cons cell - (autoload--split-prefixes-1 (cdr cell)))) - prefixes) - (lambda (x y) (< (length (cdr x)) (length (cdr y))))))) - (setq prefixes nil) - (while newprefixes - (let ((x (pop newprefixes))) - (if (or (equal '("") (cdar x)) - (and (cddr x) - (not (member (caar x) - autoload-popular-prefixes)) - (> (+ (length prefixes) (length newprefixes) - (length (cdr x))) - autoload-defs-autoload-max-size))) - ;; Nothing to split or would split too deep. - (push (car x) prefixes) - ;; (message "Expand %S to %S" (caar x) (cdr x)) - (setq again t) - (setq prefixes - (nconc (mapcar (lambda (cell) - (cons (concat (caar x) - (car cell)) - (cdr cell))) - (cdr x)) - prefixes))))))) + (let* ((tree (let ((tree radix-tree-empty)) + (dolist (def defs) + (setq tree (radix-tree-insert tree def t))) + tree)) + (prefixes (list (cons "" tree)))) + (while + (let ((newprefixes nil) + (changes nil)) + (dolist (pair prefixes) + (let ((prefix (car pair))) + (if (or (> (length prefix) autoload-def-prefixes-max-length) + (radix-tree-lookup (cdr pair) "")) + ;; No point splitting it any further. + (push pair newprefixes) + (setq changes t) + (radix-tree-iter-subtrees + (cdr pair) (lambda (sprefix subtree) + (push (cons (concat prefix sprefix) subtree) + newprefixes)))))) + (and changes + (or (and (null (cdr prefixes)) (equal "" (caar prefixes))) + (<= (length newprefixes) + autoload-def-prefixes-max-entries)) + (setq prefixes newprefixes) + (< (length prefixes) autoload-def-prefixes-max-entries)))) + ;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes)) (when prefixes `(if (fboundp 'register-definition-prefixes) diff --git a/lisp/emacs-lisp/radix-tree.el b/lisp/emacs-lisp/radix-tree.el new file mode 100644 index 0000000..a6984b8 --- /dev/null +++ b/lisp/emacs-lisp/radix-tree.el @@ -0,0 +1,188 @@ +;;; radix-tree.el --- A simple library of radix trees -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Stefan Monnier +;; Keywords: + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; There are many different options for how to represent radix trees +;; in Elisp. Here I chose a very simple one. A radix-tree can be either: +;; - a node, of the form ((PREFIX . PTREE) . RTREE) where PREFIX is a string +;; meaning that everything that starts with PREFIX is in PTREE, +;; and everything else in RTREE. It also has the property that +;; everything that starts with the first letter of PREFIX but not with +;; that whole PREFIX is not in RTREE (i.e. is not in the tree at all). +;; - anything else is taken as the value to associate with the empty string. +;; So every node is basically an (improper) alist where each mapping applies +;; to a different leading letter. +;; +;; The main downside of this representation is that the lookup operation +;; is slower because each level of the tree is an alist rather than some kind +;; of array, so every level's lookup is O(N) rather than O(1). We could easily +;; solve this by using char-tables instead of alists, but that would make every +;; level take up a lot more memory, and it would make the resulting +;; datastructure harder to read (by a human) when printed out. + +;;; Code: + +(defun radix-tree--insert (tree key val i) + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (compare-strings prefix nil nil key i ni))) + (if (eq t cmp) + (let ((nptree (radix-tree--insert ptree key val ni))) + `((,prefix . ,nptree) . ,rtree)) + (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) + (if (zerop n) + (let ((nrtree (radix-tree--insert rtree key val i))) + `((,prefix . ,ptree) . ,nrtree)) + (let* ((nprefix (substring prefix 0 n)) + (kprefix (substring key (+ i n))) + (pprefix (substring prefix n)) + (ktree (if (equal kprefix "") val + `((,kprefix . ,val))))) + `((,nprefix + . ((,pprefix . ,ptree) . ,ktree)) + . ,rtree))))))) + (_ + (if (= (length key) i) val + (let ((prefix (substring key i))) + `((,prefix . ,val) . ,tree)))))) + +(defun radix-tree--remove (tree key i) + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (compare-strings prefix nil nil key i ni))) + (if (eq t cmp) + (pcase (radix-tree--remove ptree key ni) + (`nil rtree) + (`((,pprefix . ,pptree)) + `((,(concat prefix pprefix) . ,pptree) . ,rtree)) + (nptree `((,prefix . ,nptree) . ,rtree))) + (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) + (if (zerop n) + (let ((nrtree (radix-tree--remove rtree key i))) + `((,prefix . ,ptree) . ,nrtree)) + tree))))) + (_ + (if (= (length key) i) nil tree)))) + + +(defun radix-tree--lookup (tree string i) + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (compare-strings prefix nil nil string i ni))) + (if (eq t cmp) + (radix-tree--lookup ptree string ni) + (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) + (if (zerop n) + (radix-tree--lookup rtree string i) + (+ i n)))))) + (val + (if (and val (equal (length string) i)) + (if (integerp val) `(t . ,val) val) + i)))) + +(defun radix-tree--subtree (tree string i) + (if (equal (length string) i) tree + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (let* ((ni (+ i (length prefix))) + (cmp (compare-strings prefix nil nil string i ni))) + (if (eq t cmp) + (radix-tree--subtree ptree string ni) + (let ((n (if (< cmp 0) (- -1 cmp) (- cmp 1)))) + (cond + ((zerop n) (radix-tree--subtree rtree string i)) + ((equal (+ n i) (length string)) + (let ((nprefix (substring prefix n))) + `((,nprefix . ,ptree)))) + (t nil)))))) + (_ nil)))) + +;;; Entry points + +(defconst radix-tree-empty nil + "The empty radix-tree.") + +(defun radix-tree-insert (tree key val) + "Insert a mapping from KEY to VAL in radix TREE." + (when (consp val) (setq val `(t . ,val))) + (if val (radix-tree--insert tree key val 0) + (radix-tree--remove tree key 0))) + +(defun radix-tree-lookup (tree key) + "Return the value associated to KEY in radix TREE. +If not found, return nil." + (pcase (radix-tree--lookup tree key 0) + (`(t . ,val) val) + ((pred numberp) nil) + (val val))) + +(defun radix-tree-subtree (tree string) + "Return the subtree of TREE rooted at the prefix STRING." + (radix-tree--subtree tree string 0)) + +(eval-and-compile + (pcase-defmacro radix-tree-leaf (vpat) + ;; FIXME: We'd like to use a negative pattern (not consp), but pcase + ;; doesn't support it. Using `atom' works but generates sub-optimal code. + `(or `(t . ,,vpat) (and (pred atom) ,vpat)))) + +(defun radix-tree-iter-subtrees (tree fun) + "Apply FUN to every immediate subtree of radix TREE. +FUN is called with two arguments: PREFIX and SUBTREE. +You can test if SUBTREE is a leaf (and extract its value) with the +pcase pattern (radix-tree-leaf PAT)." + (while tree + (pcase tree + (`((,prefix . ,ptree) . ,rtree) + (funcall fun prefix ptree) + (setq tree rtree)) + (_ (funcall fun "" tree) + (setq tree nil))))) + +(defun radix-tree-iter-mappings (tree fun &optional prefix) + "Apply FUN to every mapping in TREE. +FUN is called with two arguments: KEY and VAL. +PREFIX is only used internally." + (radix-tree-iter-subtrees + tree + (lambda (p s) + (let ((nprefix (concat prefix p))) + (pcase s + ((radix-tree-leaf v) (funcall fun nprefix v)) + (_ (radix-tree-iter-mappings s fun nprefix))))))) + +;; (defun radix-tree->alist (tree) +;; (let ((al nil)) +;; (radix-tree-iter-mappings tree (lambda (p v) (push (cons p v) al))) +;; al)) + +(defun radix-tree-count (tree) + (let ((i 0)) + (radix-tree-iter-mappings tree (lambda (_ _) (setq i (1+ i)))) + i)) + +(provide 'radix-tree) +;;; radix-tree.el ends here commit 1992075d990ecf780225f446ec3f616bf821d89e Author: Ken Brown Date: Mon May 30 22:22:08 2016 -0400 * src/conf_post.h (SYSTEM_PURESIZE_EXTRA) [CYGWIN]: Increase. diff --git a/src/conf_post.h b/src/conf_post.h index f16f8ee..bea2a8a 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -181,7 +181,7 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ #endif #ifdef CYGWIN -#define SYSTEM_PURESIZE_EXTRA 10000 +#define SYSTEM_PURESIZE_EXTRA 50000 #endif #if defined HAVE_NTGUI && !defined DebPrint commit 237244bbd5ce753bcdf79634561de515bd76c687 Author: Paul Eggert Date: Mon May 30 16:09:25 2016 -0700 Omit IF_LINT code that no longer seems needed Nowadays GCC is smarter, or the Emacs code has mutated, or both, and now is as good a time as any to remove uses of IF_LINT that now seem to be unnecessary. * lib-src/emacsclient.c (set_local_socket): * lib-src/movemail.c (main) [MAIL_USE_MAILLOCK && HAVE_TOUCHLOCK]: * src/buffer.c (fix_start_end_in_overlays, fix_overlays_before): * src/casefiddle.c (casify_region): * src/charset.c (load_charset_map): * src/coding.c (decode_coding_object, encode_coding_object): * src/data.c (Fmake_variable_buffer_local, Fmake_local_variable) (cons_to_unsigned, cons_to_signed): * src/frame.c (make_frame, x_set_frame_parameters): * src/keyboard.c (read_event_from_main_queue): * src/regex.c (regex_compile): * src/syntax.c (back_comment): * src/window.c (Frecenter): * src/xfaces.c (Fx_list_fonts): Remove IF_LINT that no longer seems necessary. * src/image.c (png_load_body, jpeg_load_body): Simplify use of IF_LINT. * src/keyboard.c (read_char): Use IF_LINT (volatile) rather than a pragma dance to pacify GCC -Wclobbered. * src/xdisp.c (x_produce_glyphs): Rewrite to avoid need for IF_LINT. * src/xterm.c (x_connection_closed): Now _Noreturn, which should mean we do not need IF_LINT any more. (x_io_error_quitter): Now _Noreturn. Put an 'assume (false)’ at the end, to forestall warnings from older compilers. diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index aab9c4b..7792d0a 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1195,7 +1195,7 @@ set_local_socket (const char *local_socket_name) int use_tmpdir = 0; int saved_errno; const char *server_name = local_socket_name; - const char *tmpdir IF_LINT ( = NULL); + const char *tmpdir; char *tmpdir_storage = NULL; char *socket_name_storage = NULL; diff --git a/lib-src/movemail.c b/lib-src/movemail.c index 90e683e..45779da 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -338,7 +338,7 @@ main (int argc, char **argv) int lockcount = 0; int status = 0; #if defined (MAIL_USE_MAILLOCK) && defined (HAVE_TOUCHLOCK) - time_t touched_lock IF_LINT (= 0); + time_t touched_lock; #endif if (setuid (getuid ()) < 0 || setregid (-1, real_gid) < 0) diff --git a/src/buffer.c b/src/buffer.c index 55a16b2..534b9e4 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -3552,8 +3552,8 @@ void fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end) { Lisp_Object overlay; - struct Lisp_Overlay *before_list IF_LINT (= NULL); - struct Lisp_Overlay *after_list IF_LINT (= NULL); + struct Lisp_Overlay *before_list; + struct Lisp_Overlay *after_list; /* These are either nil, indicating that before_list or after_list should be assigned, or the cons cell the cdr of which should be assigned. */ @@ -3700,7 +3700,7 @@ fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos) /* If parent is nil, replace overlays_before; otherwise, parent->next. */ struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair; Lisp_Object tem; - ptrdiff_t end IF_LINT (= 0); + ptrdiff_t end; /* After the insertion, the several overlays may be in incorrect order. The possibility is that, in the list `overlays_before', diff --git a/src/casefiddle.c b/src/casefiddle.c index c5bfa36..34a65ed 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -196,7 +196,7 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e) ptrdiff_t start_byte; /* Position of first and last changes. */ - ptrdiff_t first = -1, last IF_LINT (= 0); + ptrdiff_t first = -1, last; ptrdiff_t opoint = PT; ptrdiff_t opoint_byte = PT_BYTE; diff --git a/src/charset.c b/src/charset.c index 264036a..1a13584 100644 --- a/src/charset.c +++ b/src/charset.c @@ -240,7 +240,7 @@ struct charset_map_entries static void load_charset_map (struct charset *charset, struct charset_map_entries *entries, int n_entries, int control_flag) { - Lisp_Object vec IF_LINT (= Qnil), table IF_LINT (= Qnil); + Lisp_Object vec, table IF_LINT (= Qnil); unsigned max_code = CHARSET_MAX_CODE (charset); bool ascii_compatible_p = charset->ascii_compatible_p; int min_char, max_char, nonascii_min_char; diff --git a/src/coding.c b/src/coding.c index 7d19956..9d75ef9 100644 --- a/src/coding.c +++ b/src/coding.c @@ -8015,12 +8015,12 @@ decode_coding_object (struct coding_system *coding, Lisp_Object dst_object) { ptrdiff_t count = SPECPDL_INDEX (); - unsigned char *destination IF_LINT (= NULL); - ptrdiff_t dst_bytes IF_LINT (= 0); + unsigned char *destination; + ptrdiff_t dst_bytes; ptrdiff_t chars = to - from; ptrdiff_t bytes = to_byte - from_byte; Lisp_Object attrs; - ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0); + ptrdiff_t saved_pt = -1, saved_pt_byte; bool need_marker_adjustment = 0; Lisp_Object old_deactivate_mark; @@ -8198,7 +8198,7 @@ encode_coding_object (struct coding_system *coding, ptrdiff_t chars = to - from; ptrdiff_t bytes = to_byte - from_byte; Lisp_Object attrs; - ptrdiff_t saved_pt = -1, saved_pt_byte IF_LINT (= 0); + ptrdiff_t saved_pt = -1, saved_pt_byte; bool need_marker_adjustment = 0; bool kill_src_buffer = 0; Lisp_Object old_deactivate_mark; diff --git a/src/data.c b/src/data.c index 2574cbb..71da916 100644 --- a/src/data.c +++ b/src/data.c @@ -1614,8 +1614,8 @@ The function `default-value' gets the default value and `set-default' sets it. { struct Lisp_Symbol *sym; struct Lisp_Buffer_Local_Value *blv = NULL; - union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO}); - bool forwarded IF_LINT (= 0); + union Lisp_Val_Fwd valcontents; + bool forwarded; CHECK_SYMBOL (variable); sym = XSYMBOL (variable); @@ -1692,8 +1692,8 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) (Lisp_Object variable) { Lisp_Object tem; - bool forwarded IF_LINT (= 0); - union Lisp_Val_Fwd valcontents IF_LINT (= {LISP_INITIALLY_ZERO}); + bool forwarded; + union Lisp_Val_Fwd valcontents; struct Lisp_Symbol *sym; struct Lisp_Buffer_Local_Value *blv = NULL; @@ -2458,7 +2458,7 @@ uintmax_t cons_to_unsigned (Lisp_Object c, uintmax_t max) { bool valid = 0; - uintmax_t val IF_LINT (= 0); + uintmax_t val; if (INTEGERP (c)) { valid = 0 <= XINT (c); @@ -2511,7 +2511,7 @@ intmax_t cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) { bool valid = 0; - intmax_t val IF_LINT (= 0); + intmax_t val; if (INTEGERP (c)) { val = XINT (c); diff --git a/src/frame.c b/src/frame.c index 1c5c12c..df97539 100644 --- a/src/frame.c +++ b/src/frame.c @@ -609,7 +609,7 @@ make_frame (bool mini_p) { Lisp_Object frame; struct frame *f; - struct window *rw, *mw IF_LINT (= NULL); + struct window *rw, *mw; Lisp_Object root_window; Lisp_Object mini_window; @@ -3089,7 +3089,7 @@ x_set_frame_parameters (struct frame *f, Lisp_Object alist) /* If both of these parameters are present, it's more efficient to set them both at once. So we wait until we've looked at the entire list before we set them. */ - int width IF_LINT (= 0), height IF_LINT (= 0); + int width, height; bool width_change = false, height_change = false; /* Same here. */ diff --git a/src/image.c b/src/image.c index c1f25aa..0991f57 100644 --- a/src/image.c +++ b/src/image.c @@ -5895,12 +5895,13 @@ static bool png_load_body (struct frame *f, struct image *img, struct png_load_context *c) { Lisp_Object specified_file; - Lisp_Object specified_data; + /* IF_LINT (volatile) works around GCC bug 54561. */ + Lisp_Object IF_LINT (volatile) specified_data; + FILE * IF_LINT (volatile) fp = NULL; int x, y; ptrdiff_t i; png_struct *png_ptr; png_info *info_ptr = NULL, *end_info = NULL; - FILE *fp = NULL; png_byte sig[8]; png_byte *pixels = NULL; png_byte **rows = NULL; @@ -5922,7 +5923,6 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) /* Find out what file to load. */ specified_file = image_spec_value (img->spec, QCfile, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL); - IF_LINT (Lisp_Object volatile specified_data_volatile = specified_data); if (NILP (specified_data)) { @@ -6018,10 +6018,6 @@ png_load_body (struct frame *f, struct image *img, struct png_load_context *c) return 0; } - /* Silence a bogus diagnostic; see GCC bug 54561. */ - IF_LINT (fp = c->fp); - IF_LINT (specified_data = specified_data_volatile); - /* Read image info. */ if (!NILP (specified_data)) png_set_read_fn (png_ptr, &tbr, png_read_from_memory); @@ -6672,9 +6668,9 @@ jpeg_load_body (struct frame *f, struct image *img, struct my_jpeg_error_mgr *mgr) { Lisp_Object specified_file; - Lisp_Object specified_data; - /* The 'volatile' silences a bogus diagnostic; see GCC bug 54561. */ - FILE * IF_LINT (volatile) fp = NULL; + /* IF_LINT (volatile) works around GCC bug 54561. */ + Lisp_Object IF_LINT (volatile) specified_data; + FILE *volatile fp = NULL; JSAMPARRAY buffer; int row_stride, x, y; unsigned long *colors; @@ -6687,7 +6683,6 @@ jpeg_load_body (struct frame *f, struct image *img, /* Open the JPEG file. */ specified_file = image_spec_value (img->spec, QCfile, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL); - IF_LINT (Lisp_Object volatile specified_data_volatile = specified_data); if (NILP (specified_data)) { @@ -6751,9 +6746,6 @@ jpeg_load_body (struct frame *f, struct image *img, return 0; } - /* Silence a bogus diagnostic; see GCC bug 54561. */ - IF_LINT (specified_data = specified_data_volatile); - /* Create the JPEG decompression object. Let it read from fp. Read the JPEG image header. */ jpeg_CreateDecompress (&mgr->cinfo, JPEG_LIB_VERSION, sizeof *&mgr->cinfo); diff --git a/src/keyboard.c b/src/keyboard.c index 2b5d514..d2976cb 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2122,7 +2122,7 @@ read_event_from_main_queue (struct timespec *end_time, { Lisp_Object c = Qnil; sys_jmp_buf save_jump; - KBOARD *kb IF_LINT (= NULL); + KBOARD *kb; start: @@ -2280,11 +2280,6 @@ read_decoded_event_from_main_queue (struct timespec *end_time, } } -#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) -# pragma GCC diagnostic push -# pragma GCC diagnostic ignored "-Wclobbered" -#endif - /* Read a character from the keyboard; call the redisplay if needed. */ /* commandflag 0 means do not autosave, but do redisplay. -1 means do not redisplay, but do autosave. @@ -2317,7 +2312,9 @@ read_char (int commandflag, Lisp_Object map, Lisp_Object prev_event, bool *used_mouse_menu, struct timespec *end_time) { - Lisp_Object c; + /* IF_LINT (volatile) works around GCC bug 54561. */ + Lisp_Object IF_LINT (volatile) c; + ptrdiff_t jmpcount; sys_jmp_buf local_getcjmp; sys_jmp_buf save_jump; @@ -3125,10 +3122,6 @@ read_char (int commandflag, Lisp_Object map, return c; } -#if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) -# pragma GCC diagnostic pop -#endif - /* Record a key that came from a mouse menu. Record it for echoing, for this-command-keys, and so on. */ diff --git a/src/regex.c b/src/regex.c index 05587da..fc2a46f 100644 --- a/src/regex.c +++ b/src/regex.c @@ -2465,9 +2465,9 @@ regex_compile (const_re_char *pattern, size_t size, reg_syntax_t syntax, /* These hold the values of p, pattern, and pend from the main pattern when we have pushed into a subpattern. */ - re_char *main_p IF_LINT (= NULL); - re_char *main_pattern IF_LINT (= NULL); - re_char *main_pend IF_LINT (= NULL); + re_char *main_p; + re_char *main_pattern; + re_char *main_pend; #ifdef DEBUG debug++; diff --git a/src/syntax.c b/src/syntax.c index fc8c666..1c3f644 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -708,7 +708,7 @@ back_comment (ptrdiff_t from, ptrdiff_t from_byte, ptrdiff_t stop, ptrdiff_t comment_end = from; ptrdiff_t comment_end_byte = from_byte; ptrdiff_t comstart_pos = 0; - ptrdiff_t comstart_byte IF_LINT (= 0); + ptrdiff_t comstart_byte; /* Place where the containing defun starts, or 0 if we didn't come across it yet. */ ptrdiff_t defun_start = 0; diff --git a/src/window.c b/src/window.c index cf7fa44..99a0709 100644 --- a/src/window.c +++ b/src/window.c @@ -5693,7 +5693,7 @@ and redisplay normally--don't erase and redraw the frame. */) struct buffer *buf = XBUFFER (w->contents); bool center_p = false; ptrdiff_t charpos, bytepos; - EMACS_INT iarg IF_LINT (= 0); + EMACS_INT iarg; int this_scroll_margin; if (buf != current_buffer) diff --git a/src/xdisp.c b/src/xdisp.c index e78d3d6..d2f0d49 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -27342,18 +27342,21 @@ x_produce_glyphs (struct it *it) int leftmost, rightmost, lowest, highest; int lbearing, rbearing; int i, width, ascent, descent; - int c IF_LINT (= 0); /* cmp->glyph_len can't be zero; see Bug#8512 */ + int c; XChar2b char2b; struct font_metrics *pcm; ptrdiff_t pos; - for (glyph_len = cmp->glyph_len; glyph_len > 0; glyph_len--) - if ((c = COMPOSITION_GLYPH (cmp, glyph_len - 1)) != '\t') - break; + eassume (0 < glyph_len); /* See Bug#8512. */ + do + c = COMPOSITION_GLYPH (cmp, --glyph_len); + while (c == '\t' && 0 < glyph_len); + bool right_padded = glyph_len < cmp->glyph_len; for (i = 0; i < glyph_len; i++) { - if ((c = COMPOSITION_GLYPH (cmp, i)) != '\t') + c = COMPOSITION_GLYPH (cmp, i); + if (c != '\t') break; cmp->offsets[i * 2] = cmp->offsets[i * 2 + 1] = 0; } diff --git a/src/xfaces.c b/src/xfaces.c index 3ced1d4..de73c01 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1519,7 +1519,7 @@ the WIDTH times as wide as FACE on FRAME. */) Lisp_Object maximum, Lisp_Object width) { struct frame *f; - int size, avgwidth IF_LINT (= 0); + int size, avgwidth; check_window_system (NULL); CHECK_STRING (pattern); diff --git a/src/xterm.c b/src/xterm.c index beef61d..9fb19a1 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -9393,7 +9393,7 @@ static char *error_msg; /* Handle the loss of connection to display DPY. ERROR_MESSAGE is the text of an error message that lead to the connection loss. */ -static void +static _Noreturn void x_connection_closed (Display *dpy, const char *error_message, bool ioerror) { struct x_display_info *dpyinfo = x_display_info_for_display (dpy); @@ -9491,9 +9491,6 @@ For details, see etc/PROBLEMS.\n", unbind_to (idx, Qnil); clear_waiting_for_input (); - /* Tell GCC not to suggest attribute 'noreturn' for this function. */ - IF_LINT (if (! terminal_list) return; ) - /* Here, we absolutely have to use a non-local exit (e.g. signal, throw, longjmp), because returning from this function would get us back into Xlib's code which will directly call `exit'. */ @@ -9559,7 +9556,7 @@ x_error_quitter (Display *display, XErrorEvent *event) It kills all frames on the display that we lost touch with. If that was the only one, it prints an error message and kills Emacs. */ -static int +static _Noreturn int x_io_error_quitter (Display *display) { char buf[256]; @@ -9567,7 +9564,7 @@ x_io_error_quitter (Display *display) snprintf (buf, sizeof buf, "Connection lost to X server '%s'", DisplayString (display)); x_connection_closed (display, buf, true); - return 0; + assume (false); } /* Changing the font of the frame. */ commit cb379cbb7fc617f897e7dbc3ce45bf99ea3d1f87 Author: Paul Eggert Date: Mon May 30 16:09:25 2016 -0700 Port --enable-gcc-warnings to Cygwin, FreeBSD These platforms have a bug where _Noreturn is empty when 'lint' is defined. Problem reported by Ken Brown (Bug#23640). * configure.ac (GCC_LINT): Rename from 'lint'. * src/conf_post.h (IF_LINT): Use GCC_LINT, not just 'lint’. diff --git a/configure.ac b/configure.ac index e88a3a9..37a159f 100644 --- a/configure.ac +++ b/configure.ac @@ -997,7 +997,7 @@ AS_IF([test $gl_gcc_warnings = no], gl_WARN_ADD([-Wno-pointer-sign]) fi - AC_DEFINE([lint], [1], [Define to 1 if the compiler is checking for lint.]) + AC_DEFINE([GCC_LINT], [1], [Define to 1 if --enable-gcc-warnings.]) AC_DEFINE([GNULIB_PORTCHECK], [1], [enable some gnulib portability checks]) AH_VERBATIM([GNULIB_PORTCHECK_FORTIFY_SOURCE], [/* Enable compile-time and run-time bounds-checking, and some warnings, diff --git a/src/conf_post.h b/src/conf_post.h index 5d3394f..f16f8ee 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -343,9 +343,8 @@ extern int emacs_setenv_TZ (char const *); # define FLEXIBLE_ARRAY_MEMBER #endif -/* Use this to suppress gcc's `...may be used before initialized' warnings. */ -#ifdef lint /* Use CODE only if lint checking is in effect. */ +#if defined GCC_LINT || defined lint # define IF_LINT(Code) Code #else # define IF_LINT(Code) /* empty */ commit e7b01df5cf83cdb7e7ca5558a0f557cf6354dace Author: Paul Eggert Date: Mon May 30 16:09:25 2016 -0700 Update from gnulib This incorporates: 2016-05-30 Use GCC_LINT, not lint 2016-05-29 secure_getenv: Port to many more platforms. * doc/misc/texinfo.tex, lib/secure_getenv.c, lib/verify.h: * m4/secure_getenv.m4: Copy from gnulib. diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index d7e6b1f..85846f4 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2016-05-26.20} +\def\texinfoversion{2016-05-28.16} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -4609,11 +4609,23 @@ % Like \expandablevalue, but completely expandable (the \message in the % definition above operates at the execution level of TeX). Used when % writing to auxiliary files, due to the expansion that \write does. +% If flag is undefined, pass through an unexpanded @value command: maybe it +% will be set by the time it is read back in. % % NB flag names containing - or _ may not work here. \def\dummyvalue#1{% \expandafter\ifx\csname SET#1\endcsname\relax - [No value for ``#1'']% + \noexpand\value{#1}% + \else + \csname SET#1\endcsname + \fi +} + +% Used for @value's in index entries to form the sort key: expand the @value +% if possible, otherwise sort late. +\def\indexnofontsvalue#1{% + \expandafter\ifx\csname SET#1\endcsname\relax + ZZZZZZZ \else \csname SET#1\endcsname \fi @@ -4760,7 +4772,7 @@ % Define \doindex, the driver for all index macros. % Argument #1 is generated by the calling \fooindex macro, -% and it the two-letter name of the index. +% and it is the two-letter name of the index. \def\doindex#1{\edef\indexname{#1}\parsearg\doindexxxx} \def\doindexxxx #1{\doind{\indexname}{#1}} @@ -4769,6 +4781,7 @@ \def\docodeindex#1{\edef\indexname{#1}\parsearg\docodeindexxxx} \def\docodeindexxxx #1{\doind{\indexname}{\code{#1}}} + % Used when writing an index entry out to an index file to prevent % expansion of Texinfo commands that can appear in an index entry. % @@ -4787,9 +4800,11 @@ \def\}{{\tt\char125}}% % % Do the redefinitions. - \commondummies + \definedummies } +% Used for the aux and toc files, where @ is the escape character. +% % For the aux and toc files, @ is the escape character. So we want to % redefine everything using @ as the escape character (instead of % \realbackslash, still used for index files). When everything uses @, @@ -4802,30 +4817,35 @@ \let\} = \rbraceatcmd % % Do the redefinitions. - \commondummies + \definedummies \otherbackslash } -% Called from \indexdummies and \atdummies. +% \definedummyword defines \#1 as \string\#1\space, thus effectively +% preventing its expansion. This is used only for control words, +% not control letters, because the \space would be incorrect for +% control characters, but is needed to separate the control word +% from whatever follows. % -\def\commondummies{% - % \definedummyword defines \#1 as \string\#1\space, thus effectively - % preventing its expansion. This is used only for control words, - % not control letters, because the \space would be incorrect for - % control characters, but is needed to separate the control word - % from whatever follows. - % - % For control letters, we have \definedummyletter, which omits the - % space. - % - % These can be used both for control words that take an argument and - % those that do not. If it is followed by {arg} in the input, then - % that will dutifully get written to the index (or wherever). - % - \def\definedummyword ##1{\def##1{\string##1\space}}% - \def\definedummyletter##1{\def##1{\string##1}}% - \let\definedummyaccent\definedummyletter +% These can be used both for control words that take an argument and +% those that do not. If it is followed by {arg} in the input, then +% that will dutifully get written to the index (or wherever). +% +% For control letters, we have \definedummyletter, which omits the +% space. +% +\def\definedummyword #1{\def#1{\string#1\space}}% +\def\definedummyletter#1{\def#1{\string#1}}% +\let\definedummyaccent\definedummyletter + +% Called from \indexdummies and \atdummies, to effectively prevent +% the expansion of commands. +% +\def\definedummies{% % + \let\commondummyword\definedummyword + \let\commondummyletter\definedummyletter + \let\commondummyaccent\definedummyaccent \commondummiesnofonts % \definedummyletter\_% @@ -4910,77 +4930,77 @@ \normalturnoffactive } -% \commondummiesnofonts: common to \commondummies and \indexnofonts. -% Define \definedumyletter, \definedummyaccent and \definedummyword before -% using. +% \commondummiesnofonts: common to \definedummies and \indexnofonts. +% Define \commondummyletter, \commondummyaccent and \commondummyword before +% using. Used for accents, font commands, and various control letters. % \def\commondummiesnofonts{% % Control letters and accents. - \definedummyletter\!% - \definedummyaccent\"% - \definedummyaccent\'% - \definedummyletter\*% - \definedummyaccent\,% - \definedummyletter\.% - \definedummyletter\/% - \definedummyletter\:% - \definedummyaccent\=% - \definedummyletter\?% - \definedummyaccent\^% - \definedummyaccent\`% - \definedummyaccent\~% - \definedummyword\u - \definedummyword\v - \definedummyword\H - \definedummyword\dotaccent - \definedummyword\ogonek - \definedummyword\ringaccent - \definedummyword\tieaccent - \definedummyword\ubaraccent - \definedummyword\udotaccent - \definedummyword\dotless + \commondummyletter\!% + \commondummyaccent\"% + \commondummyaccent\'% + \commondummyletter\*% + \commondummyaccent\,% + \commondummyletter\.% + \commondummyletter\/% + \commondummyletter\:% + \commondummyaccent\=% + \commondummyletter\?% + \commondummyaccent\^% + \commondummyaccent\`% + \commondummyaccent\~% + \commondummyword\u + \commondummyword\v + \commondummyword\H + \commondummyword\dotaccent + \commondummyword\ogonek + \commondummyword\ringaccent + \commondummyword\tieaccent + \commondummyword\ubaraccent + \commondummyword\udotaccent + \commondummyword\dotless % % Texinfo font commands. - \definedummyword\b - \definedummyword\i - \definedummyword\r - \definedummyword\sansserif - \definedummyword\sc - \definedummyword\slanted - \definedummyword\t + \commondummyword\b + \commondummyword\i + \commondummyword\r + \commondummyword\sansserif + \commondummyword\sc + \commondummyword\slanted + \commondummyword\t % % Commands that take arguments. - \definedummyword\abbr - \definedummyword\acronym - \definedummyword\anchor - \definedummyword\cite - \definedummyword\code - \definedummyword\command - \definedummyword\dfn - \definedummyword\dmn - \definedummyword\email - \definedummyword\emph - \definedummyword\env - \definedummyword\file - \definedummyword\image - \definedummyword\indicateurl - \definedummyword\inforef - \definedummyword\kbd - \definedummyword\key - \definedummyword\math - \definedummyword\option - \definedummyword\pxref - \definedummyword\ref - \definedummyword\samp - \definedummyword\strong - \definedummyword\tie - \definedummyword\U - \definedummyword\uref - \definedummyword\url - \definedummyword\var - \definedummyword\verb - \definedummyword\w - \definedummyword\xref + \commondummyword\abbr + \commondummyword\acronym + \commondummyword\anchor + \commondummyword\cite + \commondummyword\code + \commondummyword\command + \commondummyword\dfn + \commondummyword\dmn + \commondummyword\email + \commondummyword\emph + \commondummyword\env + \commondummyword\file + \commondummyword\image + \commondummyword\indicateurl + \commondummyword\inforef + \commondummyword\kbd + \commondummyword\key + \commondummyword\math + \commondummyword\option + \commondummyword\pxref + \commondummyword\ref + \commondummyword\samp + \commondummyword\strong + \commondummyword\tie + \commondummyword\U + \commondummyword\uref + \commondummyword\url + \commondummyword\var + \commondummyword\verb + \commondummyword\w + \commondummyword\xref } % For testing: output @{ and @} in index sort strings as \{ and \}. @@ -5036,11 +5056,11 @@ % \def\indexnofonts{% % Accent commands should become @asis. - \def\definedummyaccent##1{\let##1\asis}% + \def\commondummyaccent##1{\let##1\asis}% % We can just ignore other control letters. - \def\definedummyletter##1{\let##1\empty}% + \def\commondummyletter##1{\let##1\empty}% % All control words become @asis by default; overrides below. - \let\definedummyword\definedummyaccent + \let\commondummyword\commondummyaccent \commondummiesnofonts % % Don't no-op \tt, since it isn't a user-level command @@ -5125,8 +5145,11 @@ % goes to end-of-line is not handled. % \macrolist + \let\value\indexnofontsvalue } + + \let\SETmarginindex=\relax % put index entries in margin (undocumented)? diff --git a/lib/secure_getenv.c b/lib/secure_getenv.c index f359ab2..88a60dc 100644 --- a/lib/secure_getenv.c +++ b/lib/secure_getenv.c @@ -1,4 +1,4 @@ -/* Look up an environment variable more securely. +/* Look up an environment variable, returning NULL in insecure situations. Copyright 2013-2016 Free Software Foundation, Inc. @@ -20,22 +20,35 @@ #include #if !HAVE___SECURE_GETENV -# if HAVE_ISSETUGID +# if HAVE_ISSETUGID || (HAVE_GETUID && HAVE_GETEUID && HAVE_GETGID && HAVE_GETEGID) # include -# else -# undef issetugid -# define issetugid() 1 # endif #endif char * secure_getenv (char const *name) { -#if HAVE___SECURE_GETENV +#if HAVE___SECURE_GETENV /* glibc */ return __secure_getenv (name); -#else +#elif HAVE_ISSETUGID /* OS X, FreeBSD, NetBSD, OpenBSD */ if (issetugid ()) - return 0; + return NULL; + return getenv (name); +#elif HAVE_GETUID && HAVE_GETEUID && HAVE_GETGID && HAVE_GETEGID /* other Unix */ + if (geteuid () != getuid () || getegid () != getgid ()) + return NULL; return getenv (name); +#elif (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ /* native Windows */ + /* On native Windows, there is no such concept as setuid or setgid binaries. + - Programs launched as system services have high privileges, but they don't + inherit environment variables from a user. + - Programs launched by a user with "Run as Administrator" have high + privileges and use the environment variables, but the user has been asked + whether he agrees. + - Programs launched by a user without "Run as Administrator" cannot gain + high privileges, therefore there is no risk. */ + return getenv (name); +#else + return NULL; #endif } diff --git a/lib/verify.h b/lib/verify.h index 2f43837..5c8381d 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -263,7 +263,7 @@ template # define assume(R) ((R) ? (void) 0 : __builtin_unreachable ()) #elif 1200 <= _MSC_VER # define assume(R) __assume (R) -#elif (defined lint \ +#elif ((defined GCC_LINT || defined lint) \ && (__has_builtin (__builtin_trap) \ || 3 < __GNUC__ + (3 < __GNUC_MINOR__ + (4 <= __GNUC_PATCHLEVEL__)))) /* Doing it this way helps various packages when configured with diff --git a/m4/secure_getenv.m4 b/m4/secure_getenv.m4 index 00194c8..3983173 100644 --- a/m4/secure_getenv.m4 +++ b/m4/secure_getenv.m4 @@ -22,4 +22,5 @@ AC_DEFUN([gl_PREREQ_SECURE_GETENV], [ if test $ac_cv_func___secure_getenv = no; then AC_CHECK_FUNCS([issetugid]) fi + AC_CHECK_FUNCS_ONCE([getuid geteuid getgid getegid]) ]) commit 13411853b25f3c861d9364961f8ca0b18a9b5ed4 Author: Stefan Monnier Date: Mon May 30 16:35:00 2016 -0400 * lisp/emacs-lisp/pcase.el: Undo last change's spurious changes diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index b18472d..0b8dddf 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -105,8 +105,6 @@ specs))))) (edebug-match cursor (cons '&or specs)))) -(fset 'pcase--canon #'identity) - ;;;###autoload (defmacro pcase (exp &rest cases) "Evaluate EXP and attempt to match it against structural patterns. @@ -334,8 +332,7 @@ any kind of error." ;; to a separate function if that number is too high. ;; ;; We've already used this branch. So it is shared. - (let* (;; (code (car prev)) - (cdrprev (cdr prev)) + (let* ((code (car prev)) (cdrprev (cdr prev)) (prevvars (car cdrprev)) (cddrprev (cdr cdrprev)) (res (car cddrprev))) (unless (symbolp res) @@ -437,10 +434,8 @@ to this macro." ;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding ;; let* which might prevent the setcar/setcdr in pcase--expand's fancy ;; codegen from later metamorphosing this let into a funcall. - (if vars - `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars) - ,@code) - `(progn ,@code))) + `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars) + ,@code)) (defun pcase--small-branch-p (code) (and (= 1 (length code)) @@ -456,36 +451,7 @@ to this macro." (cond ((eq else :pcase--dontcare) then) ((eq then :pcase--dontcare) (debug) else) ;Can/should this ever happen? - ;; FIXME: The code below shows that there are some opportunities for sharing, - ;; but it's rarely useful to do it here, since almost all sharing found - ;; shares a trivial expression. - ;; But among the common trivial expressions are those of the form - ;; (funcall pcase-0). For this case, there could be a significant payoff - ;; if we could find the sharing-opportunity earlier so as to avoid - ;; the creation of pcase-0. - ;; ((and (eq 'if (car-safe then)) - ;; (equal (macroexp-unprogn (macroexp-progn (nthcdr 3 then))) - ;; (macroexp-unprogn else))) - ;; (let ((res (macroexp-if `(and ,test ,(nth 1 then)) - ;; (nth 2 then) else))) - ;; (message "if+if => if-and: sharing %S" else) - ;; res)) - ;; ((and (eq 'if (car-safe else)) - ;; (equal (nth 2 else) then)) - ;; (let ((res (macroexp-if `(or ,test ,(nth 1 else)) - ;; then (macroexp-progn (nthcdr 3 else))))) - ;; (message "if+if => if-or: sharing %S" then) - ;; res)) - (t - ;; (cond - ;; ((and (eq 'cond (car-safe then)) - ;; (equal `(cond ,@(nthcdr 2 then)) else)) - ;; (message "if+cond => cond-and: sharing %S" else)) - ;; ((and (eq 'cond (car-safe else)) - ;; (equal (macroexp-unprogn (macroexp-progn (cdr (nth 1 else)))) - ;; (macroexp-unprogn then))) - ;; (message "if+cond => cond-or: sharing %S" then))) - (macroexp-if test then else)))) + (t (macroexp-if test then else)))) ;; Note about MATCH: ;; When we have patterns like `(PAT1 . PAT2), after performing the `consp' @@ -953,14 +919,6 @@ QPAT can take the following forms: ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat) (t (error "Unknown QPAT: %S" qpat)))) -;;; Extra definitions that use pcase. - -(defun pcase--canon (e) - (pcase e - (`(progn ,e) (pcase--canon e)) - (`(cond (,test . ,then) (t . ,else)) - `(if ,test ,(macroexp-progn then) ,(macroexp-progn else))))) - (provide 'pcase) ;;; pcase.el ends here commit 89cc852af3c7a17684b0d3083eca1ef2731f1f41 Author: Stefan Monnier Date: Mon May 30 16:33:07 2016 -0400 * lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates): Add `atom'. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 7e164c0..b18472d 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -105,6 +105,8 @@ specs))))) (edebug-match cursor (cons '&or specs)))) +(fset 'pcase--canon #'identity) + ;;;###autoload (defmacro pcase (exp &rest cases) "Evaluate EXP and attempt to match it against structural patterns. @@ -332,7 +334,8 @@ any kind of error." ;; to a separate function if that number is too high. ;; ;; We've already used this branch. So it is shared. - (let* ((code (car prev)) (cdrprev (cdr prev)) + (let* (;; (code (car prev)) + (cdrprev (cdr prev)) (prevvars (car cdrprev)) (cddrprev (cdr cdrprev)) (res (car cddrprev))) (unless (symbolp res) @@ -434,8 +437,10 @@ to this macro." ;; Don't use let*, otherwise macroexp-let* may merge it with some surrounding ;; let* which might prevent the setcar/setcdr in pcase--expand's fancy ;; codegen from later metamorphosing this let into a funcall. - `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars) - ,@code)) + (if vars + `(let ,(mapcar (lambda (b) (list (car b) (cdr b))) vars) + ,@code) + `(progn ,@code))) (defun pcase--small-branch-p (code) (and (= 1 (length code)) @@ -451,7 +456,36 @@ to this macro." (cond ((eq else :pcase--dontcare) then) ((eq then :pcase--dontcare) (debug) else) ;Can/should this ever happen? - (t (macroexp-if test then else)))) + ;; FIXME: The code below shows that there are some opportunities for sharing, + ;; but it's rarely useful to do it here, since almost all sharing found + ;; shares a trivial expression. + ;; But among the common trivial expressions are those of the form + ;; (funcall pcase-0). For this case, there could be a significant payoff + ;; if we could find the sharing-opportunity earlier so as to avoid + ;; the creation of pcase-0. + ;; ((and (eq 'if (car-safe then)) + ;; (equal (macroexp-unprogn (macroexp-progn (nthcdr 3 then))) + ;; (macroexp-unprogn else))) + ;; (let ((res (macroexp-if `(and ,test ,(nth 1 then)) + ;; (nth 2 then) else))) + ;; (message "if+if => if-and: sharing %S" else) + ;; res)) + ;; ((and (eq 'if (car-safe else)) + ;; (equal (nth 2 else) then)) + ;; (let ((res (macroexp-if `(or ,test ,(nth 1 else)) + ;; then (macroexp-progn (nthcdr 3 else))))) + ;; (message "if+if => if-or: sharing %S" then) + ;; res)) + (t + ;; (cond + ;; ((and (eq 'cond (car-safe then)) + ;; (equal `(cond ,@(nthcdr 2 then)) else)) + ;; (message "if+cond => cond-and: sharing %S" else)) + ;; ((and (eq 'cond (car-safe else)) + ;; (equal (macroexp-unprogn (macroexp-progn (cdr (nth 1 else)))) + ;; (macroexp-unprogn then))) + ;; (message "if+cond => cond-or: sharing %S" then))) + (macroexp-if test then else)))) ;; Note about MATCH: ;; When we have patterns like `(PAT1 . PAT2), after performing the `consp' @@ -509,6 +543,7 @@ MATCH is the pattern that needs to be matched, of the form: (numberp . stringp) (numberp . byte-code-function-p) (consp . arrayp) + (consp . atom) (consp . vectorp) (consp . stringp) (consp . byte-code-function-p) @@ -918,6 +953,14 @@ QPAT can take the following forms: ((or (stringp qpat) (integerp qpat) (symbolp qpat)) `',qpat) (t (error "Unknown QPAT: %S" qpat)))) +;;; Extra definitions that use pcase. + +(defun pcase--canon (e) + (pcase e + (`(progn ,e) (pcase--canon e)) + (`(cond (,test . ,then) (t . ,else)) + `(if ,test ,(macroexp-progn then) ,(macroexp-progn else))))) + (provide 'pcase) ;;; pcase.el ends here commit 060026b9162ed5a76e95d98eea4b8f3204f6b941 Author: Ken Brown Date: Mon May 30 11:36:05 2016 -0400 * src/regex.c (IF_LINT): Remove; it’s in conf_post.h diff --git a/src/regex.c b/src/regex.c index af37936..05587da 100644 --- a/src/regex.c +++ b/src/regex.c @@ -1197,13 +1197,6 @@ print_double_string (re_char *where, re_char *string1, ssize_t size1, #endif /* not DEBUG */ -/* Use this to suppress gcc's `...may be used before initialized' warnings. */ -#ifdef lint -# define IF_LINT(Code) Code -#else -# define IF_LINT(Code) /* empty */ -#endif - /* Set by `re_set_syntax' to the current regexp syntax to recognize. Can also be assigned to arbitrarily: each pattern buffer stores its own syntax, so it can be changed between regex compilations. */ commit 1535aaf2873ddc6bcf113261800fc137a611e661 Author: Michael Albinus Date: Mon May 30 15:00:14 2016 +0200 Fix Bug#23631 for Tramp * lisp/net/tramp-adb.el (tramp-adb-handle-file-name-all-completions) * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-name-all-completions) * lisp/net/tramp-sh.el (tramp-sh-handle-file-name-all-completions): Fix caching problems. * lisp/net/tramp-sh.el (tramp-perl-file-name-all-completions): Simplify. * lisp/net/tramp-smb.el (tramp-smb-handle-directory-files): Move duplicate deletion ... (tramp-smb-handle-file-name-all-completions): ... here. * lisp/net/tramp.el (tramp-handle-file-name-completion): Handle `completion-ignored-extensions'. (Bug#23631) * test/lisp/net/tramp-tests.el (tramp-test24-file-name-completion): Test also `completion-regexp-list' and `completion-ignored-extensions'. diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index c39d24e..1281dbb 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -535,7 +535,7 @@ Emacs dired can't find files." "Like `file-name-all-completions' for Tramp files." (all-completions filename - (with-parsed-tramp-file-name directory nil + (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" (save-match-data (tramp-adb-send-command diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 1775c82..9677392 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1020,69 +1020,21 @@ file names." (defun tramp-gvfs-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (unless (save-match-data (string-match "/" filename)) - (with-parsed-tramp-file-name (expand-file-name directory) nil - - (all-completions - filename - (mapcar - 'list - (or - ;; Try cache entries for filename, filename with last - ;; character removed, filename with last two characters - ;; removed, ..., and finally the empty string - all - ;; concatenated to the local directory name. - (let ((remote-file-name-inhibit-cache - (or remote-file-name-inhibit-cache - tramp-completion-reread-directory-timeout))) - - ;; This is inefficient for very long filenames, pity - ;; `reduce' is not available... - (car - (apply - 'append - (mapcar - (lambda (x) - (let ((cache-hit - (tramp-get-file-property - v - (concat localname (substring filename 0 x)) - "file-name-all-completions" - nil))) - (when cache-hit (list cache-hit)))) - ;; We cannot use a length of 0, because file properties - ;; for "foo" and "foo/" are identical. - (number-sequence (length filename) 1 -1))))) - - ;; Cache expired or no matching cache entry found so we need - ;; to perform a remote operation. + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" (let ((result '("./" "../")) entry) ;; Get a list of directories and files. - (dolist (item (tramp-gvfs-get-directory-attributes directory)) + (dolist (item (tramp-gvfs-get-directory-attributes directory) result) (setq entry (or ;; Use display-name if available (google-drive). ;(cdr (assoc "standard::display-name" item)) (car item))) - (when (string-match filename entry) - (if (string-equal (cdr (assoc "type" item)) "directory") - (push (file-name-as-directory entry) result) - (push entry result)))) - - ;; Because the remote op went through OK we know the - ;; directory we `cd'-ed to exists. - (tramp-set-file-property v localname "file-exists-p" t) - - ;; Because the remote op went through OK we know every - ;; file listed by `ls' exists. - (mapc (lambda (entry) - (tramp-set-file-property - v (concat localname entry) "file-exists-p" t)) - result) - - ;; Store result in the cache. - (tramp-set-file-property - v (concat localname filename) - "file-name-all-completions" result)))))))) + (if (string-equal (cdr (assoc "type" item)) "directory") + (push (file-name-as-directory entry) result) + (push entry result))))))))) (defun tramp-gvfs-handle-file-notify-add-watch (file-name flags _callback) "Like `file-notify-add-watch' for Tramp files." diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index a5d09af..bfa3cc6 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -662,29 +662,19 @@ Escape sequence %s is replaced with name of Perl binary. This string is passed to `format', so percent characters need to be doubled.") (defconst tramp-perl-file-name-all-completions - "%s -e 'sub case { - my $str = shift; - if ($ARGV[2]) { - return lc($str); - } - else { - return $str; - } -} + "%s -e ' opendir(d, $ARGV[0]) || die(\"$ARGV[0]: $!\\nfail\\n\"); @files = readdir(d); closedir(d); foreach $f (@files) { - if (case(substr($f, 0, length($ARGV[1]))) eq case($ARGV[1])) { - if (-d \"$ARGV[0]/$f\") { - print \"$f/\\n\"; - } - else { - print \"$f\\n\"; - } + if (-d \"$ARGV[0]/$f\") { + print \"$f/\\n\"; + } + else { + print \"$f\\n\"; } } print \"ok\\n\" -' \"$1\" \"$2\" \"$3\" 2>/dev/null" +' \"$1\" 2>/dev/null" "Perl script to produce output suitable for use with `file-name-all-completions' on the remote file system. Escape sequence %s is replaced with name of Perl binary. This string is @@ -1868,135 +1858,63 @@ be non-negative integers." (defun tramp-sh-handle-file-name-all-completions (filename directory) "Like `file-name-all-completions' for Tramp files." (unless (save-match-data (string-match "/" filename)) - (with-parsed-tramp-file-name (expand-file-name directory) nil + (all-completions + filename + (with-parsed-tramp-file-name (expand-file-name directory) nil + (with-tramp-file-property v localname "file-name-all-completions" + (let (result) + ;; Get a list of directories and files, including reliably + ;; tagging the directories with a trailing "/". Because I + ;; rock. --daniel@danann.net + (tramp-send-command + v + (if (tramp-get-remote-perl v) + (progn + (tramp-maybe-send-script + v tramp-perl-file-name-all-completions + "tramp_perl_file_name_all_completions") + (format "tramp_perl_file_name_all_completions %s" + (tramp-shell-quote-argument localname))) + + (format (concat + "(cd %s 2>&1 && %s -a 2>/dev/null" + " | while IFS= read f; do" + " if %s -d \"$f\" 2>/dev/null;" + " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" + " && \\echo ok) || \\echo fail") + (tramp-shell-quote-argument localname) + (tramp-get-ls-command v) + (tramp-get-test-command v)))) - (all-completions - filename - (mapcar - 'list - (or - ;; Try cache entries for `filename', `filename' with last - ;; character removed, `filename' with last two characters - ;; removed, ..., and finally the empty string - all - ;; concatenated to the local directory name. - (let ((remote-file-name-inhibit-cache - (or remote-file-name-inhibit-cache - tramp-completion-reread-directory-timeout))) - - ;; This is inefficient for very long file names, pity - ;; `reduce' is not available... - (car - (apply - 'append - (mapcar - (lambda (x) - (let ((cache-hit - (tramp-get-file-property - v - (concat localname (substring filename 0 x)) - "file-name-all-completions" - nil))) - (when cache-hit (list cache-hit)))) - ;; We cannot use a length of 0, because file properties - ;; for "foo" and "foo/" are identical. - (number-sequence (length filename) 1 -1))))) - - ;; Cache expired or no matching cache entry found so we need - ;; to perform a remote operation. - (let (result) - ;; Get a list of directories and files, including reliably - ;; tagging the directories with a trailing '/'. Because I - ;; rock. --daniel@danann.net - - ;; Changed to perform `cd' in the same remote op and only - ;; get entries starting with `filename'. Capture any `cd' - ;; error messages. Ensure any `cd' and `echo' aliases are - ;; ignored. - (tramp-send-command - v - (if (tramp-get-remote-perl v) - (progn - (tramp-maybe-send-script - v tramp-perl-file-name-all-completions - "tramp_perl_file_name_all_completions") - (format "tramp_perl_file_name_all_completions %s %s %d" - (tramp-shell-quote-argument localname) - (tramp-shell-quote-argument filename) - (if read-file-name-completion-ignore-case 1 0))) - - (format (concat - "(cd %s 2>&1 && (%s -a %s 2>/dev/null" - ;; `ls' with wildcard might fail with `Argument - ;; list too long' error in some corner cases; if - ;; `ls' fails after `cd' succeeded, chances are - ;; that's the case, so let's retry without - ;; wildcard. This will return "too many" entries - ;; but that isn't harmful. - " || %s -a 2>/dev/null)" - " | while IFS= read f; do" - " if %s -d \"$f\" 2>/dev/null;" - " then \\echo \"$f/\"; else \\echo \"$f\"; fi; done" - " && \\echo ok) || \\echo fail") - (tramp-shell-quote-argument localname) - (tramp-get-ls-command v) - ;; When `filename' is empty, just `ls' without - ;; `filename' argument is more efficient than `ls *' - ;; for very large directories and might avoid the - ;; `Argument list too long' error. - ;; - ;; With and only with wildcard, we need to add - ;; `-d' to prevent `ls' from descending into - ;; sub-directories. - (if (zerop (length filename)) - "." - (format "-d %s*" (tramp-shell-quote-argument filename))) - (tramp-get-ls-command v) - (tramp-get-test-command v)))) - - ;; Now grab the output. - (with-current-buffer (tramp-get-buffer v) - (goto-char (point-max)) - - ;; Check result code, found in last line of output. - (forward-line -1) - (if (looking-at "^fail$") - (progn - ;; Grab error message from line before last line - ;; (it was put there by `cd 2>&1'). - (forward-line -1) - (tramp-error - v 'file-error - "tramp-sh-handle-file-name-all-completions: %s" - (buffer-substring (point) (point-at-eol)))) - ;; For peace of mind, if buffer doesn't end in `fail' - ;; then it should end in `ok'. If neither are in the - ;; buffer something went seriously wrong on the remote - ;; side. - (unless (looking-at "^ok$") - (tramp-error - v 'file-error - "\ + ;; Now grab the output. + (with-current-buffer (tramp-get-buffer v) + (goto-char (point-max)) + + ;; Check result code, found in last line of output. + (forward-line -1) + (if (looking-at "^fail$") + (progn + ;; Grab error message from line before last line + ;; (it was put there by `cd 2>&1'). + (forward-line -1) + (tramp-error + v 'file-error + "tramp-sh-handle-file-name-all-completions: %s" + (buffer-substring (point) (point-at-eol)))) + ;; For peace of mind, if buffer doesn't end in `fail' + ;; then it should end in `ok'. If neither are in the + ;; buffer something went seriously wrong on the remote + ;; side. + (unless (looking-at "^ok$") + (tramp-error + v 'file-error + "\ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'" - (tramp-shell-quote-argument localname) (buffer-string)))) - - (while (zerop (forward-line -1)) - (push (buffer-substring (point) (point-at-eol)) result))) - - ;; Because the remote op went through OK we know the - ;; directory we `cd'-ed to exists. - (tramp-set-file-property v localname "file-exists-p" t) - - ;; Because the remote op went through OK we know every - ;; file listed by `ls' exists. - (mapc (lambda (entry) - (tramp-set-file-property - v (concat localname entry) "file-exists-p" t)) - result) - - ;; Store result in the cache. - (tramp-set-file-property - v (concat localname filename) - "file-name-all-completions" result)))))))) + (tramp-shell-quote-argument localname) (buffer-string)))) + + (while (zerop (forward-line -1)) + (push (buffer-substring (point) (point-at-eol)) result))) + result)))))) ;; cp, mv and ln diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index b75eee9..fbd7cd3 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -663,8 +663,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." result))) ;; Sort them if necessary. (unless nosort (setq result (sort result 'string-lessp))) - ;; Remove double entries. - (delete-dups result))) + result)) (defun tramp-smb-handle-expand-file-name (name &optional dir) "Like `expand-file-name' for Tramp files." @@ -907,16 +906,17 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." "Like `file-name-all-completions' for Tramp files." (all-completions filename - (with-parsed-tramp-file-name directory nil + (with-parsed-tramp-file-name (expand-file-name directory) nil (with-tramp-file-property v localname "file-name-all-completions" (save-match-data - (mapcar - (lambda (x) - (list - (if (string-match "d" (nth 1 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - (tramp-smb-get-file-entries directory))))))) + (delete-dups + (mapcar + (lambda (x) + (list + (if (string-match "d" (nth 1 x)) + (file-name-as-directory (nth 0 x)) + (nth 0 x)))) + (tramp-smb-get-file-entries directory)))))))) (defun tramp-smb-handle-file-writable-p (filename) "Like `file-writable-p' for Tramp files." diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 7a57cbc..e375553 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2867,11 +2867,21 @@ User is always nil." (error "tramp-handle-file-name-completion invoked on non-tramp directory `%s'" directory)) - (try-completion - filename - (mapcar 'list (file-name-all-completions filename directory)) - (when predicate - (lambda (x) (funcall predicate (expand-file-name (car x) directory)))))) + (let (hits-ignored-extensions) + (or + (try-completion + filename (file-name-all-completions filename directory) + (lambda (x) + (when (funcall (or predicate 'identity) (expand-file-name x directory)) + (not + (and + completion-ignored-extensions + (string-match + (concat (regexp-opt completion-ignored-extensions 'paren) "$") x) + ;; We remember the hit. + (push x hits-ignored-extensions)))))) + ;; No match. So we try again for ignored files. + (try-completion filename hits-ignored-extensions)))) (defun tramp-handle-file-name-directory (file) "Like `file-name-directory' but aware of Tramp files." diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 49e73a1..a8d89e8 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -1405,10 +1405,15 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (make-directory tmp-name) (should (file-directory-p tmp-name)) (write-region "foo" nil (expand-file-name "foo" tmp-name)) + (should (file-exists-p (expand-file-name "foo" tmp-name))) (write-region "bar" nil (expand-file-name "bold" tmp-name)) + (should (file-exists-p (expand-file-name "bold" tmp-name))) (make-directory (expand-file-name "boz" tmp-name)) + (should (file-directory-p (expand-file-name "boz" tmp-name))) (should (equal (file-name-completion "fo" tmp-name) "foo")) + (should (equal (file-name-completion "foo" tmp-name) t)) (should (equal (file-name-completion "b" tmp-name) "bo")) + (should-not (file-name-completion "a" tmp-name)) (should (equal (file-name-completion "b" tmp-name 'file-directory-p) "boz/")) @@ -1416,7 +1421,32 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (should (equal (sort (file-name-all-completions "b" tmp-name) 'string-lessp) - '("bold" "boz/")))) + '("bold" "boz/"))) + (should-not (file-name-all-completions "a" tmp-name)) + ;; `completion-regexp-list' restricts the completion to + ;; files which match all expressions in this list. + (let ((completion-regexp-list + `(,directory-files-no-dot-files-regexp "b"))) + (should + (equal (file-name-completion "" tmp-name) "bo")) + (should + (equal + (sort (file-name-all-completions "" tmp-name) 'string-lessp) + '("bold" "boz/")))) + ;; `file-name-completion' ignores file names that end in + ;; any string in `completion-ignored-extensions'. + (let ((completion-ignored-extensions '(".ext"))) + (write-region "foo" nil (expand-file-name "foo.ext" tmp-name)) + (should (file-exists-p (expand-file-name "foo.ext" tmp-name))) + (should (equal (file-name-completion "fo" tmp-name) "foo")) + (should (equal (file-name-completion "foo" tmp-name) t)) + (should (equal (file-name-completion "foo." tmp-name) "foo.ext")) + (should (equal (file-name-completion "foo.ext" tmp-name) t)) + ;; `file-name-all-completions' is not affected. + (should + (equal + (sort (file-name-all-completions "" tmp-name) 'string-lessp) + '("../" "./" "bold" "boz/" "foo" "foo.ext"))))) ;; Cleanup. (ignore-errors (delete-directory tmp-name 'recursive))))))