mirror-img/t/mirror-img.lisp

153 lines
5.7 KiB
Common Lisp
Raw Normal View History

2024-05-27 23:59:55 -05:00
;;;; mirror-img/tests: Tests for the mirror-img package.
;; Copyright © 2024 Jaidyn Ann <jadedctrl@posteo.at>
;;
;; This program is free software: you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation, either version 3 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(defpackage :mirror-img/tests
(:use :cl :lisp-unit2)
(:export :run))
2024-05-27 23:59:55 -05:00
(in-package :mirror-img/tests)
(defparameter *mirror-img-result* nil)
(defun relative-pathname (path)
"Return an absolute path adding the relative PATH to the :mirror-img
systems path."
(asdf:system-relative-pathname :mirror-img/tests path))
(defun run ()
"Run all tests for the mirror-img package."
(let* ((doc-root (relative-pathname "t/testing-website/"))
(acceptor (make-instance 'hunchentoot:easy-acceptor
:port 4242
:document-root doc-root))
(server (hunchentoot:start acceptor)))
(lisp-unit2:with-summary ()
(handler-case
(progn
(run-tests :package :mirror-img/tests)
(hunchentoot:stop server))
(error (c)
(hunchentoot:stop server)
c)))))
(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))))))
(define-test mirror-img.files-mirrored (:tags '(mirror-img))
(assert-equal
'("café" "classy_fireplace" "fireplace" "merry christmas!!! ^_^" "more_calming" "style" "welcoming you")
(sort (mapcar #'pathname-name
(uiop:directory-files (relative-pathname "t/tmp/localhost/")))
#'string-lessp)))
(define-test mirror-img.correct-urls (:tags '(mirror-img))
(assert-equal
'("tmp/localhost/café.jpg"
"tmp/localhost/classy_fireplace.jpg"
"tmp/localhost/fireplace.jpg"
"tmp/localhost/merry christmas!!! ^_^.jpg"
"tmp/localhost/more_calming.jpg"
"tmp/localhost/style.css"
"tmp/localhost/welcoming you.jpg")
(sort (mirror-img::linked-urls
(lquery:$ (lquery:initialize *mirror-img-result*)))
#'string-lessp)))
2024-05-27 23:59:55 -05:00
(define-test mirrored-pathname (:tags '(base))
(assert-equal
#p"base/invalid.tld/bird apple.txt"
(mirror-img::mirrored-pathname "https://invalid.tld/dir/bird apple.txt"
:base-dir #p"base/")))
2024-05-27 23:59:55 -05:00
(define-test mirrored-pathname.esperanto-question (:tags '(base))
(assert-equal
#p"base/invalid.tld/?!?! ĉu ne?!?!.png"
(mirror-img::mirrored-pathname "https://invalid.tld/dir/s/d/ askldjas/ asldkja/?!?! ĉu ne?!?!.png"
:base-dir #p"base/")))
(define-test linked-urls (:tags '(dom))
(assert-equal
'("/res/welcoming you.jpg"
"http://localhost:4242/res/img/b/fireplace.jpg"
"http://localhost:4242/res/img/b/Im trying hard to randomly name these directories/more_calming.jpg"
"http://localhost:4242/res/img/b/Im trying hard to randomly name these directories/ĉu ĉi tio sufiĉe hazardas?!/classy_fireplace.jpg"
"http://localhost:4242/res/img/level-2/café.jpg"
"http://localhost:4242/res/img/merry christmas!!! ^_^.jpg"
"http://localhost:4242/res/style.css")
(sort (mirror-img::linked-urls
(lquery:$ (lquery:initialize
(relative-pathname "t/testing-website/index.html"))))
#'string-lessp)))
2024-05-27 23:59:55 -05:00
(define-test url-encode-uri.space (:tags '(util))
(assert-equal
"https://invalid.tld/dad%20alive.jpg"
(mirror-img::url-encode-uri "https://invalid.tld/dad alive.jpg")))
2024-05-27 23:59:55 -05:00
(define-test url-encode-path.space+exclamation (:tags '(util))
(assert-equal
"/images%21/dad%20alive.jpg"
(mirror-img::url-encode-path "/images!/dad alive.jpg")))
(define-test url-encode-path.question (:tags '(util))
(assert-equal
"/images%21/%3F%C4%89u_ne%20tio%20sufi%C4%89e%3F%21.jpg"
(mirror-img::url-encode-path "/images!/?ĉu_ne tio sufiĉe?!.jpg")))
(define-test uri-explicit-port.http80 (:tags '(util))
(assert-eq
nil
(mirror-img::uri-explicit-port (quri:uri "http://xwx.moe/bird.png"))))
(define-test uri-explicit-port.http443 (:tags '(util))
(assert-eq
443
(mirror-img::uri-explicit-port (quri:uri "http://xwx.moe:443/bird.png"))))
(define-test uri-explicit-port.https27 (:tags '(util))
(assert-eq
27
(mirror-img::uri-explicit-port (quri:uri "http://xwx.moe:27/bird.png"))))
(define-test uri-explicit-port.https443 (:tags '(util))
(assert-eq
nil
(mirror-img::uri-explicit-port (quri:uri "https://xwx.moe:443/bird.png"))))
(define-test pathname-leaf.simple (:tags '(util))
(assert-equal
"apple_berries.png"
(mirror-img::pathname-leaf #p"/mom/dad/apple/laksdjal/apple_berries.png")))
(define-test pathname-leaf.very-weird (:tags '(util))
(assert-equal
" lak -!?ĉ_berries.png"
(mirror-img::pathname-leaf #p"/mom/dad?!?Ljla asdasd'' aslkdjĉ/apple/laksdjal/ lak -!?ĉ_berries.png")))