Commit | Line | Data |
---|---|---|
1a228575 NJ |
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 | ) |