287 lines
11 KiB
EmacsLisp
287 lines
11 KiB
EmacsLisp
;; Tests for slime-macrostep. The following are expected failures:
|
||
|
||
;; - Under CLISP, highlighting of macro sub-forms fails because our
|
||
;; pretty-printer dispatch table hacking causes infinite recursion:
|
||
;; see comment in swank-macrostep.lisp
|
||
|
||
;; - COLLECT-MACRO-FORMS does not catch compiler macros under CLISP
|
||
;; and ABCL
|
||
|
||
;; - Under CCL and ECL, compiler macro calls returned by
|
||
;; COLLECT-MACRO-FORMS are not EQ to the original form, and so are
|
||
;; not detected by the tracking pretty-printer mechanism. This
|
||
;; could be fixed by adding :TEST #'EQUAL to the POSITION call
|
||
;; within MAKE-TRACKING-PPRINT-DISPATCH, at the cost of introducing
|
||
;; false positives.
|
||
|
||
;; ECL has two other issues:
|
||
|
||
;; - it currently lacks a working SLIME defimplementation for
|
||
;; MACROEXPAND-ALL (Github issue #157), without which none of the
|
||
;; expand-in-context stuff works.
|
||
|
||
;; - the environments consed up by its WALKER:MACROEXPAND-ALL
|
||
;; function are slightly broken, and do not work when passed to
|
||
;; MACROEXPAND-1 unless fixed up via
|
||
|
||
;; (subst 'si::macro 'walker::macro env)
|
||
|
||
(require 'slime-macrostep)
|
||
(require 'slime-tests)
|
||
(require 'cl-lib)
|
||
|
||
(defun slime-macrostep-eval-definitions (definitions)
|
||
(slime-check-top-level)
|
||
(slime-compile-string definitions 0)
|
||
(slime-sync-to-top-level 5))
|
||
|
||
(defmacro slime-macrostep-with-text (buffer-text &rest body)
|
||
(declare (indent 1))
|
||
`(with-temp-buffer
|
||
(lisp-mode)
|
||
(save-excursion
|
||
(insert ,buffer-text))
|
||
,@body))
|
||
|
||
(defun slime-macrostep-search (form)
|
||
"Search forward for FORM, leaving point at its first character."
|
||
(let ((case-fold-search t)
|
||
(search-spaces-regexp "\\s-+"))
|
||
(re-search-forward (regexp-quote form)))
|
||
(goto-char (match-beginning 0)))
|
||
|
||
|
||
|
||
(def-slime-test (slime-macrostep-expand-defmacro)
|
||
(definition buffer-text original expansion)
|
||
"Test that simple macrostep expansion works."
|
||
'(("(defmacro macrostep-dummy-macro (&rest args)
|
||
`(expansion of ,@args))"
|
||
|
||
"(progn
|
||
(first body form)
|
||
(second body form)
|
||
(macrostep-dummy-macro (first (argument)) second (third argument))
|
||
(remaining body forms))"
|
||
|
||
"(macrostep-dummy-macro (first (argument)) second (third argument))"
|
||
|
||
"(expansion of (first (argument)) second (third argument))"))
|
||
(slime-macrostep-eval-definitions definition)
|
||
(slime-macrostep-with-text buffer-text
|
||
(slime-macrostep-search original)
|
||
(macrostep-expand)
|
||
(slime-test-expect "Macroexpansion is correct"
|
||
expansion
|
||
(downcase (slime-sexp-at-point))
|
||
#'slime-test-macroexpansion=)))
|
||
|
||
(def-slime-test (slime-macrostep-fontify-macros
|
||
(:fails-for "clisp" "ECL"))
|
||
(definition buffer-text original subform)
|
||
"Test that macro forms in expansions are font-locked"
|
||
'(("(defmacro macrostep-dummy-1 (&rest args)
|
||
`(expansion including (macrostep-dummy-2 ,@args)))
|
||
(defmacro macrostep-dummy-2 (&rest args)
|
||
`(final expansion of ,@args))"
|
||
|
||
"(progn
|
||
(first body form)
|
||
(second body form)
|
||
(macrostep-dummy-1 (first (argument)) second (third argument))
|
||
(remaining body forms))"
|
||
|
||
"(macrostep-dummy-1 (first (argument)) second (third argument))"
|
||
|
||
"(macrostep-dummy-2 (first (argument)) second (third argument))"))
|
||
(slime-macrostep-eval-definitions definition)
|
||
(slime-macrostep-with-text buffer-text
|
||
(slime-macrostep-search original)
|
||
(macrostep-expand)
|
||
(slime-macrostep-search subform)
|
||
(forward-char) ; move over open paren
|
||
(slime-check "Head of macro form in expansion is fontified correctly"
|
||
(eq (get-char-property (point) 'font-lock-face)
|
||
'macrostep-macro-face))))
|
||
|
||
(def-slime-test (slime-macrostep-fontify-compiler-macros
|
||
(:fails-for "armedbear" "clisp" "ccl" "ECL"))
|
||
(definition buffer-text original subform)
|
||
"Test that compiler-macro forms in expansions are font-locked"
|
||
'(("(defmacro macrostep-dummy-3 (&rest args)
|
||
`(expansion including (macrostep-dummy-4 ,@args)))
|
||
(defun macrostep-dummy-4 (&rest args)
|
||
args)
|
||
(define-compiler-macro macrostep-dummy-4 (&rest args)
|
||
`(compile-time expansion of ,@args))"
|
||
|
||
"(progn
|
||
(first body form)
|
||
(second body form)
|
||
(macrostep-dummy-3 first second third)
|
||
(remaining body forms))"
|
||
|
||
"(macrostep-dummy-3 first second third)"
|
||
|
||
"(macrostep-dummy-4 first second third)"))
|
||
(slime-macrostep-eval-definitions definition)
|
||
(slime-macrostep-with-text buffer-text
|
||
(slime-macrostep-search original)
|
||
(let ((macrostep-expand-compiler-macros t))
|
||
(macrostep-expand))
|
||
(slime-macrostep-search subform)
|
||
(forward-char) ; move over open paren
|
||
(slime-check "Head of compiler-macro in expansion is fontified correctly"
|
||
(eq (get-char-property (point) 'font-lock-face)
|
||
'macrostep-compiler-macro-face))))
|
||
|
||
(def-slime-test (slime-macrostep-expand-macrolet
|
||
(:fails-for "ECL"))
|
||
(definitions buffer-text expansions)
|
||
"Test that calls to macrolet-defined macros are expanded."
|
||
'((nil
|
||
"(macrolet
|
||
((test (&rest args) `(expansion of ,@args)))
|
||
(first body form)
|
||
(second body form)
|
||
(test (strawberry pie) and (apple pie))
|
||
(final body form))"
|
||
(("(test (strawberry pie) and (apple pie))"
|
||
"(EXPANSION OF (STRAWBERRY PIE) AND (APPLE PIE))")))
|
||
|
||
;; From swank.lisp:
|
||
(nil
|
||
"(macrolet ((define-xref-action (xref-type handler)
|
||
`(defmethod xref-doit ((type (eql ,xref-type)) thing)
|
||
(declare (ignorable type))
|
||
(funcall ,handler thing))))
|
||
(define-xref-action :calls #'who-calls)
|
||
(define-xref-action :calls-who #'calls-who)
|
||
(define-xref-action :references #'who-references)
|
||
(define-xref-action :binds #'who-binds)
|
||
(define-xref-action :macroexpands #'who-macroexpands)
|
||
(define-xref-action :specializes #'who-specializes)
|
||
(define-xref-action :callers #'list-callers)
|
||
(define-xref-action :callees #'list-callees))"
|
||
(("(define-xref-action :calls #'who-calls)"
|
||
"(DEFMETHOD XREF-DOIT ((TYPE (EQL :CALLS)) THING)
|
||
(DECLARE (IGNORABLE TYPE))
|
||
(FUNCALL #'WHO-CALLS THING))")
|
||
("(define-xref-action :macroexpands #'who-macroexpands)"
|
||
"(DEFMETHOD XREF-DOIT ((TYPE (EQL :MACROEXPANDS)) THING)
|
||
(DECLARE (IGNORABLE TYPE))
|
||
(FUNCALL #'WHO-MACROEXPANDS THING))")
|
||
("(define-xref-action :callees #'list-callees)"
|
||
"(DEFMETHOD XREF-DOIT ((TYPE (EQL :CALLEES)) THING)
|
||
(DECLARE (IGNORABLE TYPE))
|
||
(FUNCALL #'LIST-CALLEES THING))")))
|
||
|
||
;; Test expansion of shadowed definitions
|
||
(nil
|
||
"(macrolet
|
||
((test-macro (&rest forms) (cons 'outer-definition forms)))
|
||
(test-macro first (call))
|
||
(macrolet
|
||
((test-macro (&rest forms) (cons 'inner-definition forms)))
|
||
(test-macro (second (call)))))"
|
||
(("(test-macro first (call))"
|
||
"(OUTER-DEFINITION FIRST (CALL))")
|
||
("(test-macro (second (call)))"
|
||
"(INNER-DEFINITION (SECOND (CALL)))")))
|
||
|
||
;; Expansion of macro-defined local macros
|
||
("(defmacro with-local-dummy-macro (&rest body)
|
||
`(macrolet ((dummy (&rest args) `(expansion (of) ,@args)))
|
||
,@body))"
|
||
"(with-local-dummy-macro
|
||
(dummy form (one))
|
||
(dummy (form two)))"
|
||
(("(dummy form (one))"
|
||
"(EXPANSION (OF) FORM (ONE))")
|
||
("(dummy (form two))"
|
||
"(EXPANSION (OF) (FORM TWO))"))))
|
||
|
||
(when definitions
|
||
(slime-macrostep-eval-definitions definitions))
|
||
(slime-macrostep-with-text buffer-text
|
||
;; slime-test-macroexpansion= does not expect tab characters,
|
||
;; so make sure that Emacs does not insert them
|
||
(let ((indent-tabs-mode nil))
|
||
(cl-loop
|
||
for (original expansion) in expansions
|
||
do
|
||
(goto-char (point-min))
|
||
(slime-macrostep-search original)
|
||
(macrostep-expand)
|
||
(slime-test-expect "Macroexpansion is correct"
|
||
expansion
|
||
(slime-sexp-at-point)
|
||
#'slime-test-macroexpansion=)))))
|
||
|
||
(def-slime-test (slime-macrostep-fontify-local-macros
|
||
(:fails-for "clisp" "ECL"))
|
||
()
|
||
"Test that locally-bound macros are highlighted in expansions."
|
||
'(())
|
||
(slime-macrostep-with-text
|
||
"(macrolet ((frob (&rest args)
|
||
(if (zerop (length args))
|
||
nil
|
||
`(cons ,(car args) (frob ,@(cdr args))))))
|
||
(frob 1 2 3 4 5))"
|
||
(let ((expansions
|
||
'(("(frob 1 2 3 4 5)"
|
||
"(CONS 1 (FROB 2 3 4 5))"
|
||
"(FROB 2 3 4 5)")
|
||
("(FROB 2 3 4 5)"
|
||
"(CONS 2 (FROB 3 4 5))"
|
||
"(FROB 3 4 5)")
|
||
("(FROB 3 4 5)"
|
||
"(CONS 3 (FROB 4 5))"
|
||
"(FROB 4 5)")
|
||
("(FROB 4 5)"
|
||
"(CONS 4 (FROB 5))"
|
||
"(FROB 5)")
|
||
("(FROB 5)"
|
||
"(CONS 5 (FROB))"
|
||
"(FROB)")
|
||
;; ("(FROB)"
|
||
;; "NIL"
|
||
;; nil)
|
||
)))
|
||
(cl-loop for (original expansion subform) in expansions
|
||
do
|
||
(goto-char (point-min))
|
||
(slime-macrostep-search original)
|
||
(macrostep-expand)
|
||
(slime-test-expect "Macroexpansion is correct"
|
||
expansion
|
||
(slime-sexp-at-point)
|
||
#'slime-test-macroexpansion=)
|
||
(when subform
|
||
(slime-macrostep-search subform)
|
||
(forward-char)
|
||
(slime-check "Head of macro form in expansion is fontified correctly"
|
||
(eq (get-char-property (point) 'font-lock-face)
|
||
'macrostep-macro-face)))))))
|
||
|
||
(def-slime-test (slime-macrostep-handle-unreadable-objects)
|
||
(definitions buffer-text subform expansion)
|
||
"Check that macroexpansion succeeds in a context containing unreadable objects."
|
||
'(("(defmacro macrostep-dummy-5 (&rest args)
|
||
`(expansion of ,@args))"
|
||
"(progn
|
||
#<unreadable object>
|
||
(macrostep-dummy-5 quux frob))"
|
||
"(macrostep-dummy-5 quux frob)"
|
||
"(EXPANSION OF QUUX FROB)"))
|
||
(slime-macrostep-eval-definitions definitions)
|
||
(slime-macrostep-with-text buffer-text
|
||
(slime-macrostep-search subform)
|
||
(macrostep-expand)
|
||
(slime-test-expect "Macroexpansion is correct"
|
||
expansion
|
||
(slime-sexp-at-point)
|
||
#'slime-test-macroexpansion=)))
|
||
|
||
(provide 'slime-macrostep-tests)
|