Add additional MIRROR-IMG test
This one makes sure output is the same, regardless as to whether or not files have already been mirrored.
This commit is contained in:
parent
359696e5e2
commit
cd1c603c8a
|
@ -44,20 +44,29 @@ system’s path."
|
|||
(error (c)
|
||||
(hunchentoot:stop server)
|
||||
c)))))
|
||||
|
||||
(defun call-mirror-img ()
|
||||
"Invoke MIRROR-IMG:MIRROR-IMG, using our own parameters.
|
||||
Used in the tests MIRROR-IMG and MIRROR-IMG.ALREADY-DOWNLOADED."
|
||||
(let* ((html-path (relative-pathname "t/testing-website/index.html"))
|
||||
(download-dir (relative-pathname "t/tmp/"))
|
||||
(html-url "http://localhost:4242")
|
||||
(url-dir (pathname-utils:relative-pathname
|
||||
(relative-pathname "t/")
|
||||
download-dir)))
|
||||
(mirror-img:mirror-img html-path download-dir
|
||||
:url-dir url-dir
|
||||
:html-url html-url)))
|
||||
|
||||
(define-test mirror-img (:tags '(mirror-img))
|
||||
(assert-eq
|
||||
'T
|
||||
(stringp
|
||||
(setq *mirror-img-result*
|
||||
(let* ((html-path (relative-pathname "t/testing-website/index.html"))
|
||||
(download-dir (relative-pathname "t/tmp/"))
|
||||
(html-url "http://localhost:4242")
|
||||
(url-dir (pathname-utils:relative-pathname
|
||||
(relative-pathname "t/")
|
||||
download-dir)))
|
||||
(mirror-img:mirror-img html-path download-dir
|
||||
:url-dir url-dir
|
||||
:html-url html-url))))))
|
||||
(stringp (setq *mirror-img-result* (call-mirror-img)))))
|
||||
|
||||
(define-test mirror-img.already-downloaded (:tags '(mirror-img))
|
||||
(assert-equal
|
||||
*mirror-img-result*
|
||||
(call-mirror-img)))
|
||||
|
||||
(define-test mirror-img.files-mirrored (:tags '(mirror-img))
|
||||
(assert-equal
|
||||
|
|
Ŝarĝante…
Reference in New Issue