[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 40a33a3 2/2: Merge branch 'master' of git.sv.gnu.or
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] master 40a33a3 2/2: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs |
|
Date: |
Sun, 2 Apr 2017 05:03:45 -0400 (EDT) |
branch: master
commit 40a33a3cb711f894ac61691c03cc13e58bc38145
Merge: 59191cd a184a7e
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs
---
.gitignore | 1 -
ChangeLog.3 | 2 +-
lisp/filenotify.el | 2 +-
lisp/progmodes/js.el | 13 +-
lisp/progmodes/perl-mode.el | 8 +-
lisp/ses.el | 2 +-
lisp/url/url-auth.el | 403 ++++++++++++++++++++++++++---------
test/Makefile.in | 31 +--
test/lisp/emacs-lisp/cl-lib-tests.el | 25 ++-
test/lisp/progmodes/js-tests.el | 37 ++++
test/lisp/url/url-auth-tests.el | 51 ++++-
test/lisp/vc/ediff-ptch-tests.el | 78 ++++---
test/make-test-deps.emacs-lisp | 98 ---------
13 files changed, 475 insertions(+), 276 deletions(-)
diff --git a/.gitignore b/.gitignore
index ce1866d..aa9e1ff 100644
--- a/.gitignore
+++ b/.gitignore
@@ -141,7 +141,6 @@ src/*.map
# Tests.
test/indent/*.new
-test/make-test-deps.mk
test/manual/biditest.txt
test/manual/etags/srclist
test/manual/etags/regexfile
diff --git a/ChangeLog.3 b/ChangeLog.3
index 1c2f5b1..f187c28 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -1015,7 +1015,7 @@
Upcase Path and ComSpec in process-environment
Since 2016-07-18 "Keep w32 environment settings internal only", the
- upcasing of environment variables "Path" and "ComSpec" occured after
+ upcasing of environment variables "Path" and "ComSpec" occurred after
initializing process-environment. This meant that Lisp code trying to
override "PATH" environment had no effect (Bug #24956).
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index dbf19cf..8bbe348 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -422,7 +422,7 @@ DESCRIPTOR should be an object returned by
`file-notify-add-watch'."
;; (This may be the desired behaviour.)
;; * Watching a file in a already watched directory
;; If the file is created and *then* a watch is added to that file, the
-;; watch might receive events which occured prior to it being created,
+;; watch might receive events which occurred prior to it being created,
;; due to the way events are propagated during idle time. Note: This
;; may be perfectly acceptable.
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index aed42a8..3c720c0 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -1713,7 +1713,7 @@ This performs fontification according to
`js--class-styles'."
(not (any ?\] ?\\))
(and "\\" not-newline)))
"]")))
- (group "/"))
+ (group (zero-or-one "/")))
"Regular expression matching a JavaScript regexp literal.")
(defun js-syntax-propertize-regexp (end)
@@ -1721,12 +1721,13 @@ This performs fontification according to
`js--class-styles'."
(when (eq (nth 3 ppss) ?/)
;; A /.../ regexp.
(goto-char (nth 8 ppss))
- (when (and (looking-at js--syntax-propertize-regexp-regexp)
- ;; Don't touch text after END.
- (<= (match-end 1) end))
- (put-text-property (match-beginning 1) (match-end 1)
+ (when (looking-at js--syntax-propertize-regexp-regexp)
+ ;; Don't touch text after END.
+ (when (> end (match-end 1))
+ (setq end (match-end 1)))
+ (put-text-property (match-beginning 1) end
'syntax-table (string-to-syntax "\"/"))
- (goto-char (match-end 0))))))
+ (goto-char end)))))
(defun js-syntax-propertize (start end)
;; JavaScript allows immediate regular expression objects, written /.../.
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index a516f07..b75f32e 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -255,9 +255,11 @@
;; format statements
("^[ \t]*format.*=[ \t]*\\(\n\\)"
(1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
- ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'.
- ;; Be careful not to match "sub { (...) ... }".
- ("\\<sub\\(?:[\s\t\n]+\\(?:\\sw\\|\\s_\\)+\\)?[\s\t\n]*(\\([^)]+\\))"
+ ;; Propertize perl prototype chars `$%&*;address@hidden' as punctuation
+ ;; in `sub' arg-specs like `sub myfun ($)' and `sub ($)'. But
+ ;; don't match subroutine signatures like `sub add ($a, $b)', or
+ ;; anonymous subs like "sub { (...) ... }".
+
("\\<sub\\(?:[\s\t\n]+\\(?:\\sw\\|\\s_\\)+\\)?[\s\t\n]*(\\([][$%&*;address@hidden))"
(1 "."))
;; Turn __DATA__ trailer into a comment.
("^\\(_\\)_\\(?:DATA\\|END\\)__[
\t]*\\(?:\\(\n\\)#.-\\*-.*perl.*-\\*-\\|\n.*\\)"
diff --git a/lisp/ses.el b/lisp/ses.el
index 5050713..66fc0c5 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -2276,7 +2276,7 @@ print area if NONARROW is nil."
"Recalculate and reprint the current cell or range.
If SES--CURCELL is non nil use it as current cell or range
-without any check, otherwise fnuction (ses-check-curcell 'range)
+without any check, otherwise function (ses-check-curcell 'range)
is called.
For an individual cell, shows the error if the formula or printer
diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 7b6cdd5..2885d4e 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -131,8 +131,8 @@ instead of the filename inheritance method."
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Digest authorization code
;;; ------------------------
-;;; This implements the DIGEST authorization type. See the internet draft
-;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt
+;;; This implements the DIGEST authorization type. See RFC 2617
+;;; https://www.ietf.org/rfc/rfc2617.txt
;;; for the complete documentation on this type.
;;;
;;; This is very secure
@@ -143,107 +143,306 @@ Its value is an assoc list of assoc lists. The first
assoc list is
keyed by the server name. The cdr of this is an assoc list based
on the \"directory\" specified by the url we are looking up.")
+(defsubst url-digest-auth-colonjoin (&rest args)
+ "Concatenate ARGS as strings with colon as a separator."
+ (mapconcat 'identity args ":"))
+
+(defsubst url-digest-auth-kd (data secret)
+ "Apply digest algorithm to DATA using SECRET and return the result."
+ (md5 (url-digest-auth-colonjoin secret data)))
+
+(defsubst url-digest-auth-make-ha1 (user realm password)
+ "Compute checksum out of strings USER, REALM, and PASSWORD."
+ (md5 (url-digest-auth-colonjoin user realm password)))
+
+(defsubst url-digest-auth-make-ha2 (method digest-uri)
+ "Compute checksum out of strings METHOD and DIGEST-URI."
+ (md5 (url-digest-auth-colonjoin method digest-uri)))
+
+(defsubst url-digest-auth-make-request-digest (ha1 ha2 nonce)
+ "Construct the request-digest from hash strings HA1, HA2, and NONCE.
+This is the value that server receives as a proof that user knows
+a password."
+ (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
+
+(defsubst url-digest-auth-make-request-digest-qop (qop ha1 ha2 nonce nc cnonce)
+ "Construct the request-digest with qop.
+QOP describes the \"quality of protection\" and algorithm to use.
+All of the strings QOP, HA1, HA2, NONCE, NC, and CNONCE are
+combined into a single hash value that proves to a server the
+user knows a password. It's worth noting that HA2 already
+depends on value of QOP."
+ (url-digest-auth-kd (url-digest-auth-colonjoin
+ nonce nc cnonce qop ha2) ha1))
+
+(defsubst url-digest-auth-directory-id (url realm)
+ "Make an identifier for selecting a key in key cache.
+The identifier is made either from URL or REALM. It represents a
+protection space within a server so that one server can have
+multiple authorizations."
+ (or realm (or (url-file-directory (url-filename url)) "/")))
+
+(defsubst url-digest-auth-server-id (url)
+ "Make an identifier for selecting a server in key cache.
+The identifier is made from URL's host and port. Together with
+`url-digest-auth-directory-id' these identify a single key in the
+key cache `url-digest-auth-storage'."
+ (format "%s:%d" (url-host url) (url-port url)))
+
+(defun url-digest-auth-make-cnonce ()
+ "Compute a new unique client nonce value."
+ (base64-encode-string
+ (apply 'format "%016x%04x%04x%05x%05x" (random) (current-time)) t))
+
+(defun url-digest-auth-nonce-count (nonce)
+ "The number requests sent to server with the given NONCE.
+This count includes the request we're preparing here.
+
+Currently, this is not implemented and will always return 1.
+
+Value returned is in string format with leading zeroes, such as
+\"00000001\"."
+ (format "%08x" 1))
+
+(defun url-digest-auth-name-value-string (pairs)
+ "Concatenate name-value pairs in association list PAIRS.
+
+Output is formatted as \"name1=\\\"value1\\\", name2=\\\"value2\\\", ...\""
+ (mapconcat (lambda (pair)
+ (format "%s=\"%s\""
+ (symbol-name (car pair))
+ (cdr pair)))
+ pairs ", "))
+
+(defun url-digest-auth-source-creds (url)
+ "Find credentials for URL object from the Emacs auth-source.
+Return value is a plist that has `:user' and `:secret' properties
+if credentials were found. Otherwise nil."
+ (let ((server (url-digest-auth-server-id url))
+ (type (url-type url)))
+ (list :user (url-do-auth-source-search server type :user)
+ :secret (url-do-auth-source-search server type :secret))))
+
+(defun url-digest-prompt-creds (url realm &optional creds)
+ "Prompt credentials for URL and REALM, defaulting to CREDS.
+CREDS is a plist that may have properties `:user' and `:secret'."
+ ;; Set explicitly in case creds were nil. This makes the second
+ ;; plist-put modify the same plist.
+ (setq creds
+ (plist-put creds :user
+ (read-string (url-auth-user-prompt url realm)
+ (or (plist-get creds :user)
+ (user-real-login-name)))))
+ (plist-put creds :secret
+ (read-passwd "Password: " nil (plist-get creds :secret))))
+
+(defun url-digest-auth-directory-id-assoc (dirkey keylist)
+ "Find the best match for DIRKEY in key alist KEYLIST.
+
+The string DIRKEY should be obtained using
+`url-digest-auth-directory-id'. The key list to search through
+is the alist KEYLIST where car of each element may match DIRKEY.
+If DIRKEY represents a realm, the list is searched only for an
+exact match. For directory names, an ancestor is sufficient for
+a match."
+ (or
+ ;; Check exact match first.
+ (assoc dirkey keylist)
+ ;; No exact match found. Continue to look for partial match if
+ ;; dirkey is not a realm.
+ (and (string-match "/" dirkey)
+ (let (match)
+ (while (and (null match) keylist)
+ (if (or
+ ;; Any realm candidate matches. Why?
+ (not (string-match "/" (caar keylist)))
+ ;; Parent directory matches.
+ (string-prefix-p (caar keylist) dirkey))
+ (setq match (car keylist))
+ (setq keylist (cdr keylist))))
+ match))))
+
+(defun url-digest-cached-key (url realm)
+ "Find best match for URL and REALM from `url-digest-auth-storage'.
+The return value is a list consisting of a realm (or a directory)
+a user name, and hashed authentication tokens HA1 and HA2.
+Modifying the contents of the returned list will modify the cache
+variable `url-digest-auth-storage' itself."
+ (url-digest-auth-directory-id-assoc
+ (url-digest-auth-directory-id url realm)
+ (cdr (assoc (url-digest-auth-server-id url) url-digest-auth-storage))))
+
+(defun url-digest-cache-key (key url)
+ "Add key to `url-digest-auth-storage'.
+KEY has the same format as returned by `url-digest-cached-key'.
+The key is added to cache hierarchy under server id, deduced from
+URL."
+ (let ((serverid (url-digest-auth-server-id url)))
+ (push (list serverid key) url-digest-auth-storage)))
+
(defun url-digest-auth-create-key (username password realm method uri)
- "Create a key for digest authentication method"
- (let* ((info (if (stringp uri)
- (url-generic-parse-url uri)
- uri))
- (a1 (md5 (concat username ":" realm ":" password)))
- (a2 (md5 (concat method ":" (url-filename info)))))
- (list a1 a2)))
-
-(defun url-digest-auth (url &optional prompt overwrite realm args)
- "Get the username/password for the specified URL.
-If optional argument PROMPT is non-nil, ask for the username/password
-to use for the URL and its descendants. If optional third argument
-OVERWRITE is non-nil, overwrite the old username/password pair if it
-is found in the assoc list. If REALM is specified, use that as the realm
-instead of hostname:portnum."
- (if args
- (let* ((href (if (stringp url)
- (url-generic-parse-url url)
- url))
- (server (url-host href))
- (type (url-type href))
- (port (url-port href))
- (file (url-filename href))
- (enable-recursive-minibuffers t)
- user pass byserv retval data)
- (setq file (cond
- (realm realm)
- ((string-match "/$" file) file)
- (t (url-file-directory file)))
- server (format "%s:%d" server port)
- byserv (cdr-safe (assoc server url-digest-auth-storage)))
- (cond
- ((and prompt (not byserv))
- (setq user (or
- (url-do-auth-source-search server type :user)
- (read-string (url-auth-user-prompt url realm)
- (user-real-login-name)))
- pass (or
- (url-do-auth-source-search server type :secret)
- (read-passwd "Password: "))
- url-digest-auth-storage
- (cons (list server
- (cons file
- (setq retval
- (cons user
- (url-digest-auth-create-key
- user pass realm
- (or url-request-method "GET")
- url)))))
- url-digest-auth-storage)))
- (byserv
- (setq retval (cdr-safe (assoc file byserv)))
- (if (and (not retval) ; no exact match, check directories
- (string-match "/" file)) ; not looking for a realm
- (while (and byserv (not retval))
- (setq data (car (car byserv)))
- (if (or (not (string-match "/" data))
- (and
- (>= (length file) (length data))
- (string= data (substring file 0 (length data)))))
- (setq retval (cdr (car byserv))))
- (setq byserv (cdr byserv))))
- (if overwrite
- (if (and (not retval) prompt)
- (setq user (or
- (url-do-auth-source-search server type :user)
- (read-string (url-auth-user-prompt url realm)
- (user-real-login-name)))
- pass (or
- (url-do-auth-source-search server type :secret)
- (read-passwd "Password: "))
- retval (setq retval
- (cons user
- (url-digest-auth-create-key
- user pass realm
- (or url-request-method "GET")
- url)))
- byserv (assoc server url-digest-auth-storage))
- (setcdr byserv
- (cons (cons file retval) (cdr byserv))))))
- (t (setq retval nil)))
- (if retval
- (if (cdr-safe (assoc "opaque" args))
- (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))
- (opaque (cdr-safe (assoc "opaque" args))))
- (format
- (concat "Digest username=\"%s\", realm=\"%s\","
- "nonce=\"%s\", uri=\"%s\","
- "response=\"%s\", opaque=\"%s\"")
- (nth 0 retval) realm nonce (url-filename href)
- (md5 (concat (nth 1 retval) ":" nonce ":"
- (nth 2 retval))) opaque))
- (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")))
- (format
- (concat "Digest username=\"%s\", realm=\"%s\","
- "nonce=\"%s\", uri=\"%s\","
- "response=\"%s\"")
- (nth 0 retval) realm nonce (url-filename href)
- (md5 (concat (nth 1 retval) ":" nonce ":"
- (nth 2 retval))))))))))
+ "Create a key for digest authentication method.
+The USERNAME and PASSWORD are the credentials for REALM and are
+used in making a hashed value named HA1. The HTTP METHOD and URI
+makes a second hashed value HA2. These hashes are used in making
+the authentication key that can be stored without saving the
+password in plain text. The return value is a list (HA1 HA2).
+
+For backward compatibility, URI is allowed to be a URL cl-struct
+object."
+ (and username password realm
+ (list (url-digest-auth-make-ha1 username realm password)
+ (url-digest-auth-make-ha2 method (cond ((stringp uri) uri)
+ (t (url-filename uri)))))))
+
+(defun url-digest-auth-build-response (key url realm attrs)
+ "Compute authorization string for the given challenge using KEY.
+
+The string looks like 'Digest username=\"John\", realm=\"The
+Realm\", ...'
+
+Part of the challenge is already solved in a pre-computed KEY
+which is list of a realm (or a directory), user name, and hash
+tokens HA1 and HA2.
+
+Some fields are filled as is from the given URL, REALM, and
+using the contents of alist ATTRS.
+
+ATTRS is expected to contain at least the server's \"nonce\"
+value. It also might contain the optional \"opaque\" value.
+Newer implementations conforming to RFC 2617 should also contain
+qop (Quality Of Protection) and related attributes.
+
+Restrictions on Quality of Protection scheme: The qop value
+\"auth-int\" or algorithm any other than \"MD5\" are not
+implemented."
+
+ (when key
+ (let ((user (nth 1 key))
+ (ha1 (nth 2 key))
+ (ha2 (nth 3 key))
+ (digest-uri (url-filename url))
+ (qop (cdr-safe (assoc "qop" attrs)))
+ (nonce (cdr-safe (assoc "nonce" attrs)))
+ (opaque (cdr-safe (assoc "opaque" attrs))))
+
+ (concat
+ "Digest "
+ (url-digest-auth-name-value-string
+ (append (list (cons 'username user)
+ (cons 'realm realm)
+ (cons 'nonce nonce)
+ (cons 'uri digest-uri))
+
+ (cond
+ ((null qop)
+ (list (cons 'response (url-digest-auth-make-request-digest
+ ha1 ha2 nonce))))
+ ((string= qop "auth")
+ (let ((nc (url-digest-auth-nonce-count nonce))
+ (cnonce (url-digest-auth-make-cnonce)))
+ (list (cons 'qop qop)
+ (cons 'nc nc)
+ (cons 'cnonce cnonce)
+ (cons 'response
+ (url-digest-auth-make-request-digest-qop
+ qop ha1 ha2 nonce nc cnonce)))))
+ (t (message "Quality of protection \"%s\" is not
implemented." qop)
+ nil))
+
+
+ (if opaque (list (cons 'opaque opaque)))))))))
+
+(defun url-digest-find-creds (url prompt &optional realm)
+ "Find or ask credentials for URL.
+
+Primary method for finding credentials is from Emacs auth-source.
+If password isn't found, and PROMPT is non-nil, query credentials
+via minibuffer. Optional REALM may be used when prompting as a
+hint to the user.
+
+Return value is nil in case either user name or password wasn't
+found. Otherwise, it's a plist containing `:user' and `:secret'.
+Additional `:source' property denotes the origin of the
+credentials and its value can be either symbol `authsource' or
+`interactive'."
+ (let ((creds (url-digest-auth-source-creds url)))
+
+ ;; If credentials weren't found and prompting is allowed, prompt
+ ;; the user.
+ (if (and prompt
+ (or (null creds)
+ (null (plist-get creds :secret))))
+ (progn
+ (setq creds (url-digest-prompt-creds url realm creds))
+ (plist-put creds :source 'interactive))
+ (plist-put creds :source 'authsource))
+
+ (and (plist-get creds :user)
+ (plist-get creds :secret)
+ creds)))
+
+(defun url-digest-find-new-key (url realm prompt)
+ "Find credentials and create a new authorization key for given URL and REALM.
+
+Return value is the new key, or nil if credentials weren't found.
+\"New\" in this context means a key that's not yet found in cache
+variable `url-digest-auth-storage'. You may use `url-digest-cache-key'
+to put it there.
+
+This function uses `url-digest-find-creds' to find the
+credentials. It first looks in auth-source. If not found, and
+PROMPT is non-nil, user is asked for credentials interactively
+via minibuffer."
+ (let (creds)
+ (unwind-protect
+ (if (setq creds (url-digest-find-creds url prompt realm))
+ (cons (url-digest-auth-directory-id url realm)
+ (cons (plist-get creds :user)
+ (url-digest-auth-create-key
+ (plist-get creds :user)
+ (plist-get creds :secret)
+ realm
+ (or url-request-method "GET")
+ (url-filename url)))))
+ (if (and creds
+ ;; Don't clear secret for `authsource' since it will
+ ;; corrupt any future fetches for it.
+ (not (eq (plist-get creds :source) 'authsource)))
+ (clear-string (plist-get creds :secret))))))
+
+(defun url-digest-auth (url &optional prompt overwrite realm attrs)
+ "Get the HTTP Digest response string for the specified URL.
+
+If optional argument PROMPT is non-nil, ask for the username and
+password to use for the URL and its descendants but only if one
+cannot be found from cache. Look also in Emacs auth-source.
+
+If optional third argument OVERWRITE is non-nil, overwrite the
+old credentials, if they're found in cache, with new ones from
+user prompt or from Emacs auth-source.
+
+If REALM is specified, use that instead of the URL descendant
+method to match cached credentials.
+
+Alist ATTRS contains additional attributes for the authentication
+challenge such as nonce and opaque."
+ (if attrs
+ (let* ((href (if (stringp url) (url-generic-parse-url url) url))
+ (enable-recursive-minibuffers t)
+ (key (url-digest-cached-key href realm)))
+
+ (if (or (null key) overwrite)
+ (let ((newkey (url-digest-find-new-key href realm (cond
+ (key nil)
+ (t prompt)))))
+ (if (and newkey key overwrite)
+ (setcdr key (cdr newkey))
+ (if (and newkey (null key))
+ (url-digest-cache-key (setq key newkey) href)))))
+
+ (if key
+ (url-digest-auth-build-response key href realm attrs)))))
(defvar url-registered-auth-schemes nil
"A list of the registered authorization schemes and various and sundry
diff --git a/test/Makefile.in b/test/Makefile.in
index c0056b6..d218b64 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -124,12 +124,12 @@ endif
$(emacs) -l ert -l $$loadfile \
--eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})"
${WRITE_LOG}
-ELFILES = $(shell find ${srcdir} -path "${srcdir}/manual" -prune -o \
- -path "*resources" -prune -o -name "*el" -print)
+ELFILES := $(shell find ${srcdir} -path "${srcdir}/manual" -prune -o \
+ -name "*resources" -prune -o -name "*.el" -print)
## .log files may be in a different directory for out of source builds
-LOGFILES = $(patsubst %.el,%.log, \
+LOGFILES := $(patsubst %.el,%.log, \
$(patsubst $(srcdir)%,.%,$(ELFILES)))
-TESTS = $(subst ${srcdir}/,,$(LOGFILES:.log=))
+TESTS := $(subst ${srcdir}/,,$(LOGFILES:.log=))
## If we have to interrupt a hanging test, preserve the log so we can
## see what the problem was.
@@ -141,6 +141,11 @@ TESTS = $(subst ${srcdir}/,,$(LOGFILES:.log=))
## Define an alias both with and without the directory name for ease
## of use.
define test_template
+ ifeq (,$(patsubst $(srcdir)/src/%,,$(1)))
+ $(1): $(srcdir)/../src/$(1:.log=.c)
+ else
+ $(1): $(srcdir)/../lisp/$(1:.log=.el)
+ endif
$(1):
@test ! -f ./$(1).log || mv ./$(1).log ./$(1).log~
@${MAKE} ./$(1).log WRITE_LOG=
@@ -157,11 +162,6 @@ $(foreach test,${TESTS},$(eval $(call
test_template,${test})))
check-no-automated-subdir:
test ! -d $(srcdir)/automated
-## Include dependencies between test files and the files they test.
-## We could do this without the file and eval directly, but then we
-## would have to run Emacs for every make invocation, and it might not
-## be available during clean.
--include make-test-deps.mk
## Rerun all default tests.
check: mostlyclean check-no-automated-subdir
@${MAKE} check-doit SELECTOR="${SELECTOR_ACTUAL}"
@@ -175,7 +175,7 @@ check-expensive: mostlyclean check-no-automated-subdir
## logfile is out-of-date with either the test file, or the source
## files that the tests depend on. The source file dependencies are
## determined by a heuristic and does not identify the full dependency
-## graph. See make-test-deps.emacs-lisp for details.
+## graph. See test_template for details.
.PHONY: check-maybe
check-maybe: check-no-automated-subdir
@${MAKE} check-doit SELECTOR="${SELECTOR_ACTUAL}"
@@ -183,7 +183,7 @@ check-maybe: check-no-automated-subdir
## Run the tests.
.PHONY: check-doit
check-doit: ${LOGFILES}
- $(emacs) -l ert -f ert-summarize-tests-batch-and-exit $^
+ @$(emacs) -l ert -f ert-summarize-tests-batch-and-exit $^
.PHONY: mostlyclean clean bootstrap-clean distclean maintainer-clean
@@ -193,7 +193,6 @@ mostlyclean:
clean:
find . '(' -name '*.log' -o -name '*.log~' ')' $(FIND_DELETE)
- rm -f make-test-deps.mk
bootstrap-clean: clean
find $(srcdir) -name '*.elc' $(FIND_DELETE)
@@ -202,11 +201,3 @@ distclean: clean
rm -f Makefile
maintainer-clean: distclean bootstrap-clean
-
-make-test-deps.mk: $(ELFILES) make-test-deps.emacs-lisp
- $(EMACS) --batch -l $(srcdir)/make-test-deps.emacs-lisp \
- --eval "(make-test-deps \"$(srcdir)\")" \
- 2> address@hidden
- # Hack to elide any CANNOT_DUMP=yes chatter.
- sed '/\.log: /!d' address@hidden >$@
- rm -f address@hidden
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el
b/test/lisp/emacs-lisp/cl-lib-tests.el
index b594620..093cb34 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -494,12 +494,29 @@
(should-not (cl-typep 1 'cl-lib-test-type)))
(ert-deftest cl-lib-symbol-macrolet ()
+ ;; bug#26325
+ :expected-result :failed
(should (equal (cl-flet ((f (x) (+ x 5)))
(let ((x 5))
(f (+ x 6))))
- (cl-symbol-macrolet ((f (+ x 6)))
- (cl-flet ((f (x) (+ x 5)))
- (let ((x 5))
- (f f)))))))
+ ;; Go through `eval', otherwise the macro-expansion
+ ;; error prevents running the whole test suite :-(
+ (eval '(cl-symbol-macrolet ((f (+ x 6)))
+ (cl-flet ((f (x) (+ x 5)))
+ (let ((x 5))
+ (f f))))
+ t))))
+
+(defmacro cl-lib-symbol-macrolet-4+5 ()
+ ;; bug#26068
+ (let* ((sname "x")
+ (s1 (make-symbol sname))
+ (s2 (make-symbol sname)))
+ `(cl-symbol-macrolet ((,s1 4)
+ (,s2 5))
+ (+ ,s1 ,s2))))
+
+(ert-deftest cl-lib-symbol-macrolet-2 ()
+ (should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5))))
;;; cl-lib.el ends here
diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el
index e030675..8e1bac1 100644
--- a/test/lisp/progmodes/js-tests.el
+++ b/test/lisp/progmodes/js-tests.el
@@ -140,6 +140,43 @@ if (!/[ (:,='\"]/.test(value)) {
(font-lock-ensure)
(should (eq (get-text-property (point) 'face) (caddr test))))))
+(ert-deftest js-mode-propertize-bug-1 ()
+ (with-temp-buffer
+ (js-mode)
+ (save-excursion (insert "x"))
+ (insert "/")
+ ;; The bug was a hang.
+ (should t)))
+
+(ert-deftest js-mode-propertize-bug-2 ()
+ (with-temp-buffer
+ (js-mode)
+ (insert "function f() {
+ function g()
+ {
+ 1 / 2;
+ }
+
+ function h() {
+")
+ (save-excursion
+ (insert "
+ 00000000000000000000000000000000000000000000000000;
+ 00000000000000000000000000000000000000000000000000;
+ 00000000000000000000000000000000000000000000000000;
+ 00000000000000000000000000000000000000000000000000;
+ 00000000000000000000000000000000000000000000000000;
+ 00000000000000000000000000000000000000000000000000;
+ 00000000000000000000000000000000000000000000000000;
+ 00000000000000000000000000000000000000000000000000;
+ 00;
+ }
+}
+"))
+ (insert "/")
+ ;; The bug was a hang.
+ (should t)))
+
(provide 'js-tests)
;;; js-tests.el ends here
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index 11e5a47..30636db 100644
--- a/test/lisp/url/url-auth-tests.el
+++ b/test/lisp/url/url-auth-tests.el
@@ -77,6 +77,49 @@ server's WWW-Authenticate header field.")
:expected-ha2 "b44272ea65ee4af7fb26c5dba58f6863"
:expected-response "0d84884d967e04440efc77e9e2b5b561")))
+(ert-deftest url-auth-test-colonjoin ()
+ "Check joining strings with `:'."
+ (should (string= (url-digest-auth-colonjoin) ""))
+ (should (string= (url-digest-auth-colonjoin nil) ""))
+ (should (string= (url-digest-auth-colonjoin nil nil nil) "::"))
+ (should (string= (url-digest-auth-colonjoin "") ""))
+ (should (string= (url-digest-auth-colonjoin "" "") ":"))
+ (should (string= (url-digest-auth-colonjoin "one") "one"))
+ (should (string= (url-digest-auth-colonjoin "one" "two" "three")
"one:two:three")))
+
+(ert-deftest url-auth-test-digest-ha1 ()
+ "Check HA1 computation."
+ (dolist (row url-auth-test-challenges)
+ (should (string= (url-digest-auth-make-ha1 (plist-get row :username)
+ (plist-get row :realm)
+ (plist-get row :password))
+ (plist-get row :expected-ha1)
+ ))))
+
+(ert-deftest url-auth-test-digest-ha2 ()
+ "Check HA2 computation."
+ (dolist (row url-auth-test-challenges)
+ (should (string= (url-digest-auth-make-ha2 (plist-get row :method)
+ (plist-get row :uri))
+ (plist-get row :expected-ha2)))))
+
+(ert-deftest url-auth-test-digest-request-digest ()
+ "Check digest response value."
+ (dolist (row url-auth-test-challenges)
+ (should (string= (plist-get row :expected-response)
+ (if (plist-member row :qop)
+ (url-digest-auth-make-request-digest-qop
+ (plist-get row :qop)
+ (plist-get row :expected-ha1)
+ (plist-get row :expected-ha2)
+ (plist-get row :nonce)
+ (plist-get row :nc)
+ (plist-get row :cnonce))
+ (url-digest-auth-make-request-digest
+ (plist-get row :expected-ha1)
+ (plist-get row :expected-ha2)
+ (plist-get row :nonce)))))))
+
(ert-deftest url-auth-test-digest-create-key ()
"Check user credentials in their hashed form."
(dolist (challenge url-auth-test-challenges)
@@ -223,14 +266,12 @@ test and cannot be passed by arguments to
`url-digest-auth'."
(progn
;; We don't know these, just check that they exists.
(should (string-match-p ".*response=\".*?\".*" auth))
- ;; url-digest-auth doesn't return these AFAICS.
-;;; (should (string-match-p ".*nc=\".*?\".*" auth))
-;;; (should (string-match-p ".*cnonce=\".*?\".*" auth))
- )
+ (should (string-match-p ".*nc=\".*?\".*" auth))
+ (should (string-match-p ".*cnonce=\".*?\".*" auth)))
(should (string-match ".*response=\"\\(.*?\\)\".*" auth))
(should (string= (match-string 1 auth)
(plist-get challenge :expected-response))))
- )))
+ )))
(ert-deftest url-auth-test-digest-auth-opaque ()
"Check that `opaque' value is added to result when presented by
diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el
index 9aacb6b..387786c 100644
--- a/test/lisp/vc/ediff-ptch-tests.el
+++ b/test/lisp/vc/ediff-ptch-tests.el
@@ -41,25 +41,31 @@ index 6a07f80..6e8e947 100644
(ert-deftest ediff-ptch-test-bug26084 ()
"Test for http://debbugs.gnu.org/26084 ."
- (let* ((tmpdir temporary-file-directory)
- (foo (expand-file-name "foo" tmpdir))
- (patch (expand-file-name "foo.diff" tmpdir))
- (qux (expand-file-name "qux.txt" foo))
- (bar (expand-file-name "bar.txt" foo))
- (cmd "
-mkdir -p foo
-cd foo
-echo 'qux here' > qux.txt
-echo 'bar here' > bar.txt
-git init
-git add . && git commit -m 'Test repository.'
-echo 'foo here' > qux.txt
-echo 'foo here' > bar.txt
-git diff > ../foo.diff
-git reset --hard HEAD
-"))
- (setq default-directory tmpdir)
- (call-process-shell-command cmd)
+ (skip-unless (executable-find "git"))
+ (skip-unless (executable-find ediff-patch-program))
+ (let* ((tmpdir (make-temp-file "ediff-ptch-test" t))
+ (default-directory (file-name-as-directory tmpdir))
+ (patch (make-temp-file "ediff-ptch-test"))
+ (qux (expand-file-name "qux.txt" tmpdir))
+ (bar (expand-file-name "bar.txt" tmpdir))
+ (git-program (executable-find "git")))
+ ;; Create repository.
+ (with-temp-buffer
+ (insert "qux here\n")
+ (write-region nil nil qux nil 'silent)
+ (erase-buffer)
+ (insert "bar here\n")
+ (write-region nil nil bar nil 'silent))
+ (call-process git-program nil nil nil "init")
+ (call-process git-program nil nil nil "add" ".")
+ (call-process git-program nil nil nil "commit" "-m" "Test repository.")
+ ;; Update repo., save the diff and reset to initial state.
+ (with-temp-buffer
+ (insert "foo here\n")
+ (write-region nil nil qux nil 'silent)
+ (write-region nil nil bar nil 'silent))
+ (call-process git-program nil `(:file ,patch) nil "diff")
+ (call-process git-program nil nil nil "reset" "--hard" "HEAD")
(find-file patch)
(unwind-protect
(let* ((info
@@ -76,23 +82,27 @@ git reset --hard HEAD
(dolist (x (list (cons patch1 bar) (cons patch2 qux)))
(with-temp-buffer
(insert (car x))
- (call-shell-region (point-min)
- (point-max)
- (format "%s %s %s %s"
- ediff-patch-program
- ediff-patch-options
- ediff-backup-specs
- (cdr x)))))
+ (call-process-region (point-min)
+ (point-max)
+ ediff-patch-program
+ nil nil nil
+ "-b" (cdr x))))
;; Check backup files were saved correctly.
(dolist (x (list qux bar))
- (should-not (string= (with-temp-buffer
- (insert-file-contents x)
- (buffer-string))
- (with-temp-buffer
- (insert-file-contents (concat x
ediff-backup-extension))
- (buffer-string))))))
- (delete-directory foo 'recursive)
- (delete-file patch))))
+ (let ((backup
+ (car
+ (directory-files
+ tmpdir 'full
+ (concat (file-name-nondirectory x) ".")))))
+ (should-not
+ (string= (with-temp-buffer
+ (insert-file-contents x)
+ (buffer-string))
+ (with-temp-buffer
+ (insert-file-contents backup)
+ (buffer-string))))))
+ (delete-directory tmpdir 'recursive)
+ (delete-file patch)))))
(provide 'ediff-ptch-tests)
diff --git a/test/make-test-deps.emacs-lisp b/test/make-test-deps.emacs-lisp
deleted file mode 100644
index 609e927..0000000
--- a/test/make-test-deps.emacs-lisp
+++ /dev/null
@@ -1,98 +0,0 @@
-;; -*- emacs-lisp -*-
-
-;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file generates dependencies between test files and the files
-;; that they test.
-
-;; It has an .emacs-lisp extension because it makes the Makefile easier!
-
-(require 'seq)
-
-(defun make-test-deps (src-dir)
- (let ((src-dir (file-truename src-dir)))
- (message
- "%s"
- (concat
- (make-test-deps-lisp src-dir)
- (make-test-deps-src src-dir)))))
-
-(defun make-test-deps-lisp (src-dir)
- (mapconcat
- (lambda (file-without-suffix)
- (format "./%s-tests.log: %s/../%s.el\n"
- file-without-suffix
- src-dir
- file-without-suffix))
- (make-test-test-files src-dir "lisp") ""))
-
-(defun make-test-deps-src (src-dir)
- (mapconcat
- (lambda (file-without-suffix)
- (format "./%s-tests.log: %s/../%s.c\n"
- file-without-suffix
- src-dir
- file-without-suffix))
- (make-test-test-files src-dir "src") ""))
-
-(defun make-test-test-files (src-dir sub-src-dir)
- (make-test-munge-files
- src-dir
- (directory-files-recursively
- (concat src-dir "/" sub-src-dir)
- ".*-tests.el$")))
-
-(defun make-test-munge-files (src-dir files)
- (make-test-sans-suffix
- (make-test-de-stem
- src-dir
- (make-test-no-legacy
- (make-test-no-test-dir
- (make-test-no-resources
- files))))))
-
-(defun make-test-sans-suffix (files)
- (mapcar
- (lambda (file)
- (substring file 0 -9))
- files))
-
-(defun make-test-de-stem (stem files)
- (mapcar
- (lambda (file)
- (substring
- file
- (+ 1 (length stem))))
- files))
-
-(defun make-test-no-legacy (list)
- (make-test-remove list "legacy/"))
-
-(defun make-test-no-resources (list)
- (make-test-remove list "-resources/"))
-
-(defun make-test-no-test-dir (list)
- (make-test-remove list "-tests/"))
-
-(defun make-test-remove (list match)
- (seq-remove
- (lambda (file)
- (string-match-p match file))
- list))
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 40a33a3 2/2: Merge branch 'master' of git.sv.gnu.org:/srv/git/emacs,
Michael Albinus <=