sly-mrepl-tests.el (3658B)
1 ;; -*- lexical-binding: t; -*- 2 (require 'sly-mrepl) 3 (require 'sly-tests "lib/sly-tests") 4 (require 'cl-lib) 5 (require 'ert-x) 6 7 8 (cl-defun sly-mrepl-tests--assert-prompt (&optional (prompt "CL-USER>")) 9 (let ((proper-prompt-p nil)) 10 (cl-loop 11 repeat 5 12 when (looking-back (format "%s $" prompt) (- (point) 100)) 13 do (setq proper-prompt-p t) 14 (cl-return) 15 do (sit-for 0.3)) 16 (or proper-prompt-p 17 (ert-fail (format "Proper prompt not seen in time (saw last 20 chars as \"%s\")" 18 (buffer-substring-no-properties (max (point-min) 19 (- (point-max) 20 20)) 21 (point-max))))))) 22 23 (defun sly-mrepl-tests--assert-dedicated-stream () 24 (let ((dedicated-stream nil)) 25 (cl-loop 26 repeat 5 27 when (and sly-mrepl--dedicated-stream 28 (processp sly-mrepl--dedicated-stream) 29 (process-live-p sly-mrepl--dedicated-stream)) 30 do (setq dedicated-stream t) 31 (cl-return) 32 do (sleep-for 0 300)) 33 (or dedicated-stream 34 (ert-fail "Dedicated stream not setup correctly")))) 35 36 (defvar sly-mrepl-tests--debug nil) 37 (setq sly-mrepl-tests--debug nil) 38 39 (defmacro sly-mrepl-tests--with-basic-repl-setup (&rest body) 40 (declare (debug (&rest form))) 41 `(let ((sly-buffer-package "COMMON-LISP-USER")) 42 (with-current-buffer (sly-mrepl-new (sly-current-connection) 43 "test-only-repl") 44 (unwind-protect 45 (progn 46 (sly-mrepl-tests--assert-prompt) 47 (sly-mrepl-tests--assert-dedicated-stream) 48 ,@body) 49 (unless sly-mrepl-tests--debug 50 (kill-buffer (current-buffer))))))) 51 52 (defun sly-mrepl-tests--current-input-string () 53 (buffer-substring-no-properties (sly-mrepl--mark) (point-max))) 54 55 (define-sly-ert-test basic-repl-setup () 56 (sly-mrepl-tests--with-basic-repl-setup)) 57 58 (define-sly-ert-test repl-values-and-button-navigation () 59 (sly-mrepl-tests--with-basic-repl-setup 60 (insert "(values (list 1 2 3) #(1 2 3))") 61 (sly-mrepl-return) 62 (sly-mrepl-tests--assert-prompt) 63 (ert-simulate-command '(sly-button-backward 1)) 64 (ert-simulate-command '(sly-button-backward 1)) 65 (should-error 66 (ert-simulate-command '(sly-button-backward 1))) 67 (ert-simulate-command '(sly-button-forward 1)))) 68 69 (when (>= emacs-major-version 25) 70 (define-sly-ert-test repl-completion-pop-up-window () 71 (sly-mrepl-tests--with-basic-repl-setup 72 (insert "(setq echonumberli)") 73 (backward-char 1) 74 (ert-simulate-command '(completion-at-point)) 75 (should (get-buffer-window "*sly-completions*")))) 76 77 (define-sly-ert-test repl-completion-choose-candidates () 78 (sly-mrepl-tests--with-basic-repl-setup 79 (let ((symbol-snippet "multiple-value-t")) 80 (insert "'()") 81 (backward-char 1) 82 (insert symbol-snippet) 83 (ert-simulate-command '(completion-at-point)) 84 (should (get-buffer-window "*sly-completions*")) 85 (ert-simulate-command '(sly-choose-completion)) 86 (should (string= "'(multiple-value-setq)" 87 (sly-mrepl-tests--current-input-string))) 88 (backward-sexp) 89 (kill-sexp) 90 (insert symbol-snippet) 91 (ert-simulate-command '(completion-at-point)) 92 (ert-simulate-command '(sly-next-completion 1)) 93 (ert-simulate-command '(sly-choose-completion)) 94 (should (string= "'(multiple-value-list)" 95 (sly-mrepl-tests--current-input-string))))))) 96 97 (provide 'sly-mrepl-tests)