[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/android f5d142f6637: Merge remote-tracking branch 'origin/master
|
From: |
Po Lu |
|
Subject: |
feature/android f5d142f6637: Merge remote-tracking branch 'origin/master' into feature/android |
|
Date: |
Fri, 23 Jun 2023 21:20:44 -0400 (EDT) |
branch: feature/android
commit f5d142f66370b29af58360faeea90d1112756bc5
Merge: a5ee9a69ae7 77c2f05d773
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
Merge remote-tracking branch 'origin/master' into feature/android
---
doc/lispref/modes.texi | 9 ---
doc/misc/tramp.texi | 11 ++-
etc/NEWS | 27 ++++---
lisp/emacs-lisp/cl-macs.el | 33 ++++++--
lisp/net/tramp-container.el | 145 +++++++++++++++++++++++++++-------
lisp/net/tramp-sh.el | 10 ++-
lisp/net/tramp.el | 29 ++++---
src/lisp.h | 1 -
src/window.c | 66 ++--------------
src/xdisp.c | 6 --
test/lisp/emacs-lisp/cl-macs-tests.el | 22 +++++-
11 files changed, 219 insertions(+), 140 deletions(-)
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 3bb3ae9b939..cdbda5503b7 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -2597,15 +2597,6 @@ It is normally @code{nil}, so that ordinary buffers have
no header
line.
@end defvar
-Emacs displays the header line for a window unless
-@code{header-line-format} is either @code{nil}, or it's a list whose
-@sc{car} is a symbol, and either that symbol is @code{:eval} and the
-second list element evaluates to @code{nil} or the symbol's value as a
-variable is @code{nil} or void. Note that there are other possible
-values @code{header-line-format} that result in an empty header line
-(for example, @code{""}), but all other values tell Emacs to display a
-header line, whether or not it is empty.
-
If @code{display-line-numbers-mode} is turned on in a buffer
(@pxref{Display Custom, display-line-numbers-mode,, emacs, The GNU
Emacs Manual}), the buffer text is indented on display by the amount
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index eb5c418728e..01f46865a39 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -922,8 +922,15 @@ if desired.
@cindex @option{kubernetes} method
Integration for containers in Kubernetes pods. The host name is a pod
-name returned by @samp{kubectl get pods}. The first container in a
-pod is used.
+name returned by @samp{kubectl get pods}, or
+@samp{@var{container}.@var{pod}} if an explicit container name shall
+be used. Otherwise, the first container in a pod is used.
+
+@vindex tramp-kubernetes-context
+@vindex tramp-kubernetes-namespace
+If another Kubernetes context or namespace shall be used, configure
+the user options @code{tramp-kubernetes-context} and
+@code{tramp-kubernetes-namespace}.
This method does not support user names.
diff --git a/etc/NEWS b/etc/NEWS
index 487eaf22feb..c707ac279cf 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -241,6 +241,14 @@ point is not in a comment or a string. It is by default
bound to
They allow accessing system containers provided by Toolbox or
sandboxes provided by Flatpak.
++++
+*** Connection method "kubernetes" supports now optional container name.
+The host name for Kubernetes connections can be of kind [CONTAINER.]POD,
+in order to specify a dedicated container. If there is just the pod
+name, the first container in the pod is taken. The new user options
+'tramp-kubernetes-context' and 'tramp-kubernetes-namespace' allow to
+access pods with different context or namespace but the default one.
+
+++
*** Rename 'tramp-use-ssh-controlmaster-options' to
'tramp-use-connection-share'.
The old name still exists as obsolete variable alias. This user
@@ -419,17 +427,18 @@ name as a string. The new function
completion based on dictionaries that the server supports.
** Pp
-*** New 'pp-default-function' custom variable replaces 'pp-use-max-width'.
+
+*** New 'pp-default-function' user option replaces 'pp-use-max-width'.
*** New default pretty printing function, which tries to obey 'fill-column'.
-*** 'pp-to-string' takes an additional 'pp-function' argument.
-This arg specifies the prettifying algorithm to use.
+*** 'pp-to-string' takes an additional PP-FUNCTION argument.
+This argument specifies the prettifying algorithm to use.
** Emacs Lisp mode
---
-*** ',@' now has 'prefix' syntax
+*** ',@' now has 'prefix' syntax.
Previously, the '@' character, which normally has 'symbol' syntax,
would combine with a following Lisp symbol and interfere with symbol
searching.
@@ -493,17 +502,9 @@ hooks named after the feature name, like
'esh-mode-unload-hook'.
+++
** 'copy-tree' now copies records when its optional 2nd argument is non-nil.
-+++
-** Certain values of 'header-line-format' now inhibit empty header line.
-Emacs now avoids displaying a header line, instead of displaying an
-empty one, when 'header-line-format' is a list whose 'car' is a
-symbol, and either that symbol is ':eval' and the second element of
-the list evaluates to 'nil' or the symbol's value as a variable is
-'nil' or void.
-
+++
** Regexp zero-width assertions followed by operators are better defined.
-Previously, regexps such as "xy\\B*" would have ill-defined behaviour.
+Previously, regexps such as "xy\\B*" would have ill-defined behavior.
Now any operator following a zero-width assertion applies to that
assertion only (which is useless). For historical compatibility, an
operator character following '^' or '\`' becomes literal, but we
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 0b09cd7d225..4caa573ea9d 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -243,6 +243,25 @@ The name is made by appending a number to PREFIX, default
\"T\"."
(defvar cl--bind-enquote) ;Non-nil if &cl-quote was in the formal arglist!
(defvar cl--bind-lets) (defvar cl--bind-forms)
+(defun cl--slet (bindings body)
+ "Like `cl--slet*' but for \"parallel let\"."
+ (cond
+ ((seq-some (lambda (binding) (macroexp--dynamic-variable-p (car binding)))
+ bindings)
+ ;; FIXME: We use `identity' to obfuscate the code enough to
+ ;; circumvent the known bug in `macroexp--unfold-lambda' :-(
+ `(funcall (identity (lambda (,@(mapcar #'car bindings))
+ ,@(macroexp-unprogn body)))
+ ,@(mapcar #'cadr bindings)))
+ ((null (cdr bindings))
+ (macroexp-let* bindings body))
+ (t `(let ,bindings ,@(macroexp-unprogn body)))))
+
+(defun cl--slet* (bindings body)
+ "Like `macroexp-let*' but uses static scoping for all the BINDINGS."
+ (if (null bindings) body
+ (cl--slet `(,(car bindings)) (cl--slet* (cdr bindings) body))))
+
(defun cl--transform-lambda (form bind-block)
"Transform a function form FORM of name BIND-BLOCK.
BIND-BLOCK is the name of the symbol to which the function will be bound,
@@ -337,10 +356,11 @@ FORM is of the form (ARGS . BODY)."
(list '&rest (car (pop cl--bind-lets))))))))
`((,@(nreverse simple-args) ,@rest-args)
,@header
- ,(macroexp-let* cl--bind-lets
- (macroexp-progn
- `(,@(nreverse cl--bind-forms)
- ,@body)))))))
+ ;; Function arguments are unconditionally statically scoped
(bug#47552).
+ ,(cl--slet* cl--bind-lets
+ (macroexp-progn
+ `(,@(nreverse cl--bind-forms)
+ ,@body)))))))
;;;###autoload
(defmacro cl-defun (name args &rest body)
@@ -2896,9 +2916,10 @@ The function's arguments should be treated as immutable.
(cl-defun ,name ,args ,@body))))
(defun cl--defsubst-expand (argns body _simple whole _unsafe &rest argvs)
- (if (and whole (not (cl--safe-expr-p (cons 'progn argvs))))
+ (if (and whole (not (cl--safe-expr-p (macroexp-progn argvs))))
whole
- `(let ,(cl-mapcar #'list argns argvs) ,body)))
+ ;; Function arguments are unconditionally statically scoped (bug#47552).
+ (cl--slet (cl-mapcar #'list argns argvs) body)))
;;; Structures.
diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el
index 473cb1c54b8..6e8d28a3016 100644
--- a/lisp/net/tramp-container.el
+++ b/lisp/net/tramp-container.el
@@ -37,19 +37,20 @@
;; C-x C-f /podman:USER@CONTAINER:/path/to/file
;;
;; Where:
-;; USER is the user on the container to connect as (optional)
-;; CONTAINER is the container to connect to
+;; USER is the user on the container to connect as (optional).
+;; CONTAINER is the container to connect to.
;;
;;
;;
;; Open file in a Kubernetes container:
;;
-;; C-x C-f /kubernetes:POD:/path/to/file
+;; C-x C-f /kubernetes:[CONTAINER.]POD:/path/to/file
;;
;; Where:
-;; POD is the pod to connect to.
-;; By default, the first container in that pod will be
-;; used.
+;; POD is the pod to connect to.
+;; CONTAINER is the container to connect to (optional).
+;; By default, the first container in that pod will
+;; be used.
;;
;; Completion for POD and accessing it operate in the current
;; namespace, use this command to change it:
@@ -63,7 +64,7 @@
;; C-x C-f /toolbox:CONTAINER:/path/to/file
;;
;; Where:
-;; CONTAINER is the container to connect to (optional)
+;; CONTAINER is the container to connect to (optional).
;;
;; If the container is not running, it is started. If no container is
;; specified, the default Toolbox container is used.
@@ -106,6 +107,20 @@
:type '(choice (const "kubectl")
(string)))
+(defcustom tramp-kubernetes-context nil
+ "Context of Kubernetes.
+If it is nil, the default context will be used."
+ :group 'tramp
+ :version "30.1"
+ :type '(choice (const :tag "Use default" nil)
+ (string)))
+
+(defcustom tramp-kubernetes-namespace "default"
+ "Namespace of Kubernetes."
+ :group 'tramp
+ :version "30.1"
+ :type 'string)
+
;;;###tramp-autoload
(defcustom tramp-toolbox-program "toolbox"
"Name of the Toolbox client program."
@@ -172,29 +187,83 @@ This function is used by `tramp-set-completion-function',
please
see its function help for a description of the format."
(when-let ((default-directory tramp-compat-temporary-file-directory)
(raw-list (shell-command-to-string
- (concat tramp-kubernetes-program
- " get pods --no-headers "
- "-o custom-columns=NAME:.metadata.name")))
- (names (split-string raw-list "\n" 'omit)))
- (mapcar (lambda (name) (list nil name)) (delq nil names))))
+ (concat
+ tramp-kubernetes-program " "
+ (tramp-kubernetes--context-namespace nil)
+ " get pods --no-headers"
+ ;; We separate pods by "|". Inside a pod,
+ ;; its name is separated from the containers
+ ;; by ":". Containers are separated by ",".
+ " -o jsonpath='{range
.items[*]}{\"|\"}{.metadata.name}"
+ "{\":\"}{range .spec.containers[*]}{.name}{\",\"}"
+ "{end}{end}'")))
+ (lines (split-string raw-list "|" 'omit)))
+ (let (names)
+ (dolist (line lines)
+ (setq line (split-string line ":" 'omit))
+ ;; Pod name.
+ (push (car line) names)
+ ;; Container names.
+ (dolist (elt (split-string (cadr line) "," 'omit))
+ (push (concat elt "." (car line)) names)))
+ (mapcar (lambda (name) (list nil name)) (delq nil names)))))
+
+(defconst tramp-kubernetes--host-name-regexp
+ (rx (? (group (regexp tramp-host-regexp)) ".")
+ (group (regexp tramp-host-regexp)))
+ "The CONTAINER.POD syntax of kubernetes host names in Tramp.")
+
+;;;###tramp-autoload
+(defun tramp-kubernetes--container (vec)
+ "Extract the container name from a kubernetes host name in VEC."
+ (or (let ((host (tramp-file-name-host vec)))
+ (and (string-match tramp-kubernetes--host-name-regexp host)
+ (match-string 1 host)))
+ ""))
+
+;;;###tramp-autoload
+(defun tramp-kubernetes--pod (vec)
+ "Extract the pod name from a kubernetes host name in VEC."
+ (or (let ((host (tramp-file-name-host vec)))
+ (and (string-match tramp-kubernetes--host-name-regexp host)
+ (match-string 2 host)))
+ ""))
+
+(defun tramp-kubernetes--current-context (vec)
+ "Return Kubernetes current context.
+Obey `tramp-kubernetes-context'"
+ (or tramp-kubernetes-context
+ (with-tramp-connection-property nil "current-context"
+ (with-temp-buffer
+ (when (zerop
+ (tramp-call-process
+ vec tramp-kubernetes-program nil t nil
+ "config" "current-context"))
+ (goto-char (point-min))
+ (buffer-substring (point) (line-end-position)))))))
(defun tramp-kubernetes--current-context-data (vec)
"Return Kubernetes current context data as JSON string."
- (with-temp-buffer
- (when (zerop
- (tramp-call-process
- vec tramp-kubernetes-program nil t nil
- "config" "current-context"))
- (goto-char (point-min))
- (let ((current-context (buffer-substring (point) (line-end-position))))
- (erase-buffer)
- (when (zerop
- (tramp-call-process
- vec tramp-kubernetes-program nil t nil
- "config" "view" "-o"
- (format
- "jsonpath='{.contexts[?(@.name == \"%s\")]}'"
current-context)))
- (buffer-string))))))
+ (when-let ((current-context (tramp-kubernetes--current-context vec)))
+ (with-temp-buffer
+ (when (zerop
+ (tramp-call-process
+ vec tramp-kubernetes-program nil t nil
+ "config" "view" "-o"
+ (format
+ "jsonpath='{.contexts[?(@.name == \"%s\")]}'" current-context)))
+ (buffer-string)))))
+
+;;;###tramp-autoload
+(defun tramp-kubernetes--context-namespace (vec)
+ "The kubectl options for context and namespace."
+ (mapconcat
+ #'identity
+ `(,(when-let ((context (tramp-kubernetes--current-context vec)))
+ (format "--context=%s" context))
+ ,(when tramp-kubernetes-namespace
+ (format "--namespace=%s" tramp-kubernetes-namespace)))
+ " "))
;;;###tramp-autoload
(defun tramp-toolbox--completion-function (&rest _args)
@@ -275,12 +344,13 @@ see its function help for a description of the format."
(add-to-list 'tramp-methods
`(,tramp-kubernetes-method
(tramp-login-program ,tramp-kubernetes-program)
- (tramp-login-args (("exec")
+ (tramp-login-args (("%x") ; context and namespace.
+ ("exec")
+ ("-c" "%a") ; container.
("%h")
("-it")
("--")
("%l")))
- (tramp-config-check tramp-kubernetes--current-context-data)
(tramp-direct-async (,tramp-default-remote-shell "-c"))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
@@ -334,6 +404,23 @@ see its function help for a description of the format."
;; Default connection-local variables for Tramp.
+ (defconst tramp-container-connection-local-default-kubernetes-variables
+ '((tramp-config-check . tramp-kubernetes--current-context-data)
+ ;; This variable will be eval'ed in `tramp-expand-args'.
+ (tramp-extra-expand-args
+ . (?a (tramp-kubernetes--container (car tramp-current-connection))
+ ?h (tramp-kubernetes--pod (car tramp-current-connection))
+ ?x (tramp-kubernetes--context-namespace (car
tramp-current-connection)))))
+ "Default connection-local variables for remote kubernetes connections.")
+
+ (connection-local-set-profile-variables
+ 'tramp-container-connection-local-default-kubernetes-profile
+ tramp-container-connection-local-default-kubernetes-variables)
+
+ (connection-local-set-profiles
+ `(:application tramp :protocol ,tramp-kubernetes-method)
+ 'tramp-container-connection-local-default-kubernetes-profile)
+
(defconst tramp-container-connection-local-default-flatpak-variables
`((tramp-remote-path . ,(cons "/app/bin" tramp-remote-path)))
"Default connection-local variables for remote flatpak connections.")
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index da34f31fea6..d8231bd5bd2 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -4324,6 +4324,14 @@ seconds. If not, it produces an error message with the
given ERROR-ARGS."
(apply #'tramp-error-with-buffer
(tramp-get-connection-buffer vec) vec 'file-error error-args)))))
+(defvar tramp-config-check nil
+ "A function to be called with one argument, VEC.
+It should return a string which is used to check, whether the
+configuration of the remote host has been changed (which would
+require to flush the cache data). This string is kept as
+connection property \"config-check-data\".
+This variable is intended as connection-local variable.")
+
(defun tramp-open-connection-setup-interactive-shell (proc vec)
"Set up an interactive shell.
Mainly sets the prompt and the echo correctly. PROC is the shell
@@ -4370,7 +4378,7 @@ process to set up. VEC specifies the connection."
vec "uname"
(tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
(config-check-function
- (tramp-get-method-parameter vec 'tramp-config-check))
+ (buffer-local-value 'tramp-config-check (process-buffer proc)))
(old-config-check
(and config-check-function
(tramp-get-connection-property vec "config-check-data")))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 2264ccd0707..7f818d81123 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -305,13 +305,6 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
and container methods do. If it is a list of strings, they
are used to construct the remote command.
- * `tramp-config-check'
- A function to be called with one argument, VEC. It should
- return a string which is used to check, whether the
- configuration of the remote host has been changed (which
- would require to flush the cache data). This string is kept
- as connection property \"config-check-data\".
-
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
the file; this might be the absolute filename of scp or the name of
@@ -4959,14 +4952,30 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
;; Result.
target-alist))
+(defvar tramp-extra-expand-args nil
+ "Method specific arguments.")
+
(defun tramp-expand-args (vec parameter &rest spec-list)
"Expand login arguments as given by PARAMETER in `tramp-methods'.
PARAMETER is a symbol like `tramp-login-args', denoting a list of
list of strings from `tramp-methods', containing %-sequences for
-substitution. SPEC-LIST is a list of char/value pairs used for
-`format-spec-make'."
+substitution.
+SPEC-LIST is a list of char/value pairs used for
+`format-spec-make'. It is appended by `tramp-extra-expand-args',
+a connection-local variable."
(let ((args (tramp-get-method-parameter vec parameter))
- (spec (apply 'format-spec-make spec-list)))
+ (extra-spec-list
+ (mapcar
+ #'eval
+ (buffer-local-value
+ 'tramp-extra-expand-args (tramp-get-connection-buffer vec))))
+ spec)
+ ;; Merge both spec lists. Remove duplicate entries.
+ (while spec-list
+ (unless (member (car spec-list) extra-spec-list)
+ (setq extra-spec-list (append (take 2 spec-list) extra-spec-list)))
+ (setq spec-list (cddr spec-list)))
+ (setq spec (apply #'format-spec-make extra-spec-list))
;; Expand format spec.
(flatten-tree
(mapcar
diff --git a/src/lisp.h b/src/lisp.h
index cb46487358e..e8cfda1be6e 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4179,7 +4179,6 @@ void set_frame_cursor_types (struct frame *, Lisp_Object);
extern void syms_of_xdisp (void);
extern void init_xdisp (void);
extern Lisp_Object safe_eval (Lisp_Object);
-extern Lisp_Object safe_eval_inhibit_quit (Lisp_Object);
extern bool pos_visible_p (struct window *, ptrdiff_t, int *,
int *, int *, int *, int *, int *);
diff --git a/src/window.c b/src/window.c
index ea27fdda2a6..482db5dbed4 100644
--- a/src/window.c
+++ b/src/window.c
@@ -5472,58 +5472,6 @@ window_wants_mode_line (struct window *w)
&& WINDOW_PIXEL_HEIGHT (w) > WINDOW_FRAME_LINE_HEIGHT (w));
}
-static int header_line_eval_called = 0;
-
-/**
- * null_header_line_format:
- *
- * Return non-zero when header line format FMT indicates that the
- * header line should not be displayed at all, for windows on frame F.
- *
- * This is when FMT is nil, or if FMT is a cons cell and either its
- * car is a symbol whose value as a variable is nil or void, or its
- * car is the symbol ':eval' and its cadr evaluates to nil.
- */
-static bool
-null_header_line_format (Lisp_Object fmt, struct frame *f)
-{
- Lisp_Object car;
- Lisp_Object val;
-
- if (NILP (fmt))
- return true;
-
- if (CONSP (fmt))
- {
- car = XCAR (fmt);
- if (SYMBOLP (car))
- {
- if (EQ (car, QCeval))
- {
- if (header_line_eval_called > 0)
- return false;
- eassert (header_line_eval_called == 0);
- header_line_eval_called++;
- val = safe_eval_inhibit_quit (XCAR (XCDR (fmt)));
- header_line_eval_called--;
- eassert (header_line_eval_called == 0);
- if (!FRAME_LIVE_P (f))
- {
- header_line_eval_called = 0;
- signal_error (":eval deleted the frame being displayed", fmt);
- }
- return NILP (val);
- }
- val = find_symbol_value (car);
- return (SYMBOLP (car)
- && (EQ (val, Qunbound)
- || NILP (val)));
- }
- }
-
- return false;
-}
-
/**
* window_wants_header_line:
@@ -5542,19 +5490,15 @@ null_header_line_format (Lisp_Object fmt, struct frame
*f)
bool
window_wants_header_line (struct window *w)
{
- Lisp_Object window_header_line_format
- = window_parameter (w, Qheader_line_format);
-
- struct frame *f = WINDOW_XFRAME (w);
- Lisp_Object wbuffer = WINDOW_BUFFER (w);
+ Lisp_Object window_header_line_format =
+ window_parameter (w, Qheader_line_format);
- return (BUFFERP (wbuffer)
+ return (WINDOW_LEAF_P (w)
&& !MINI_WINDOW_P (w)
&& !WINDOW_PSEUDO_P (w)
&& !EQ (window_header_line_format, Qnone)
- && (!null_header_line_format (window_header_line_format, f)
- || !null_header_line_format (BVAR (XBUFFER (wbuffer),
- header_line_format), f))
+ && (!NILP (window_header_line_format)
+ || !NILP (BVAR (XBUFFER (WINDOW_BUFFER (w)), header_line_format)))
&& (WINDOW_PIXEL_HEIGHT (w)
> (window_wants_mode_line (w)
? 2 * WINDOW_FRAME_LINE_HEIGHT (w)
diff --git a/src/xdisp.c b/src/xdisp.c
index 679f937a9c7..d928e9562d2 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -3074,12 +3074,6 @@ safe__eval (bool inhibit_quit, Lisp_Object sexpr)
return safe__call1 (inhibit_quit, Qeval, sexpr);
}
-Lisp_Object
-safe_eval_inhibit_quit (Lisp_Object sexpr)
-{
- return safe__eval (true, sexpr);
-}
-
/* Call function FN with two arguments ARG1 and ARG2.
Return the result, or nil if something went wrong. */
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el
b/test/lisp/emacs-lisp/cl-macs-tests.el
index a4bc8d542d4..01ca56386e3 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -803,10 +803,28 @@ See Bug#57915."
(macroexpand form)
(should (string-empty-p messages))))))))
+(defvar cl--test-a)
+
(ert-deftest cl-&key-arguments ()
(cl-flet ((fn (&key x) x))
(should-error (fn :x))
- (should (eq (fn :x :a) :a))))
-
+ (should (eq (fn :x :a) :a)))
+ ;; In ELisp function arguments are always statically scoped (bug#47552).
+ (let ((cl--test-a 'dyn)
+ ;; FIXME: How do we silence the "Lexical argument shadows" warning?
+ (f (cl-function (lambda (&key cl--test-a b)
+ (list cl--test-a (symbol-value 'cl--test-a) b)))))
+ (should (equal (funcall f :cl--test-a 'lex :b 2) '(lex dyn 2)))))
+
+(cl-defstruct cl--test-s
+ cl--test-a b)
+
+(ert-deftest cl-defstruct-dynbound-label-47552 ()
+ "Check that labels can have the same name as dynbound vars."
+ (let ((cl--test-a 'dyn))
+ (let ((x (make-cl--test-s :cl--test-a 4 :b cl--test-a)))
+ (should (cl--test-s-p x))
+ (should (equal (cl--test-s-cl--test-a x) 4))
+ (should (equal (cl--test-s-b x) 'dyn)))))
;;; cl-macs-tests.el ends here