commit 67a01490934ba5a43b68b7141b20bc8e636ed7c5 (HEAD, refs/remotes/origin/master) Author: Oleh Krehel Date: Mon Aug 29 10:35:34 2016 +0200 Make dired-do-compress understand files with spaces in them * lisp/dired-aux.el (dired-compress-file): Add `shell-quote-argument' and `literal' flag to `replace-regexp-in-string'. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 4bdded3..9e0943a 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1049,10 +1049,12 @@ Return nil if no change in files." (prog1 (setq newname (file-name-as-directory newname)) (dired-shell-command (replace-regexp-in-string - "%o" newname + "%o" (shell-quote-argument newname) (replace-regexp-in-string - "%i" file - command)))) + "%i" (shell-quote-argument file) + command + nil t) + nil t))) ;; We found an uncompression rule. (when (not (dired-check-process @@ -1072,10 +1074,12 @@ Return nil if no change in files." (default-directory (file-name-directory file))) (dired-shell-command (replace-regexp-in-string - "%o" out-name + "%o" (shell-quote-argument out-name) (replace-regexp-in-string - "%i" (file-name-nondirectory file) - (cadr suffix)))) + "%i" (shell-quote-argument (file-name-nondirectory file)) + (cadr suffix) + nil t) + nil t)) out-name))) (let ((out-name (concat file ".gz"))) (and (or (not (file-exists-p out-name)) commit 5214cc8e9d2a9cf461b8307daa2c15a5c9c69049 Author: Paul Eggert Date: Sun Aug 28 18:23:25 2016 -0700 * INSTALL.REPO: Suggest Texinfo 4.13 or later. diff --git a/INSTALL.REPO b/INSTALL.REPO index 7497f1f..6fc9857 100644 --- a/INSTALL.REPO +++ b/INSTALL.REPO @@ -15,7 +15,7 @@ automake - at least the version specified near the start of git - at least Git 1.7.1. If your repository was created by an older Git version, you may need to reclone it. makeinfo - not strictly necessary, but highly recommended, so that - you can build the manuals. + you can build the manuals. GNU Texinfo 4.13 or later should work. To use the autotools, run the following shell command to generate the 'configure' script and some related files, and to set up your git commit 91734c6bd33bab47c443ca23e6948e3a7900856b Author: Simen Heggestøyl Date: Sun Aug 28 18:36:27 2016 +0200 Add tests for dom.el * test/lisp/dom-tests.el: New file with tests for dom.el. diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el new file mode 100644 index 0000000..ca6bfbf --- /dev/null +++ b/test/lisp/dom-tests.el @@ -0,0 +1,201 @@ +;;; dom-tests.el --- Tests for dom.el -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 Free Software Foundation, Inc. + +;; Author: Simen Heggestøyl +;; Keywords: + +;; 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: + +;; + +;;; Code: + +(require 'dom) +(require 'ert) +(require 'subr-x) + +(defun dom-tests--tree () + "Return a DOM tree for testing." + (dom-node "html" nil + (dom-node "head" nil + (dom-node "title" nil + "Test")) + (dom-node "body" nil + (dom-node "div" '((class . "foo") + (style . "color: red;")) + (dom-node "p" '((id . "bar")) + "foo")) + (dom-node "div" '((title . "2nd div")) + "bar")))) + +(ert-deftest dom-tests-tag () + (let ((dom (dom-tests--tree))) + (should (equal (dom-tag dom) "html")) + (should (equal (dom-tag (car (dom-children dom))) "head")))) + +(ert-deftest dom-tests-attributes () + (let ((dom (dom-tests--tree))) + (should-not (dom-attributes dom)) + (should (equal (dom-attributes (dom-by-class dom "foo")) + '((class . "foo") (style . "color: red;")))))) + +(ert-deftest dom-tests-children () + (let ((dom (dom-tests--tree))) + (should (equal (mapcar #'dom-tag (dom-children dom)) + '("head" "body"))) + (should (equal (dom-tag (dom-children (dom-children dom))) + "title")))) + +(ert-deftest dom-tests-non-text-children () + (let ((dom (dom-tests--tree))) + (should (equal (dom-children dom) (dom-non-text-children dom))) + (should-not (dom-non-text-children + (dom-children (dom-children dom)))))) + +(ert-deftest dom-tests-set-attributes () + (let ((dom (dom-tests--tree)) + (attributes '((xmlns "http://www.w3.org/1999/xhtml")))) + (should-not (dom-attributes dom)) + (dom-set-attributes dom attributes) + (should (equal (dom-attributes dom) attributes)))) + +(ert-deftest dom-tests-set-attribute () + (let ((dom (dom-tests--tree)) + (attr 'xmlns) + (value "http://www.w3.org/1999/xhtml")) + (should-not (dom-attributes dom)) + (dom-set-attribute dom attr value) + (should (equal (dom-attr dom attr) value)))) + +(ert-deftest dom-tests-attr () + (let ((dom (dom-tests--tree))) + (should-not (dom-attr dom 'id)) + (should (equal (dom-attr (dom-by-id dom "bar") 'id) "bar")))) + +(ert-deftest dom-tests-text () + (let ((dom (dom-tests--tree))) + (should (string-empty-p (dom-text dom))) + (should (equal (dom-text (dom-by-tag dom "title")) "Test")))) + +(ert-deftest dom-tests-texts () + (let ((dom (dom-tests--tree))) + (should (equal (dom-texts dom) "Test foo bar")) + (should (equal (dom-texts dom ", ") "Test, foo, bar")))) + +(ert-deftest dom-tests-child-by-tag () + (let ((dom (dom-tests--tree))) + (should (equal (dom-child-by-tag dom "head") + (car (dom-children dom)))) + (should-not (dom-child-by-tag dom "title")))) + +(ert-deftest dom-tests-by-tag () + (let ((dom (dom-tests--tree))) + (should (= (length (dom-by-tag dom "div")) 2)) + (should-not (dom-by-tag dom "article")))) + +(ert-deftest dom-tests-strings () + (let ((dom (dom-tests--tree))) + (should (equal (dom-strings dom) '("Test" "foo" "bar"))) + (should (equal (dom-strings (dom-children dom)) '("Test"))))) + +(ert-deftest dom-tests-by-class () + (let ((dom (dom-tests--tree))) + (should (equal (dom-tag (dom-by-class dom "foo")) "div")) + (should-not (dom-by-class dom "bar")))) + +(ert-deftest dom-tests-by-style () + (let ((dom (dom-tests--tree))) + (should (equal (dom-tag (dom-by-style dom "color")) "div")) + (should-not (dom-by-style dom "width")))) + +(ert-deftest dom-tests-by-id () + (let ((dom (dom-tests--tree))) + (should (equal (dom-tag (dom-by-id dom "bar")) "p")) + (should-not (dom-by-id dom "foo")))) + +(ert-deftest dom-tests-elements () + (let ((dom (dom-tests--tree))) + (should (equal (dom-elements dom 'class "foo") + (dom-by-class dom "foo"))) + (should (equal (dom-attr (dom-elements dom 'title "2nd") 'title) + "2nd div")))) + +(ert-deftest dom-tests-remove-node () + (let ((dom (dom-tests--tree))) + (should-not (dom-remove-node dom dom)) + (should (= (length (dom-children dom)) 2)) + (dom-remove-node dom (car (dom-children dom))) + (should (= (length (dom-children dom)) 1)) + (dom-remove-node dom (car (dom-children dom))) + (should-not (dom-children dom)))) + +(ert-deftest dom-tests-parent () + (let ((dom (dom-tests--tree))) + (should-not (dom-parent dom dom)) + (should (equal (dom-parent dom (car (dom-children dom))) dom)))) + +(ert-deftest dom-tests-previous-sibling () + (let ((dom (dom-tests--tree))) + (should-not (dom-previous-sibling dom dom)) + (let ((children (dom-children dom))) + (should (equal (dom-previous-sibling dom (cadr children)) + (car children)))))) + +(ert-deftest dom-tests-append-child () + (let ((dom (dom-tests--tree))) + (should (equal (mapcar #'dom-tag (dom-children dom)) + '("head" "body"))) + (dom-append-child dom (dom-node "feet")) + (should (equal (mapcar #'dom-tag (dom-children dom)) + '("head" "body" "feet"))))) + +(ert-deftest dom-tests-add-child-before () + "Test `dom-add-child-before'. +Tests the cases of adding a new first-child and mid-child. Also +checks that an attempt to add a new node before a non-existent +child results in an error." + (let ((dom (dom-tests--tree))) + (should (equal (mapcar #'dom-tag (dom-children dom)) + '("head" "body"))) + (dom-add-child-before dom (dom-node "neck") + (dom-child-by-tag dom "body")) + (should (equal (mapcar #'dom-tag (dom-children dom)) + '("head" "neck" "body"))) + (dom-add-child-before dom (dom-node "hat")) + (should (equal (mapcar #'dom-tag (dom-children dom)) + '("hat" "head" "neck" "body"))) + (should-error (dom-add-child-before dom (dom-node "neck") + (dom-by-id dom "bar"))))) + +(ert-deftest dom-tests-ensure-node () + (let ((node (dom-node "foo"))) + (should (equal (dom-ensure-node '("foo")) node)) + (should (equal (dom-ensure-node '(("foo"))) node)) + (should (equal (dom-ensure-node '("foo" nil)) node)) + (should (equal (dom-ensure-node '(("foo") nil)) node)))) + +(ert-deftest dom-tests-pp () + (let ((node (dom-node "foo" nil ""))) + (with-temp-buffer + (dom-pp node) + (should (equal (buffer-string) "(\"foo\" nil\n \"\")"))) + (with-temp-buffer + (dom-pp node t) + (should (equal (buffer-string) "(\"foo\" nil)"))))) + +(provide 'dom-tests) +;;; dom-tests.el ends here commit 7fcce24e75b8281621a0b8816dc58cbdc05fdc91 Author: Paul Eggert Date: Sun Aug 28 02:13:18 2016 -0700 Memory allocator alignment fixes These changes remove some assumptions about heap allocator alignment that may not be true on unusual platforms. * src/alloc.c (POWER_OF_2): New macro. (ROUNDUP): Use it. (BLOCK_ALIGN): Verify that it is a power of 2. (aligned_alloc): Check that alignment passed to posix_memalign satisfies POSIX restrictions. (lisp_align_malloc): Check that size passed to aligned_alloc satisfies C11 restrictions. (MALLOC_IS_GC_ALIGNED): Check that GCALIGNMENT is 8, since the code has not been verified to work with other GCALIGNMENT values and the ice is thin here. On GNU/Linux, malloc can return a value that is a multiple of 8 but not 16, even though __alignof__ (max_align_t) is 16. See: https://gcc.gnu.org/ml/gcc-patches/2016-08/msg01902.html (lmalloc) [USE_ALIGNED_ALLOC]: Use aligned_alloc only if size is a multiple of alignment, since C11 says the behavior is undefined otherwise. (lmalloc, lrealloc): Don't use INT_ADD_WRAPV on size_t, as in general this macro is restricted to signed types. Remove assertion that the result is a multiple of GCALIGNMENT, as that need not be true. diff --git a/src/alloc.c b/src/alloc.c index db16575..67187f1 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -478,13 +478,18 @@ static int staticidx; static void *pure_alloc (size_t, int); -/* Return X rounded to the next multiple of Y. Arguments should not - have side effects, as they are evaluated more than once. Assume X - + Y - 1 does not overflow. Tune for Y being a power of 2. */ +/* True if N is a power of 2. N should be positive. */ -#define ROUNDUP(x, y) ((y) & ((y) - 1) \ - ? ((x) + (y) - 1) - ((x) + (y) - 1) % (y) \ - : ((x) + (y) - 1) & ~ ((y) - 1)) +#define POWER_OF_2(n) (((n) & ((n) - 1)) == 0) + +/* Return X rounded to the next multiple of Y. Y should be positive, + and Y - 1 + X should not overflow. Arguments should not have side + effects, as they are evaluated more than once. Tune for Y being a + power of 2. */ + +#define ROUNDUP(x, y) (POWER_OF_2 (y) \ + ? ((y) - 1 + (x)) & ~ ((y) - 1) \ + : ((y) - 1 + (x)) - ((y) - 1 + (x)) % (y)) /* Return PTR rounded up to the next multiple of ALIGNMENT. */ @@ -639,13 +644,14 @@ buffer_memory_full (ptrdiff_t nbytes) #define XMALLOC_OVERRUN_CHECK_OVERHEAD \ (2 * XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE) -/* Define XMALLOC_OVERRUN_SIZE_SIZE so that (1) it's large enough to - hold a size_t value and (2) the header size is a multiple of the - alignment that Emacs needs for C types and for USE_LSB_TAG. */ #define XMALLOC_BASE_ALIGNMENT alignof (max_align_t) #define XMALLOC_HEADER_ALIGNMENT \ COMMON_MULTIPLE (GCALIGNMENT, XMALLOC_BASE_ALIGNMENT) + +/* Define XMALLOC_OVERRUN_SIZE_SIZE so that (1) it's large enough to + hold a size_t value and (2) the header size is a multiple of the + alignment that Emacs needs for C types and for USE_LSB_TAG. */ #define XMALLOC_OVERRUN_SIZE_SIZE \ (((XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t) \ + XMALLOC_HEADER_ALIGNMENT - 1) \ @@ -1126,6 +1132,10 @@ lisp_free (void *block) /* The entry point is lisp_align_malloc which returns blocks of at most BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */ +/* Byte alignment of storage blocks. */ +#define BLOCK_ALIGN (1 << 10) +verify (POWER_OF_2 (BLOCK_ALIGN)); + /* Use aligned_alloc if it or a simple substitute is available. Address sanitization breaks aligned allocation, as of gcc 4.8.2 and clang 3.3 anyway. Aligned allocation is incompatible with @@ -1143,15 +1153,20 @@ lisp_free (void *block) static void * aligned_alloc (size_t alignment, size_t size) { + /* POSIX says the alignment must be a power-of-2 multiple of sizeof (void *). + Verify this for all arguments this function is given. */ + verify (BLOCK_ALIGN % sizeof (void *) == 0 + && POWER_OF_2 (BLOCK_ALIGN / sizeof (void *))); + verify (GCALIGNMENT % sizeof (void *) == 0 + && POWER_OF_2 (GCALIGNMENT / sizeof (void *))); + eassert (alignment == BLOCK_ALIGN || alignment == GCALIGNMENT); + void *p; return posix_memalign (&p, alignment, size) == 0 ? p : 0; } # endif #endif -/* BLOCK_ALIGN has to be a power of 2. */ -#define BLOCK_ALIGN (1 << 10) - /* Padding to leave at the end of a malloc'd block. This is to give malloc a chance to minimize the amount of memory wasted to alignment. It should be tuned to the particular malloc library used. @@ -1253,6 +1268,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type) #endif #ifdef USE_ALIGNED_ALLOC + verify (ABLOCKS_BYTES % BLOCK_ALIGN == 0); abase = base = aligned_alloc (BLOCK_ALIGN, ABLOCKS_BYTES); #else base = malloc (ABLOCKS_BYTES); @@ -1379,15 +1395,21 @@ lisp_align_free (void *block) # define __alignof__(type) alignof (type) #endif -/* True if malloc returns a multiple of GCALIGNMENT. In practice this - holds if __alignof__ (max_align_t) is a multiple. Use __alignof__ - if available, as otherwise this check would fail with GCC x86. +/* True if malloc (N) is known to return a multiple of GCALIGNMENT + whenever N is also a multiple. In practice this is true if + __alignof__ (max_align_t) is a multiple as well, assuming + GCALIGNMENT is 8; other values of GCALIGNMENT have not been looked + into. Use __alignof__ if available, as otherwise + MALLOC_IS_GC_ALIGNED would be false on GCC x86 even though the + alignment is OK there. + This is a macro, not an enum constant, for portability to HP-UX 10.20 cc and AIX 3.2.5 xlc. */ -#define MALLOC_IS_GC_ALIGNED (__alignof__ (max_align_t) % GCALIGNMENT == 0) +#define MALLOC_IS_GC_ALIGNED \ + (GCALIGNMENT == 8 && __alignof__ (max_align_t) % GCALIGNMENT == 0) -/* True if P is suitably aligned for SIZE, where Lisp alignment may be - needed if SIZE is Lisp-aligned. */ +/* True if a malloc-returned pointer P is suitably aligned for SIZE, + where Lisp alignment may be needed if SIZE is Lisp-aligned. */ static bool laligned (void *p, size_t size) @@ -1416,24 +1438,20 @@ static void * lmalloc (size_t size) { #if USE_ALIGNED_ALLOC - if (! MALLOC_IS_GC_ALIGNED) + if (! MALLOC_IS_GC_ALIGNED && size % GCALIGNMENT == 0) return aligned_alloc (GCALIGNMENT, size); #endif - void *p; while (true) { - p = malloc (size); + void *p = malloc (size); if (laligned (p, size)) - break; + return p; free (p); - size_t bigger; - if (! INT_ADD_WRAPV (size, GCALIGNMENT, &bigger)) + size_t bigger = size + GCALIGNMENT; + if (size < bigger) size = bigger; } - - eassert ((intptr_t) p % GCALIGNMENT == 0); - return p; } static void * @@ -1443,14 +1461,11 @@ lrealloc (void *p, size_t size) { p = realloc (p, size); if (laligned (p, size)) - break; - size_t bigger; - if (! INT_ADD_WRAPV (size, GCALIGNMENT, &bigger)) + return p; + size_t bigger = size + GCALIGNMENT; + if (size < bigger) size = bigger; } - - eassert ((intptr_t) p % GCALIGNMENT == 0); - return p; } commit 4be1ab61f4c1784f6870a5d53185bb0a6d9c5312 Author: Paul Eggert Date: Sun Aug 28 01:56:51 2016 -0700 Pacify --enable-gcc-warnings for lib-src/pop.c * lib-src/pop.c: Include c-ctype.h. (socket_connection): Pacify --enable-gcc-warnings by rewriting to avoid 'if (v = E) ...'. Use c_tolower, instead of a combination of the (undeclared) isupper and tolower. Fix pointer constness problem. diff --git a/lib-src/pop.c b/lib-src/pop.c index 74a6fc1..99ec1cf 100644 --- a/lib-src/pop.c +++ b/lib-src/pop.c @@ -90,6 +90,7 @@ extern struct servent *hes_getservbyname (/* char *, char * */); # endif #endif /* KERBEROS */ +#include #include #ifdef KERBEROS @@ -718,7 +719,8 @@ pop_multi_next (popserver server, char **line) return (-1); } - if ((ret = pop_getline (server, &fromserver)) < 0) + ret = pop_getline (server, &fromserver); + if (ret < 0) { return (-1); } @@ -1102,7 +1104,8 @@ socket_connection (char *host, int flags) if (! (flags & POP_NO_KERBEROS)) { #ifdef KERBEROS5 - if ((rem = krb5_init_context (&kcontext))) + rem = krb5_init_context (&kcontext); + if (rem) { krb5error: if (auth_context) @@ -1115,29 +1118,29 @@ socket_connection (char *host, int flags) return (-1); } - if ((rem = krb5_auth_con_init (kcontext, &auth_context))) + rem = krb5_auth_con_init (kcontext, &auth_context); + if (rem) goto krb5error; - if (rem = krb5_cc_default (kcontext, &ccdef)) + rem = krb5_cc_default (kcontext, &ccdef); + if (rem) goto krb5error; - if (rem = krb5_cc_get_principal (kcontext, ccdef, &client)) + rem = krb5_cc_get_principal (kcontext, ccdef, &client); + if (rem) goto krb5error; for (cp = realhost; *cp; cp++) - { - if (isupper (*cp)) - { - *cp = tolower (*cp); - } - } + *cp = c_tolower (*cp); - if (rem = krb5_sname_to_principal (kcontext, realhost, - POP_SERVICE, FALSE, &server)) + rem = krb5_sname_to_principal (kcontext, realhost, + POP_SERVICE, FALSE, &server); + if (rem) goto krb5error; rem = krb5_sendauth (kcontext, &auth_context, - (krb5_pointer) &sock, "KPOPV1.0", client, server, + (krb5_pointer) &sock, (char *) "KPOPV1.0", + client, server, AP_OPTS_MUTUAL_REQUIRED, 0, /* no checksum */ 0, /* no creds, use ccache instead */