aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore1
-rw-r--r--ChangeLog.32
-rw-r--r--lisp/filenotify.el2
-rw-r--r--lisp/progmodes/js.el13
-rw-r--r--lisp/progmodes/perl-mode.el8
-rw-r--r--lisp/ses.el2
-rw-r--r--lisp/url/url-auth.el403
-rw-r--r--test/Makefile.in31
-rw-r--r--test/lisp/emacs-lisp/cl-lib-tests.el25
-rw-r--r--test/lisp/progmodes/js-tests.el37
-rw-r--r--test/lisp/url/url-auth-tests.el51
-rw-r--r--test/lisp/vc/ediff-ptch-tests.el78
-rw-r--r--test/make-test-deps.emacs-lisp98
13 files changed, 475 insertions, 276 deletions
diff --git a/.gitignore b/.gitignore
index ce1866d616b..aa9e1ff709e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -141,7 +141,6 @@ src/*.map
141 141
142# Tests. 142# Tests.
143test/indent/*.new 143test/indent/*.new
144test/make-test-deps.mk
145test/manual/biditest.txt 144test/manual/biditest.txt
146test/manual/etags/srclist 145test/manual/etags/srclist
147test/manual/etags/regexfile 146test/manual/etags/regexfile
diff --git a/ChangeLog.3 b/ChangeLog.3
index 1c2f5b1d2fa..f187c2852f7 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -1015,7 +1015,7 @@
1015 Upcase Path and ComSpec in process-environment 1015 Upcase Path and ComSpec in process-environment
1016 1016
1017 Since 2016-07-18 "Keep w32 environment settings internal only", the 1017 Since 2016-07-18 "Keep w32 environment settings internal only", the
1018 upcasing of environment variables "Path" and "ComSpec" occured after 1018 upcasing of environment variables "Path" and "ComSpec" occurred after
1019 initializing process-environment. This meant that Lisp code trying to 1019 initializing process-environment. This meant that Lisp code trying to
1020 override "PATH" environment had no effect (Bug #24956). 1020 override "PATH" environment had no effect (Bug #24956).
1021 1021
diff --git a/lisp/filenotify.el b/lisp/filenotify.el
index dbf19cf2f20..8bbe348f332 100644
--- a/lisp/filenotify.el
+++ b/lisp/filenotify.el
@@ -422,7 +422,7 @@ DESCRIPTOR should be an object returned by `file-notify-add-watch'."
422;; (This may be the desired behaviour.) 422;; (This may be the desired behaviour.)
423;; * Watching a file in a already watched directory 423;; * Watching a file in a already watched directory
424;; If the file is created and *then* a watch is added to that file, the 424;; If the file is created and *then* a watch is added to that file, the
425;; watch might receive events which occured prior to it being created, 425;; watch might receive events which occurred prior to it being created,
426;; due to the way events are propagated during idle time. Note: This 426;; due to the way events are propagated during idle time. Note: This
427;; may be perfectly acceptable. 427;; may be perfectly acceptable.
428 428
diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el
index aed42a85076..3c720c05610 100644
--- a/lisp/progmodes/js.el
+++ b/lisp/progmodes/js.el
@@ -1713,7 +1713,7 @@ This performs fontification according to `js--class-styles'."
1713 (not (any ?\] ?\\)) 1713 (not (any ?\] ?\\))
1714 (and "\\" not-newline))) 1714 (and "\\" not-newline)))
1715 "]"))) 1715 "]")))
1716 (group "/")) 1716 (group (zero-or-one "/")))
1717 "Regular expression matching a JavaScript regexp literal.") 1717 "Regular expression matching a JavaScript regexp literal.")
1718 1718
1719(defun js-syntax-propertize-regexp (end) 1719(defun js-syntax-propertize-regexp (end)
@@ -1721,12 +1721,13 @@ This performs fontification according to `js--class-styles'."
1721 (when (eq (nth 3 ppss) ?/) 1721 (when (eq (nth 3 ppss) ?/)
1722 ;; A /.../ regexp. 1722 ;; A /.../ regexp.
1723 (goto-char (nth 8 ppss)) 1723 (goto-char (nth 8 ppss))
1724 (when (and (looking-at js--syntax-propertize-regexp-regexp) 1724 (when (looking-at js--syntax-propertize-regexp-regexp)
1725 ;; Don't touch text after END. 1725 ;; Don't touch text after END.
1726 (<= (match-end 1) end)) 1726 (when (> end (match-end 1))
1727 (put-text-property (match-beginning 1) (match-end 1) 1727 (setq end (match-end 1)))
1728 (put-text-property (match-beginning 1) end
1728 'syntax-table (string-to-syntax "\"/")) 1729 'syntax-table (string-to-syntax "\"/"))
1729 (goto-char (match-end 0)))))) 1730 (goto-char end)))))
1730 1731
1731(defun js-syntax-propertize (start end) 1732(defun js-syntax-propertize (start end)
1732 ;; JavaScript allows immediate regular expression objects, written /.../. 1733 ;; JavaScript allows immediate regular expression objects, written /.../.
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index a516f07e72f..b75f32ee200 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -255,9 +255,11 @@
255 ;; format statements 255 ;; format statements
256 ("^[ \t]*format.*=[ \t]*\\(\n\\)" 256 ("^[ \t]*format.*=[ \t]*\\(\n\\)"
257 (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end)))) 257 (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end))))
258 ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'. 258 ;; Propertize perl prototype chars `$%&*;+@\[]' as punctuation
259 ;; Be careful not to match "sub { (...) ... }". 259 ;; in `sub' arg-specs like `sub myfun ($)' and `sub ($)'. But
260 ("\\<sub\\(?:[\s\t\n]+\\(?:\\sw\\|\\s_\\)+\\)?[\s\t\n]*(\\([^)]+\\))" 260 ;; don't match subroutine signatures like `sub add ($a, $b)', or
261 ;; anonymous subs like "sub { (...) ... }".
262 ("\\<sub\\(?:[\s\t\n]+\\(?:\\sw\\|\\s_\\)+\\)?[\s\t\n]*(\\([][$%&*;+@\\]+\\))"
261 (1 ".")) 263 (1 "."))
262 ;; Turn __DATA__ trailer into a comment. 264 ;; Turn __DATA__ trailer into a comment.
263 ("^\\(_\\)_\\(?:DATA\\|END\\)__[ \t]*\\(?:\\(\n\\)#.-\\*-.*perl.*-\\*-\\|\n.*\\)" 265 ("^\\(_\\)_\\(?:DATA\\|END\\)__[ \t]*\\(?:\\(\n\\)#.-\\*-.*perl.*-\\*-\\|\n.*\\)"
diff --git a/lisp/ses.el b/lisp/ses.el
index 50507132346..66fc0c5ebdf 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -2276,7 +2276,7 @@ print area if NONARROW is nil."
2276 "Recalculate and reprint the current cell or range. 2276 "Recalculate and reprint the current cell or range.
2277 2277
2278If SES--CURCELL is non nil use it as current cell or range 2278If SES--CURCELL is non nil use it as current cell or range
2279without any check, otherwise fnuction (ses-check-curcell 'range) 2279without any check, otherwise function (ses-check-curcell 'range)
2280is called. 2280is called.
2281 2281
2282For an individual cell, shows the error if the formula or printer 2282For 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 7b6cdd53790..2885d4e12e2 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -131,8 +131,8 @@ instead of the filename inheritance method."
131;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 131;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
132;;; Digest authorization code 132;;; Digest authorization code
133;;; ------------------------ 133;;; ------------------------
134;;; This implements the DIGEST authorization type. See the internet draft 134;;; This implements the DIGEST authorization type. See RFC 2617
135;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt 135;;; https://www.ietf.org/rfc/rfc2617.txt
136;;; for the complete documentation on this type. 136;;; for the complete documentation on this type.
137;;; 137;;;
138;;; This is very secure 138;;; This is very secure
@@ -143,107 +143,306 @@ Its value is an assoc list of assoc lists. The first assoc list is
143keyed by the server name. The cdr of this is an assoc list based 143keyed by the server name. The cdr of this is an assoc list based
144on the \"directory\" specified by the url we are looking up.") 144on the \"directory\" specified by the url we are looking up.")
145 145
146(defsubst url-digest-auth-colonjoin (&rest args)
147 "Concatenate ARGS as strings with colon as a separator."
148 (mapconcat 'identity args ":"))
149
150(defsubst url-digest-auth-kd (data secret)
151 "Apply digest algorithm to DATA using SECRET and return the result."
152 (md5 (url-digest-auth-colonjoin secret data)))
153
154(defsubst url-digest-auth-make-ha1 (user realm password)
155 "Compute checksum out of strings USER, REALM, and PASSWORD."
156 (md5 (url-digest-auth-colonjoin user realm password)))
157
158(defsubst url-digest-auth-make-ha2 (method digest-uri)
159 "Compute checksum out of strings METHOD and DIGEST-URI."
160 (md5 (url-digest-auth-colonjoin method digest-uri)))
161
162(defsubst url-digest-auth-make-request-digest (ha1 ha2 nonce)
163 "Construct the request-digest from hash strings HA1, HA2, and NONCE.
164This is the value that server receives as a proof that user knows
165a password."
166 (url-digest-auth-kd (url-digest-auth-colonjoin nonce ha2) ha1))
167
168(defsubst url-digest-auth-make-request-digest-qop (qop ha1 ha2 nonce nc cnonce)
169 "Construct the request-digest with qop.
170QOP describes the \"quality of protection\" and algorithm to use.
171All of the strings QOP, HA1, HA2, NONCE, NC, and CNONCE are
172combined into a single hash value that proves to a server the
173user knows a password. It's worth noting that HA2 already
174depends on value of QOP."
175 (url-digest-auth-kd (url-digest-auth-colonjoin
176 nonce nc cnonce qop ha2) ha1))
177
178(defsubst url-digest-auth-directory-id (url realm)
179 "Make an identifier for selecting a key in key cache.
180The identifier is made either from URL or REALM. It represents a
181protection space within a server so that one server can have
182multiple authorizations."
183 (or realm (or (url-file-directory (url-filename url)) "/")))
184
185(defsubst url-digest-auth-server-id (url)
186 "Make an identifier for selecting a server in key cache.
187The identifier is made from URL's host and port. Together with
188`url-digest-auth-directory-id' these identify a single key in the
189key cache `url-digest-auth-storage'."
190 (format "%s:%d" (url-host url) (url-port url)))
191
192(defun url-digest-auth-make-cnonce ()
193 "Compute a new unique client nonce value."
194 (base64-encode-string
195 (apply 'format "%016x%04x%04x%05x%05x" (random) (current-time)) t))
196
197(defun url-digest-auth-nonce-count (nonce)
198 "The number requests sent to server with the given NONCE.
199This count includes the request we're preparing here.
200
201Currently, this is not implemented and will always return 1.
202
203Value returned is in string format with leading zeroes, such as
204\"00000001\"."
205 (format "%08x" 1))
206
207(defun url-digest-auth-name-value-string (pairs)
208 "Concatenate name-value pairs in association list PAIRS.
209
210Output is formatted as \"name1=\\\"value1\\\", name2=\\\"value2\\\", ...\""
211 (mapconcat (lambda (pair)
212 (format "%s=\"%s\""
213 (symbol-name (car pair))
214 (cdr pair)))
215 pairs ", "))
216
217(defun url-digest-auth-source-creds (url)
218 "Find credentials for URL object from the Emacs auth-source.
219Return value is a plist that has `:user' and `:secret' properties
220if credentials were found. Otherwise nil."
221 (let ((server (url-digest-auth-server-id url))
222 (type (url-type url)))
223 (list :user (url-do-auth-source-search server type :user)
224 :secret (url-do-auth-source-search server type :secret))))
225
226(defun url-digest-prompt-creds (url realm &optional creds)
227 "Prompt credentials for URL and REALM, defaulting to CREDS.
228CREDS is a plist that may have properties `:user' and `:secret'."
229 ;; Set explicitly in case creds were nil. This makes the second
230 ;; plist-put modify the same plist.
231 (setq creds
232 (plist-put creds :user
233 (read-string (url-auth-user-prompt url realm)
234 (or (plist-get creds :user)
235 (user-real-login-name)))))
236 (plist-put creds :secret
237 (read-passwd "Password: " nil (plist-get creds :secret))))
238
239(defun url-digest-auth-directory-id-assoc (dirkey keylist)
240 "Find the best match for DIRKEY in key alist KEYLIST.
241
242The string DIRKEY should be obtained using
243`url-digest-auth-directory-id'. The key list to search through
244is the alist KEYLIST where car of each element may match DIRKEY.
245If DIRKEY represents a realm, the list is searched only for an
246exact match. For directory names, an ancestor is sufficient for
247a match."
248 (or
249 ;; Check exact match first.
250 (assoc dirkey keylist)
251 ;; No exact match found. Continue to look for partial match if
252 ;; dirkey is not a realm.
253 (and (string-match "/" dirkey)
254 (let (match)
255 (while (and (null match) keylist)
256 (if (or
257 ;; Any realm candidate matches. Why?
258 (not (string-match "/" (caar keylist)))
259 ;; Parent directory matches.
260 (string-prefix-p (caar keylist) dirkey))
261 (setq match (car keylist))
262 (setq keylist (cdr keylist))))
263 match))))
264
265(defun url-digest-cached-key (url realm)
266 "Find best match for URL and REALM from `url-digest-auth-storage'.
267The return value is a list consisting of a realm (or a directory)
268a user name, and hashed authentication tokens HA1 and HA2.
269Modifying the contents of the returned list will modify the cache
270variable `url-digest-auth-storage' itself."
271 (url-digest-auth-directory-id-assoc
272 (url-digest-auth-directory-id url realm)
273 (cdr (assoc (url-digest-auth-server-id url) url-digest-auth-storage))))
274
275(defun url-digest-cache-key (key url)
276 "Add key to `url-digest-auth-storage'.
277KEY has the same format as returned by `url-digest-cached-key'.
278The key is added to cache hierarchy under server id, deduced from
279URL."
280 (let ((serverid (url-digest-auth-server-id url)))
281 (push (list serverid key) url-digest-auth-storage)))
282
146(defun url-digest-auth-create-key (username password realm method uri) 283(defun url-digest-auth-create-key (username password realm method uri)
147 "Create a key for digest authentication method" 284 "Create a key for digest authentication method.
148 (let* ((info (if (stringp uri) 285The USERNAME and PASSWORD are the credentials for REALM and are
149 (url-generic-parse-url uri) 286used in making a hashed value named HA1. The HTTP METHOD and URI
150 uri)) 287makes a second hashed value HA2. These hashes are used in making
151 (a1 (md5 (concat username ":" realm ":" password))) 288the authentication key that can be stored without saving the
152 (a2 (md5 (concat method ":" (url-filename info))))) 289password in plain text. The return value is a list (HA1 HA2).
153 (list a1 a2))) 290
154 291For backward compatibility, URI is allowed to be a URL cl-struct
155(defun url-digest-auth (url &optional prompt overwrite realm args) 292object."
156 "Get the username/password for the specified URL. 293 (and username password realm
157If optional argument PROMPT is non-nil, ask for the username/password 294 (list (url-digest-auth-make-ha1 username realm password)
158to use for the URL and its descendants. If optional third argument 295 (url-digest-auth-make-ha2 method (cond ((stringp uri) uri)
159OVERWRITE is non-nil, overwrite the old username/password pair if it 296 (t (url-filename uri)))))))
160is found in the assoc list. If REALM is specified, use that as the realm 297
161instead of hostname:portnum." 298(defun url-digest-auth-build-response (key url realm attrs)
162 (if args 299 "Compute authorization string for the given challenge using KEY.
163 (let* ((href (if (stringp url) 300
164 (url-generic-parse-url url) 301The string looks like 'Digest username=\"John\", realm=\"The
165 url)) 302Realm\", ...'
166 (server (url-host href)) 303
167 (type (url-type href)) 304Part of the challenge is already solved in a pre-computed KEY
168 (port (url-port href)) 305which is list of a realm (or a directory), user name, and hash
169 (file (url-filename href)) 306tokens HA1 and HA2.
170 (enable-recursive-minibuffers t) 307
171 user pass byserv retval data) 308Some fields are filled as is from the given URL, REALM, and
172 (setq file (cond 309using the contents of alist ATTRS.
173 (realm realm) 310
174 ((string-match "/$" file) file) 311ATTRS is expected to contain at least the server's \"nonce\"
175 (t (url-file-directory file))) 312value. It also might contain the optional \"opaque\" value.
176 server (format "%s:%d" server port) 313Newer implementations conforming to RFC 2617 should also contain
177 byserv (cdr-safe (assoc server url-digest-auth-storage))) 314qop (Quality Of Protection) and related attributes.
178 (cond 315
179 ((and prompt (not byserv)) 316Restrictions on Quality of Protection scheme: The qop value
180 (setq user (or 317\"auth-int\" or algorithm any other than \"MD5\" are not
181 (url-do-auth-source-search server type :user) 318implemented."
182 (read-string (url-auth-user-prompt url realm) 319
183 (user-real-login-name))) 320 (when key
184 pass (or 321 (let ((user (nth 1 key))
185 (url-do-auth-source-search server type :secret) 322 (ha1 (nth 2 key))
186 (read-passwd "Password: ")) 323 (ha2 (nth 3 key))
187 url-digest-auth-storage 324 (digest-uri (url-filename url))
188 (cons (list server 325 (qop (cdr-safe (assoc "qop" attrs)))
189 (cons file 326 (nonce (cdr-safe (assoc "nonce" attrs)))
190 (setq retval 327 (opaque (cdr-safe (assoc "opaque" attrs))))
191 (cons user 328
192 (url-digest-auth-create-key 329 (concat
193 user pass realm 330 "Digest "
194 (or url-request-method "GET") 331 (url-digest-auth-name-value-string
195 url))))) 332 (append (list (cons 'username user)
196 url-digest-auth-storage))) 333 (cons 'realm realm)
197 (byserv 334 (cons 'nonce nonce)
198 (setq retval (cdr-safe (assoc file byserv))) 335 (cons 'uri digest-uri))
199 (if (and (not retval) ; no exact match, check directories 336
200 (string-match "/" file)) ; not looking for a realm 337 (cond
201 (while (and byserv (not retval)) 338 ((null qop)
202 (setq data (car (car byserv))) 339 (list (cons 'response (url-digest-auth-make-request-digest
203 (if (or (not (string-match "/" data)) 340 ha1 ha2 nonce))))
204 (and 341 ((string= qop "auth")
205 (>= (length file) (length data)) 342 (let ((nc (url-digest-auth-nonce-count nonce))
206 (string= data (substring file 0 (length data))))) 343 (cnonce (url-digest-auth-make-cnonce)))
207 (setq retval (cdr (car byserv)))) 344 (list (cons 'qop qop)
208 (setq byserv (cdr byserv)))) 345 (cons 'nc nc)
209 (if overwrite 346 (cons 'cnonce cnonce)
210 (if (and (not retval) prompt) 347 (cons 'response
211 (setq user (or 348 (url-digest-auth-make-request-digest-qop
212 (url-do-auth-source-search server type :user) 349 qop ha1 ha2 nonce nc cnonce)))))
213 (read-string (url-auth-user-prompt url realm) 350 (t (message "Quality of protection \"%s\" is not implemented." qop)
214 (user-real-login-name))) 351 nil))
215 pass (or 352
216 (url-do-auth-source-search server type :secret) 353
217 (read-passwd "Password: ")) 354 (if opaque (list (cons 'opaque opaque)))))))))
218 retval (setq retval 355
219 (cons user 356(defun url-digest-find-creds (url prompt &optional realm)
220 (url-digest-auth-create-key 357 "Find or ask credentials for URL.
221 user pass realm 358
222 (or url-request-method "GET") 359Primary method for finding credentials is from Emacs auth-source.
223 url))) 360If password isn't found, and PROMPT is non-nil, query credentials
224 byserv (assoc server url-digest-auth-storage)) 361via minibuffer. Optional REALM may be used when prompting as a
225 (setcdr byserv 362hint to the user.
226 (cons (cons file retval) (cdr byserv)))))) 363
227 (t (setq retval nil))) 364Return value is nil in case either user name or password wasn't
228 (if retval 365found. Otherwise, it's a plist containing `:user' and `:secret'.
229 (if (cdr-safe (assoc "opaque" args)) 366Additional `:source' property denotes the origin of the
230 (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven")) 367credentials and its value can be either symbol `authsource' or
231 (opaque (cdr-safe (assoc "opaque" args)))) 368`interactive'."
232 (format 369 (let ((creds (url-digest-auth-source-creds url)))
233 (concat "Digest username=\"%s\", realm=\"%s\"," 370
234 "nonce=\"%s\", uri=\"%s\"," 371 ;; If credentials weren't found and prompting is allowed, prompt
235 "response=\"%s\", opaque=\"%s\"") 372 ;; the user.
236 (nth 0 retval) realm nonce (url-filename href) 373 (if (and prompt
237 (md5 (concat (nth 1 retval) ":" nonce ":" 374 (or (null creds)
238 (nth 2 retval))) opaque)) 375 (null (plist-get creds :secret))))
239 (let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))) 376 (progn
240 (format 377 (setq creds (url-digest-prompt-creds url realm creds))
241 (concat "Digest username=\"%s\", realm=\"%s\"," 378 (plist-put creds :source 'interactive))
242 "nonce=\"%s\", uri=\"%s\"," 379 (plist-put creds :source 'authsource))
243 "response=\"%s\"") 380
244 (nth 0 retval) realm nonce (url-filename href) 381 (and (plist-get creds :user)
245 (md5 (concat (nth 1 retval) ":" nonce ":" 382 (plist-get creds :secret)
246 (nth 2 retval)))))))))) 383 creds)))
384
385(defun url-digest-find-new-key (url realm prompt)
386 "Find credentials and create a new authorization key for given URL and REALM.
387
388Return value is the new key, or nil if credentials weren't found.
389\"New\" in this context means a key that's not yet found in cache
390variable `url-digest-auth-storage'. You may use `url-digest-cache-key'
391to put it there.
392
393This function uses `url-digest-find-creds' to find the
394credentials. It first looks in auth-source. If not found, and
395PROMPT is non-nil, user is asked for credentials interactively
396via minibuffer."
397 (let (creds)
398 (unwind-protect
399 (if (setq creds (url-digest-find-creds url prompt realm))
400 (cons (url-digest-auth-directory-id url realm)
401 (cons (plist-get creds :user)
402 (url-digest-auth-create-key
403 (plist-get creds :user)
404 (plist-get creds :secret)
405 realm
406 (or url-request-method "GET")
407 (url-filename url)))))
408 (if (and creds
409 ;; Don't clear secret for `authsource' since it will
410 ;; corrupt any future fetches for it.
411 (not (eq (plist-get creds :source) 'authsource)))
412 (clear-string (plist-get creds :secret))))))
413
414(defun url-digest-auth (url &optional prompt overwrite realm attrs)
415 "Get the HTTP Digest response string for the specified URL.
416
417If optional argument PROMPT is non-nil, ask for the username and
418password to use for the URL and its descendants but only if one
419cannot be found from cache. Look also in Emacs auth-source.
420
421If optional third argument OVERWRITE is non-nil, overwrite the
422old credentials, if they're found in cache, with new ones from
423user prompt or from Emacs auth-source.
424
425If REALM is specified, use that instead of the URL descendant
426method to match cached credentials.
427
428Alist ATTRS contains additional attributes for the authentication
429challenge such as nonce and opaque."
430 (if attrs
431 (let* ((href (if (stringp url) (url-generic-parse-url url) url))
432 (enable-recursive-minibuffers t)
433 (key (url-digest-cached-key href realm)))
434
435 (if (or (null key) overwrite)
436 (let ((newkey (url-digest-find-new-key href realm (cond
437 (key nil)
438 (t prompt)))))
439 (if (and newkey key overwrite)
440 (setcdr key (cdr newkey))
441 (if (and newkey (null key))
442 (url-digest-cache-key (setq key newkey) href)))))
443
444 (if key
445 (url-digest-auth-build-response key href realm attrs)))))
247 446
248(defvar url-registered-auth-schemes nil 447(defvar url-registered-auth-schemes nil
249 "A list of the registered authorization schemes and various and sundry 448 "A list of the registered authorization schemes and various and sundry
diff --git a/test/Makefile.in b/test/Makefile.in
index c0056b6f44d..d218b640057 100644
--- a/test/Makefile.in
+++ b/test/Makefile.in
@@ -124,12 +124,12 @@ endif
124 $(emacs) -l ert -l $$loadfile \ 124 $(emacs) -l ert -l $$loadfile \
125 --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG} 125 --eval "(ert-run-tests-batch-and-exit ${SELECTOR_ACTUAL})" ${WRITE_LOG}
126 126
127ELFILES = $(shell find ${srcdir} -path "${srcdir}/manual" -prune -o \ 127ELFILES := $(shell find ${srcdir} -path "${srcdir}/manual" -prune -o \
128 -path "*resources" -prune -o -name "*el" -print) 128 -name "*resources" -prune -o -name "*.el" -print)
129## .log files may be in a different directory for out of source builds 129## .log files may be in a different directory for out of source builds
130LOGFILES = $(patsubst %.el,%.log, \ 130LOGFILES := $(patsubst %.el,%.log, \
131 $(patsubst $(srcdir)%,.%,$(ELFILES))) 131 $(patsubst $(srcdir)%,.%,$(ELFILES)))
132TESTS = $(subst ${srcdir}/,,$(LOGFILES:.log=)) 132TESTS := $(subst ${srcdir}/,,$(LOGFILES:.log=))
133 133
134## If we have to interrupt a hanging test, preserve the log so we can 134## If we have to interrupt a hanging test, preserve the log so we can
135## see what the problem was. 135## see what the problem was.
@@ -141,6 +141,11 @@ TESTS = $(subst ${srcdir}/,,$(LOGFILES:.log=))
141## Define an alias both with and without the directory name for ease 141## Define an alias both with and without the directory name for ease
142## of use. 142## of use.
143define test_template 143define test_template
144 ifeq (,$(patsubst $(srcdir)/src/%,,$(1)))
145 $(1): $(srcdir)/../src/$(1:.log=.c)
146 else
147 $(1): $(srcdir)/../lisp/$(1:.log=.el)
148 endif
144$(1): 149$(1):
145 @test ! -f ./$(1).log || mv ./$(1).log ./$(1).log~ 150 @test ! -f ./$(1).log || mv ./$(1).log ./$(1).log~
146 @${MAKE} ./$(1).log WRITE_LOG= 151 @${MAKE} ./$(1).log WRITE_LOG=
@@ -157,11 +162,6 @@ $(foreach test,${TESTS},$(eval $(call test_template,${test})))
157check-no-automated-subdir: 162check-no-automated-subdir:
158 test ! -d $(srcdir)/automated 163 test ! -d $(srcdir)/automated
159 164
160## Include dependencies between test files and the files they test.
161## We could do this without the file and eval directly, but then we
162## would have to run Emacs for every make invocation, and it might not
163## be available during clean.
164-include make-test-deps.mk
165## Rerun all default tests. 165## Rerun all default tests.
166check: mostlyclean check-no-automated-subdir 166check: mostlyclean check-no-automated-subdir
167 @${MAKE} check-doit SELECTOR="${SELECTOR_ACTUAL}" 167 @${MAKE} check-doit SELECTOR="${SELECTOR_ACTUAL}"
@@ -175,7 +175,7 @@ check-expensive: mostlyclean check-no-automated-subdir
175## logfile is out-of-date with either the test file, or the source 175## logfile is out-of-date with either the test file, or the source
176## files that the tests depend on. The source file dependencies are 176## files that the tests depend on. The source file dependencies are
177## determined by a heuristic and does not identify the full dependency 177## determined by a heuristic and does not identify the full dependency
178## graph. See make-test-deps.emacs-lisp for details. 178## graph. See test_template for details.
179.PHONY: check-maybe 179.PHONY: check-maybe
180check-maybe: check-no-automated-subdir 180check-maybe: check-no-automated-subdir
181 @${MAKE} check-doit SELECTOR="${SELECTOR_ACTUAL}" 181 @${MAKE} check-doit SELECTOR="${SELECTOR_ACTUAL}"
@@ -183,7 +183,7 @@ check-maybe: check-no-automated-subdir
183## Run the tests. 183## Run the tests.
184.PHONY: check-doit 184.PHONY: check-doit
185check-doit: ${LOGFILES} 185check-doit: ${LOGFILES}
186 $(emacs) -l ert -f ert-summarize-tests-batch-and-exit $^ 186 @$(emacs) -l ert -f ert-summarize-tests-batch-and-exit $^
187 187
188.PHONY: mostlyclean clean bootstrap-clean distclean maintainer-clean 188.PHONY: mostlyclean clean bootstrap-clean distclean maintainer-clean
189 189
@@ -193,7 +193,6 @@ mostlyclean:
193 193
194clean: 194clean:
195 find . '(' -name '*.log' -o -name '*.log~' ')' $(FIND_DELETE) 195 find . '(' -name '*.log' -o -name '*.log~' ')' $(FIND_DELETE)
196 rm -f make-test-deps.mk
197 196
198bootstrap-clean: clean 197bootstrap-clean: clean
199 find $(srcdir) -name '*.elc' $(FIND_DELETE) 198 find $(srcdir) -name '*.elc' $(FIND_DELETE)
@@ -202,11 +201,3 @@ distclean: clean
202 rm -f Makefile 201 rm -f Makefile
203 202
204maintainer-clean: distclean bootstrap-clean 203maintainer-clean: distclean bootstrap-clean
205
206make-test-deps.mk: $(ELFILES) make-test-deps.emacs-lisp
207 $(EMACS) --batch -l $(srcdir)/make-test-deps.emacs-lisp \
208 --eval "(make-test-deps \"$(srcdir)\")" \
209 2> $@.tmp
210 # Hack to elide any CANNOT_DUMP=yes chatter.
211 sed '/\.log: /!d' $@.tmp >$@
212 rm -f $@.tmp
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el
index b5946208f10..093cb3476c1 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -494,12 +494,29 @@
494 (should-not (cl-typep 1 'cl-lib-test-type))) 494 (should-not (cl-typep 1 'cl-lib-test-type)))
495 495
496(ert-deftest cl-lib-symbol-macrolet () 496(ert-deftest cl-lib-symbol-macrolet ()
497 ;; bug#26325
498 :expected-result :failed
497 (should (equal (cl-flet ((f (x) (+ x 5))) 499 (should (equal (cl-flet ((f (x) (+ x 5)))
498 (let ((x 5)) 500 (let ((x 5))
499 (f (+ x 6)))) 501 (f (+ x 6))))
500 (cl-symbol-macrolet ((f (+ x 6))) 502 ;; Go through `eval', otherwise the macro-expansion
501 (cl-flet ((f (x) (+ x 5))) 503 ;; error prevents running the whole test suite :-(
502 (let ((x 5)) 504 (eval '(cl-symbol-macrolet ((f (+ x 6)))
503 (f f))))))) 505 (cl-flet ((f (x) (+ x 5)))
506 (let ((x 5))
507 (f f))))
508 t))))
509
510(defmacro cl-lib-symbol-macrolet-4+5 ()
511 ;; bug#26068
512 (let* ((sname "x")
513 (s1 (make-symbol sname))
514 (s2 (make-symbol sname)))
515 `(cl-symbol-macrolet ((,s1 4)
516 (,s2 5))
517 (+ ,s1 ,s2))))
518
519(ert-deftest cl-lib-symbol-macrolet-2 ()
520 (should (equal (cl-lib-symbol-macrolet-4+5) (+ 4 5))))
504 521
505;;; cl-lib.el ends here 522;;; cl-lib.el ends here
diff --git a/test/lisp/progmodes/js-tests.el b/test/lisp/progmodes/js-tests.el
index e030675e07c..8e1bac10cd1 100644
--- a/test/lisp/progmodes/js-tests.el
+++ b/test/lisp/progmodes/js-tests.el
@@ -140,6 +140,43 @@ if (!/[ (:,='\"]/.test(value)) {
140 (font-lock-ensure) 140 (font-lock-ensure)
141 (should (eq (get-text-property (point) 'face) (caddr test)))))) 141 (should (eq (get-text-property (point) 'face) (caddr test))))))
142 142
143(ert-deftest js-mode-propertize-bug-1 ()
144 (with-temp-buffer
145 (js-mode)
146 (save-excursion (insert "x"))
147 (insert "/")
148 ;; The bug was a hang.
149 (should t)))
150
151(ert-deftest js-mode-propertize-bug-2 ()
152 (with-temp-buffer
153 (js-mode)
154 (insert "function f() {
155 function g()
156 {
157 1 / 2;
158 }
159
160 function h() {
161")
162 (save-excursion
163 (insert "
164 00000000000000000000000000000000000000000000000000;
165 00000000000000000000000000000000000000000000000000;
166 00000000000000000000000000000000000000000000000000;
167 00000000000000000000000000000000000000000000000000;
168 00000000000000000000000000000000000000000000000000;
169 00000000000000000000000000000000000000000000000000;
170 00000000000000000000000000000000000000000000000000;
171 00000000000000000000000000000000000000000000000000;
172 00;
173 }
174}
175"))
176 (insert "/")
177 ;; The bug was a hang.
178 (should t)))
179
143(provide 'js-tests) 180(provide 'js-tests)
144 181
145;;; js-tests.el ends here 182;;; js-tests.el ends here
diff --git a/test/lisp/url/url-auth-tests.el b/test/lisp/url/url-auth-tests.el
index 11e5a479720..30636db083c 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.")
77 :expected-ha2 "b44272ea65ee4af7fb26c5dba58f6863" 77 :expected-ha2 "b44272ea65ee4af7fb26c5dba58f6863"
78 :expected-response "0d84884d967e04440efc77e9e2b5b561"))) 78 :expected-response "0d84884d967e04440efc77e9e2b5b561")))
79 79
80(ert-deftest url-auth-test-colonjoin ()
81 "Check joining strings with `:'."
82 (should (string= (url-digest-auth-colonjoin) ""))
83 (should (string= (url-digest-auth-colonjoin nil) ""))
84 (should (string= (url-digest-auth-colonjoin nil nil nil) "::"))
85 (should (string= (url-digest-auth-colonjoin "") ""))
86 (should (string= (url-digest-auth-colonjoin "" "") ":"))
87 (should (string= (url-digest-auth-colonjoin "one") "one"))
88 (should (string= (url-digest-auth-colonjoin "one" "two" "three") "one:two:three")))
89
90(ert-deftest url-auth-test-digest-ha1 ()
91 "Check HA1 computation."
92 (dolist (row url-auth-test-challenges)
93 (should (string= (url-digest-auth-make-ha1 (plist-get row :username)
94 (plist-get row :realm)
95 (plist-get row :password))
96 (plist-get row :expected-ha1)
97 ))))
98
99(ert-deftest url-auth-test-digest-ha2 ()
100 "Check HA2 computation."
101 (dolist (row url-auth-test-challenges)
102 (should (string= (url-digest-auth-make-ha2 (plist-get row :method)
103 (plist-get row :uri))
104 (plist-get row :expected-ha2)))))
105
106(ert-deftest url-auth-test-digest-request-digest ()
107 "Check digest response value."
108 (dolist (row url-auth-test-challenges)
109 (should (string= (plist-get row :expected-response)
110 (if (plist-member row :qop)
111 (url-digest-auth-make-request-digest-qop
112 (plist-get row :qop)
113 (plist-get row :expected-ha1)
114 (plist-get row :expected-ha2)
115 (plist-get row :nonce)
116 (plist-get row :nc)
117 (plist-get row :cnonce))
118 (url-digest-auth-make-request-digest
119 (plist-get row :expected-ha1)
120 (plist-get row :expected-ha2)
121 (plist-get row :nonce)))))))
122
80(ert-deftest url-auth-test-digest-create-key () 123(ert-deftest url-auth-test-digest-create-key ()
81 "Check user credentials in their hashed form." 124 "Check user credentials in their hashed form."
82 (dolist (challenge url-auth-test-challenges) 125 (dolist (challenge url-auth-test-challenges)
@@ -223,14 +266,12 @@ test and cannot be passed by arguments to `url-digest-auth'."
223 (progn 266 (progn
224 ;; We don't know these, just check that they exists. 267 ;; We don't know these, just check that they exists.
225 (should (string-match-p ".*response=\".*?\".*" auth)) 268 (should (string-match-p ".*response=\".*?\".*" auth))
226 ;; url-digest-auth doesn't return these AFAICS. 269 (should (string-match-p ".*nc=\".*?\".*" auth))
227;;; (should (string-match-p ".*nc=\".*?\".*" auth)) 270 (should (string-match-p ".*cnonce=\".*?\".*" auth)))
228;;; (should (string-match-p ".*cnonce=\".*?\".*" auth))
229 )
230 (should (string-match ".*response=\"\\(.*?\\)\".*" auth)) 271 (should (string-match ".*response=\"\\(.*?\\)\".*" auth))
231 (should (string= (match-string 1 auth) 272 (should (string= (match-string 1 auth)
232 (plist-get challenge :expected-response)))) 273 (plist-get challenge :expected-response))))
233 ))) 274 )))
234 275
235(ert-deftest url-auth-test-digest-auth-opaque () 276(ert-deftest url-auth-test-digest-auth-opaque ()
236 "Check that `opaque' value is added to result when presented by 277 "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 9aacb6bd20f..387786ced06 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
41 41
42(ert-deftest ediff-ptch-test-bug26084 () 42(ert-deftest ediff-ptch-test-bug26084 ()
43 "Test for http://debbugs.gnu.org/26084 ." 43 "Test for http://debbugs.gnu.org/26084 ."
44 (let* ((tmpdir temporary-file-directory) 44 (skip-unless (executable-find "git"))
45 (foo (expand-file-name "foo" tmpdir)) 45 (skip-unless (executable-find ediff-patch-program))
46 (patch (expand-file-name "foo.diff" tmpdir)) 46 (let* ((tmpdir (make-temp-file "ediff-ptch-test" t))
47 (qux (expand-file-name "qux.txt" foo)) 47 (default-directory (file-name-as-directory tmpdir))
48 (bar (expand-file-name "bar.txt" foo)) 48 (patch (make-temp-file "ediff-ptch-test"))
49 (cmd " 49 (qux (expand-file-name "qux.txt" tmpdir))
50mkdir -p foo 50 (bar (expand-file-name "bar.txt" tmpdir))
51cd foo 51 (git-program (executable-find "git")))
52echo 'qux here' > qux.txt 52 ;; Create repository.
53echo 'bar here' > bar.txt 53 (with-temp-buffer
54git init 54 (insert "qux here\n")
55git add . && git commit -m 'Test repository.' 55 (write-region nil nil qux nil 'silent)
56echo 'foo here' > qux.txt 56 (erase-buffer)
57echo 'foo here' > bar.txt 57 (insert "bar here\n")
58git diff > ../foo.diff 58 (write-region nil nil bar nil 'silent))
59git reset --hard HEAD 59 (call-process git-program nil nil nil "init")
60")) 60 (call-process git-program nil nil nil "add" ".")
61 (setq default-directory tmpdir) 61 (call-process git-program nil nil nil "commit" "-m" "Test repository.")
62 (call-process-shell-command cmd) 62 ;; Update repo., save the diff and reset to initial state.
63 (with-temp-buffer
64 (insert "foo here\n")
65 (write-region nil nil qux nil 'silent)
66 (write-region nil nil bar nil 'silent))
67 (call-process git-program nil `(:file ,patch) nil "diff")
68 (call-process git-program nil nil nil "reset" "--hard" "HEAD")
63 (find-file patch) 69 (find-file patch)
64 (unwind-protect 70 (unwind-protect
65 (let* ((info 71 (let* ((info
@@ -76,23 +82,27 @@ git reset --hard HEAD
76 (dolist (x (list (cons patch1 bar) (cons patch2 qux))) 82 (dolist (x (list (cons patch1 bar) (cons patch2 qux)))
77 (with-temp-buffer 83 (with-temp-buffer
78 (insert (car x)) 84 (insert (car x))
79 (call-shell-region (point-min) 85 (call-process-region (point-min)
80 (point-max) 86 (point-max)
81 (format "%s %s %s %s" 87 ediff-patch-program
82 ediff-patch-program 88 nil nil nil
83 ediff-patch-options 89 "-b" (cdr x))))
84 ediff-backup-specs
85 (cdr x)))))
86 ;; Check backup files were saved correctly. 90 ;; Check backup files were saved correctly.
87 (dolist (x (list qux bar)) 91 (dolist (x (list qux bar))
88 (should-not (string= (with-temp-buffer 92 (let ((backup
89 (insert-file-contents x) 93 (car
90 (buffer-string)) 94 (directory-files
91 (with-temp-buffer 95 tmpdir 'full
92 (insert-file-contents (concat x ediff-backup-extension)) 96 (concat (file-name-nondirectory x) ".")))))
93 (buffer-string)))))) 97 (should-not
94 (delete-directory foo 'recursive) 98 (string= (with-temp-buffer
95 (delete-file patch)))) 99 (insert-file-contents x)
100 (buffer-string))
101 (with-temp-buffer
102 (insert-file-contents backup)
103 (buffer-string))))))
104 (delete-directory tmpdir 'recursive)
105 (delete-file patch)))))
96 106
97 107
98(provide 'ediff-ptch-tests) 108(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 609e9276186..00000000000
--- a/test/make-test-deps.emacs-lisp
+++ /dev/null
@@ -1,98 +0,0 @@
1;; -*- emacs-lisp -*-
2
3;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21
22;; This file generates dependencies between test files and the files
23;; that they test.
24
25;; It has an .emacs-lisp extension because it makes the Makefile easier!
26
27(require 'seq)
28
29(defun make-test-deps (src-dir)
30 (let ((src-dir (file-truename src-dir)))
31 (message
32 "%s"
33 (concat
34 (make-test-deps-lisp src-dir)
35 (make-test-deps-src src-dir)))))
36
37(defun make-test-deps-lisp (src-dir)
38 (mapconcat
39 (lambda (file-without-suffix)
40 (format "./%s-tests.log: %s/../%s.el\n"
41 file-without-suffix
42 src-dir
43 file-without-suffix))
44 (make-test-test-files src-dir "lisp") ""))
45
46(defun make-test-deps-src (src-dir)
47 (mapconcat
48 (lambda (file-without-suffix)
49 (format "./%s-tests.log: %s/../%s.c\n"
50 file-without-suffix
51 src-dir
52 file-without-suffix))
53 (make-test-test-files src-dir "src") ""))
54
55(defun make-test-test-files (src-dir sub-src-dir)
56 (make-test-munge-files
57 src-dir
58 (directory-files-recursively
59 (concat src-dir "/" sub-src-dir)
60 ".*-tests.el$")))
61
62(defun make-test-munge-files (src-dir files)
63 (make-test-sans-suffix
64 (make-test-de-stem
65 src-dir
66 (make-test-no-legacy
67 (make-test-no-test-dir
68 (make-test-no-resources
69 files))))))
70
71(defun make-test-sans-suffix (files)
72 (mapcar
73 (lambda (file)
74 (substring file 0 -9))
75 files))
76
77(defun make-test-de-stem (stem files)
78 (mapcar
79 (lambda (file)
80 (substring
81 file
82 (+ 1 (length stem))))
83 files))
84
85(defun make-test-no-legacy (list)
86 (make-test-remove list "legacy/"))
87
88(defun make-test-no-resources (list)
89 (make-test-remove list "-resources/"))
90
91(defun make-test-no-test-dir (list)
92 (make-test-remove list "-tests/"))
93
94(defun make-test-remove (list match)
95 (seq-remove
96 (lambda (file)
97 (string-match-p match file))
98 list))
generated by cgit v1.2.1 (git 2.18.0) at 2026-02-04 17:55:36 +0000