1 ;;;_ elinstall/tests.el --- Tests for elinstall
5 ;; Copyright (C) 2010 Tom Breton (Tehom)
7 ;; Author: Tom Breton (Tehom) <tehom@panix.com>
8 ;; Keywords: lisp, maint, internal
10 ;; This file is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This file is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
33 (require 'emtest
/main
/define
)
34 (require 'emtest
/testhelp
/standard
)
35 (require 'emtest
/testhelp
/misc
)
36 (require 'emtest
/testhelp
/tagnames
)
37 (require 'emtest
/testhelp
/testpoint
)
38 (require 'emtest
/testhelp
/mocks
/filebuf
)
41 (require 'emtest
/testhelp
/testpoint
/requirer
))
44 (require 'cus-edit
) ;;Because we save "installedness" manually
49 (defconst elinstall
:th
:examples
50 (emtb:expand-filename-by-load-file
"examples")
51 "Directory of example files" )
54 ;;;_ . elinstall:th:surrounders
55 (defconst elinstall
:th
:surrounders
56 ;;Mock customize-save-variable to do nothing.
57 ;;Also mock interaction: yes-or-no-p. This suggests that I should
58 ;;articulate the package more, to separate interaction.
59 '((emtp:insulate
(customize-save-variable)))
60 "The normal surrounders for elinstall tests" )
64 ((of 'elinstall-already-installed
)
65 (:surrounders elinstall
:th
:surrounders
))
69 ((elinstall-already-installed nil
))
70 (emt:doc
"Situation: Nothing has been installed.")
71 (emt:doc
"Operation: Query whether EXAMPLE has been installed.")
72 (emt:doc
"Response: give nil.")
75 (elinstall-already-installed "example")))
77 (emt:doc
"Operation: Record that EXAMPLE has been installed.")
79 (elinstall-record-installed "example")
80 (emt:doc
"Operation: Query whether EXAMPLE has been installed.")
81 (emt:doc
"Response: give true.")
83 (elinstall-already-installed "example")))))
85 ;;;_ , Generating the right actions
86 (emt:deftest-3 elinstall-find-actions-by-spec
87 ;;At least one for each command.
89 ;;Also test recursing in directories
92 (emt:doc
"Situation: On examples/1 directory.")
93 (emt:doc
"Response: WRITEME."))))
96 ;;;_ , Given list of actions, segregate it right.
98 (defconst elinstall
:td
:examples
100 ((dir (expand-file-name "2/" elinstall
:th
:examples
)))
103 (transparent-tags () (type name
))
105 (group ((type filename
))
108 ;;But it might not be made in this directory, but
109 ;;rather in a tmp directory.
113 (expand-file-name "a1.el" dir
)))
115 ;;The actions themselves:
116 (group ((type action
))
117 (group ((subtype add-file-autoloads
))
120 `(add-file-autoloads "deffile-1"
123 ,(expand-file-name "a1.el" dir
)))
126 `(add-file-autoloads "deffile-1" "b1" ,dir
127 ,(expand-file-name "b1.el" dir
))))
130 `(add-file-autoloads "deffile-2"
133 ,(expand-file-name "c2.el" dir
)))
136 `(add-file-autoloads "deffile-2" "d2" ,dir
137 ,(expand-file-name "d2.el" dir
)))))
138 (group ((subtype add-to-load-path
))
139 (item ((target 1)(qname 'alp1
))
140 `(add-to-load-path "deffile-1" ,dir
))
141 (item ((target 2)(qname 'alp2
))
142 `(add-to-load-path "deffile-2" ,dir
)))
144 (group ((subtype add-to-info-path
))
145 (item ((target 1)(qname 'aip1
))
146 `(add-to-info-path "deffile-1" ,dir
))
147 (item ((target 2)(qname 'aip2
))
148 `(add-to-info-path "deffile-2" ,dir
)))
150 (group ((subtype preload-file
))
151 (item ((target 1)(qname 'plf1
))
152 `(preload-file "deffile-1" 50))
153 (item ((target 2)(qname 'plf2
))
154 `(preload-file "deffile-2"))
155 (item ((target 3)(qname 'plf3
))
156 `(preload-file "deffile-3"))))
161 (item ((type action-list
))
163 (item ((type segment-list
))
165 ;;List all pointing towards the same deffile
167 (item ((type action-list
))
169 ,(emtg (type action
)(target 1)(qname 'a1
))
170 ,(emtg (type action
)(target 1)(qname 'b
))))
173 (item ((type segment-list
))
174 (elinstall-make-stages
177 ,(emtg (type action
)(target 1)(qname 'a1
))
178 ,(emtg (type action
)(target 1)(qname 'b
)))))))
180 ;;List pointing towards two deffiles
182 (item ((type action-list
))
184 ,(emtg (type action
)(target 1)(qname 'a1
))
185 ,(emtg (type action
)(target 2)(qname 'c
))
186 ,(emtg (type action
)(target 1)(qname 'b
))
187 ,(emtg (type action
)(target 2)(qname 'd
))))
189 (item ((type segment-list
))
190 (elinstall-make-stages
193 ,(emtg (type action
)(target 1)(qname 'a1
))
194 ,(emtg (type action
)(target 1)(qname 'b
)))
196 ,(emtg (type action
)(target 2)(qname 'c
))
197 ,(emtg (type action
)(target 2)(qname 'd
)))))))
199 ;;List including all types except preload actions
201 (item ((type action-list
))
203 ,(emtg (type action
)(subtype add-to-info-path
)
205 ,(emtg (type action
)(subtype add-to-load-path
)
207 ,(emtg (type action
)(target 1)(qname 'a1
))
208 ,(emtg (type action
)(target 2)(qname 'c
))
209 ,(emtg (type action
)(target 1)(qname 'b
))
210 ,(emtg (type action
)(target 2)(qname 'd
))
211 ,(emtg (type action
)(subtype add-to-info-path
)
213 ,(emtg (type action
)(subtype add-to-load-path
)
217 (item ((type segment-list
))
218 (elinstall-make-stages
222 ,(emtg (type action
)(subtype add-to-info-path
)
224 ,(emtg (type action
)(subtype add-to-load-path
)
226 ,(emtg (type action
)(target 1)(qname 'a1
))
227 ,(emtg (type action
)(target 1)(qname 'b
)))
229 ,(emtg (type action
)(target 2)(qname 'c
))
230 ,(emtg (type action
)(target 2)(qname 'd
))
231 ,(emtg (type action
)(subtype add-to-info-path
)
233 ,(emtg (type action
)(subtype add-to-load-path
)
236 ;;List including some preload actions
238 (item ((type action-list
))
240 ,(emtg (type action
)(subtype preload-file
)
242 ,(emtg (type action
)(target 1)(qname 'a1
))
243 ,(emtg (type action
)(target 2)(qname 'c
))
244 ,(emtg (type action
)(subtype preload-file
)
246 ,(emtg (type action
)(target 1)(qname 'b
))
247 ,(emtg (type action
)(target 2)(qname 'd
))
248 ,(emtg (type action
)(subtype preload-file
)
251 (item ((type segment-list
))
252 (elinstall-make-stages
256 ,(emtg (type action
)(target 1)(qname 'a1
))
257 ,(emtg (type action
)(target 1)(qname 'b
)))
260 ,(emtg (type action
)(target 2)(qname 'c
))
261 ,(emtg (type action
)(target 2)(qname 'd
))))
264 ,(emtg (type action
)(subtype preload-file
)
266 ,(emtg (type action
)(subtype preload-file
)
268 ,(emtg (type action
)(subtype preload-file
)
271 ;;List includes some null actions
273 (item ((type action-list
))
276 ,(emtg (type action
)(target 1)(qname 'a1
))
278 ,(emtg (type action
)(target 2)(qname 'c
))
280 ,(emtg (type action
)(target 1)(qname 'b
))
281 ,(emtg (type action
)(target 2)(qname 'd
))))
283 (item ((type segment-list
))
284 (elinstall-make-stages
287 ,(emtg (type action
)(target 1)(qname 'a1
))
288 ,(emtg (type action
)(target 1)(qname 'b
)))
290 ,(emtg (type action
)(target 2)(qname 'c
))
291 ,(emtg (type action
)(target 2)(qname 'd
))))))))))
293 ;;;_ . elinstall-remove-autogen-action
294 (emt:deftest-3 elinstall-remove-autogen-action
296 (emtg:with elinstall
:td
:examples
()
297 (emt:doc
"Param: List of actions including an
298 add-file-autoloads for a1.")
299 (emt:doc
"Param: filename a1.")
300 (emt:doc
"Response: The a1 action is removed.")
303 (elinstall-remove-autogen-action
306 (emtg (type action
)(target 1)(name 'a
))
307 (add-file-autoloads "deffile-1" "b1")))
308 '((add-file-autoloads "deffile-1" "b1")))
313 ;;;_ . elinstall-segregate-actions
315 (emt:deftest-3 elinstall-segregate-actions
317 (emtg:with elinstall
:td
:examples
()
321 (elinstall-segregate-actions
322 (emtg (type action-list
)))))
327 (emtg (type segment-list
))
331 (equal (car a
)(car b
))
335 ;;;_ . elinstall-get-relevant-load-path
336 (emt:deftest-3 elinstall-get-relevant-load-path
338 (emtg:with elinstall
:td
:examples
()
339 (emt:doc
"Situation: Some actions are add-to-load-path.")
340 (emt:doc
"Response: Return exactly a list of these.")
341 ;;$$WRITE MY EXAMPLES for results comparison.
342 (elinstall-get-relevant-load-path
343 (emtg (type action-list
) (name 3))))))
347 ;;;_ , Given list of actions, doing the right adds to deffile
348 ;;Similar requirements for `elinstall-do-segment'
349 (emt:deftest-3 elinstall-update-deffile
351 ;;Test that when called multiple times, it updates right:
353 ;;Removes gone files.
355 ;;Autoloads with slash-path if asked to (That requires another setup)
356 ;;That will use function 31a1-1 in 31a1.el
357 ;;Check it by autoloading it.
359 ;;load-path is just to "3/"
361 ;;(For add-to-load-path)
362 ;;Doesn't make the same add-to-load-path section twice
365 (emtg:with elinstall
:td
:examples
367 ((elinsert:th
:found
'())
369 (expand-file-name "2/" elinstall
:th
:examples
))
370 ;;Because the load will sometimes set it.
371 (load-path (list dir
)))
374 (emtb:with-file-f
(:absent
:visited-name
'tmp
) x
375 (emt:doc
"Case: Only one autoload")
376 (emt:doc
"Situation: elinsert:th:found is an empty list
377 and all the autoloads in question push symbols to it.")
378 (emt:doc
"Operation: update the def file")
379 (elinstall-update-deffile x
381 ,(emtg (type action
)(target 1)(qname 'a1
)))
383 (emt:doc
"Operation: load the def file")
385 (emt:doc
"Response: It has done what was expected")
387 (equal elinsert
:th
:found
'(a1))))))))
388 ;;;_ , elinstall-remove-autogen-action
389 ;;Test that it removes on the same sort of filename that
390 ;;elinstall-generate-file-autoloads hands to it.
391 ;;elinstall-get-autogen-action, same requirement.
392 ;;;_ , elinstall-symlink-on-emacs-start
394 (emt:deftest-3 elinstall-symlink-on-emacs-start
396 (emtg:with elinstall
:td
:examples
()
397 (emtmd:with-dirtree
(:repr
'())
398 (emt:doc
"Situation: Directory exists and is empty.")
399 (emt:doc
"Operation: Symlink into it.")
400 (emt:doc
"PARAM: force flag not passed.")
402 (elinstall-symlink-on-emacs-start
403 (emtg (type filename
)(qname 'a1
)) "apreload"
404 default-directory
50)
408 (emtmd:get-repr-contents
".")))
411 "Response: Now contains a symlink of the expected name.")
412 ;;$$IMPROVE MY SUPPORT dirtree doesn't yet allow
413 ;;testing for type = symlink
415 (emtmd:repr-contents-equal
417 (emtmd:make-repr-contents
418 (emtmd:make-repr-file
"50apreload.el")))
421 ;;;_ , elinstall-arrange-preload
423 (emt:deftest-3 elinstall-arrange-preload
425 (emtg:with elinstall
:td
:examples
()
426 (emtmd:with-dirtree
(:repr
'())
427 (emt:doc
"Situation: Directory exists and is empty.")
428 (emt:doc
"Operation: Symlink into it.")
429 (emt:doc
"PARAM: force flag not passed.")
432 ((elinstall-default-preload-target default-directory
))
433 (elinstall-arrange-preload
435 (emtg (type filename
)(qname 'a1
))
441 (emtmd:get-repr-contents
".")))
444 "Response: Now contains a symlink of the expected name.")
445 ;;$$IMPROVE MY SUPPORT dirtree doesn't yet allow
446 ;;testing for type = symlink
448 (emtmd:repr-contents-equal
450 (emtmd:make-repr-contents
451 (emtmd:make-repr-file
"50apreload.el")))
457 (provide 'elinstall
/tests
)
459 ;;;_ * Local emacs vars.
460 ;;;_ + Local variables:
465 ;;; elinstall/tests.el ends here