emacs/gds-test.el

   1
   2 ;; Test utility code.
   3 (defun gds-test-execute-keys (keys &optional keys2)
   4   (execute-kbd-macro (apply 'vector (listify-key-sequence keys))))
   5
   6 (defvar gds-test-expecting nil)
   7
   8 (defun gds-test-protocol-hook (form)
   9   (message "[protocol: %s]" (car form))
  10   (if (eq (car form) gds-test-expecting)
  11       (setq gds-test-expecting nil)))
  12
  13 (defun gds-test-expect-protocol (proc &optional timeout)
  14   (message "[expect: %s]" proc)
  15   (setq gds-test-expecting proc)
  16   (while gds-test-expecting
  17     (or (accept-process-output gds-debug-server (or timeout 5))
  18         (error "Timed out after %ds waiting for %s" (or timeout 5) proc))))
  19
  20 (defun gds-test-check-buffer (name &rest strings)
  21   (let ((buf (or (get-buffer name) (error "No %s buffer" name))))
  22     (save-excursion
  23       (set-buffer buf)
  24       (goto-char (point-min))
  25       (while strings
  26         (search-forward (car strings))
  27         (setq strings (cdr strings))))))
  28
  29 (defun TEST (desc)
  30   (message "TEST: %s" desc))
  31
  32 ;; Make sure we take GDS elisp code from this code tree.
  33 (setq load-path (cons (concat default-directory "emacs/") load-path))
  34
  35 ;; Protect the tests so we can do some cleanups in case of error.
  36 (unwind-protect
  37     (progn
  38
  39       ;; Visit the tutorial.
  40       (find-file "gds-tutorial.txt")
  41
  42       (TEST "Load up GDS.")
  43       (search-forward "(require 'gds)")
  44       (setq load-path (cons (concat default-directory "emacs/") load-path))
  45       (gds-test-execute-keys "\C-x\C-e")
  46
  47       ;; Install our testing hook.
  48       (add-hook 'gds-protocol-hook 'gds-test-protocol-hook)
  49
  50       (TEST "Help.")
  51       (search-forward "(list-ref")
  52       (backward-char 2)
  53       (gds-test-execute-keys "\C-hg\C-m")
  54       (gds-test-expect-protocol 'eval-results 10)
  55       (gds-test-check-buffer "*Guile Help*"
  56                              "help list-ref"
  57                              "is a primitive procedure in the (guile) module")
  58
  59       (TEST "Completion.")
  60       (re-search-forward "^with-output-to-s")
  61       (gds-test-execute-keys "\e\C-i")
  62       (beginning-of-line)
  63       (or (looking-at "with-output-to-string")
  64           (error "Expected completion `with-output-to-string' failed"))
  65
  66       (TEST "Eval defun.")
  67       (search-forward "(display z)")
  68       (gds-test-execute-keys "\e\C-x")
  69       (gds-test-expect-protocol 'eval-results)
  70       (gds-test-check-buffer "*Guile Evaluation*"
  71                              "(let ((x 1) (y 2))"
  72                              "Arctangent is: 0.46"
  73                              "=> 0.46")
  74
  75       (TEST "Multiple values.")
  76       (search-forward "(values 'a ")
  77       (gds-test-execute-keys "\e\C-x")
  78       (gds-test-expect-protocol 'eval-results)
  79       (gds-test-check-buffer "*Guile Evaluation*"
  80                              "(values 'a"
  81                              "hello world"
  82                              "=> a"
  83                              "=> b"
  84                              "=> c")
  85
  86       (TEST "Eval region with multiple expressions.")
  87       (search-forward "(display \"Arctangent is: \")")
  88       (beginning-of-line)
  89       (push-mark nil nil t)
  90       (forward-line 3)
  91       (gds-test-execute-keys "\C-c\C-r")
  92       (gds-test-expect-protocol 'eval-results)
  93       (gds-test-check-buffer "*Guile Evaluation*"
  94                              "(display \"Arctangent is"
  95                              "Arctangent is:"
  96                              "=> no (or unspecified) value"
  97                              "ERROR: Unbound variable: z"
  98                              "=> error-in-evaluation"
  99                              "Evaluating expression 3"
 100                              "=> no (or unspecified) value")
 101
 102       (TEST "Eval syntactically unbalanced region.")
 103       (search-forward "(let ((z (atan x y)))")
 104       (beginning-of-line)
 105       (push-mark nil nil t)
 106       (forward-line 4)
 107       (gds-test-execute-keys "\C-c\C-r")
 108       (gds-test-expect-protocol 'eval-results)
 109       (gds-test-check-buffer "*Guile Evaluation*"
 110                              "(let ((z (atan"
 111                              "Reading expressions to evaluate"
 112                              "ERROR"
 113                              "end of file"
 114                              "=> error-in-read")
 115
 116       (TEST "Stepping through an evaluation.")
 117       (search-forward "(for-each (lambda (x)")
 118       (forward-line 1)
 119       (push-mark nil nil t)
 120       (forward-line 1)
 121       (gds-test-execute-keys "\C-u\e\C-x")
 122       (gds-test-expect-protocol 'stack)
 123       (gds-test-execute-keys " ")
 124       (gds-test-expect-protocol 'stack)
 125       (gds-test-execute-keys "o")
 126       (gds-test-expect-protocol 'stack)
 127       (gds-test-execute-keys "o")
 128       (gds-test-expect-protocol 'stack)
 129       (gds-test-execute-keys "o")
 130       (gds-test-expect-protocol 'stack)
 131       (gds-test-execute-keys "o")
 132       (gds-test-expect-protocol 'stack)
 133       (gds-test-execute-keys "o")
 134       (gds-test-expect-protocol 'stack)
 135       (gds-test-execute-keys "o")
 136       (gds-test-expect-protocol 'stack)
 137       (gds-test-execute-keys "o")
 138       (gds-test-expect-protocol 'stack)
 139       (gds-test-execute-keys "o")
 140       (gds-test-expect-protocol 'stack)
 141       (gds-test-execute-keys "o")
 142       (gds-test-expect-protocol 'stack)
 143       (gds-test-execute-keys "o")
 144       (gds-test-expect-protocol 'stack)
 145       (gds-test-execute-keys "g")
 146       (gds-test-expect-protocol 'eval-results)
 147       (gds-test-check-buffer "*Guile Evaluation*"
 148                              "(for-each (lambda"
 149                              "Evaluating in current module"
 150                              "3 cubed is 27"
 151                              "=> no (or unspecified) value")
 152
 153       ;; Done.
 154       (message "====================================")
 155       (message "gds-test.el completed without errors")
 156       (message "====================================")
 157
 158       )
 159
 160   (switch-to-buffer "gds-debug")
 161   (write-region (point-min) (point-max) "gds-test.debug")
 162
 163   (switch-to-buffer "*GDS Transcript*")
 164   (write-region (point-min) (point-max) "gds-test.transcript")
 165
 166   )