Add testing website and additional tests

… most importantly for MIRROR-IMG:MIRROR-IMG.
Thanks Hunchentoot, for being such a nice
web-server. =w=
This commit is contained in:
Jaidyn Ann 2024-05-28 15:09:22 -05:00
parent 927f80e1ee
commit 36c8b2a87b
16 changed files with 186 additions and 6 deletions

View File

@ -29,12 +29,11 @@
:license "GPLv3" :license "GPLv3"
:author "Jaidyn Ann <jadedctrl@posteo.at>" :author "Jaidyn Ann <jadedctrl@posteo.at>"
:description "Tests for the the mirror-img package." :description "Tests for the the mirror-img package."
:depends-on (:mirror-img :lisp-unit2) :depends-on (:mirror-img :hunchentoot :lisp-unit2)
:components ((:file "t/mirror-img"))) :components ((:file "t/mirror-img")))
;; Following method borrowed from lisp-unit2s documentation: ;; Following method tweaked from lisp-unit2s documentation:
;; https://github.com/AccelerationNet/lisp-unit2/blob/master/README.md#asdf ;; https://github.com/AccelerationNet/lisp-unit2/blob/master/README.md#asdf
(defmethod asdf:perform ((o asdf:test-op) (c (eql (asdf:find-system :mirror-img/tests)))) (defmethod asdf:perform ((o asdf:test-op) (c (eql (asdf:find-system :mirror-img/tests))))
(eval (read-from-string (eval (read-from-string
"(lisp-unit2:with-summary () "(mirror-img/tests:run)")))
(lisp-unit2:run-tests :package :mirror-img/tests))")))

View File

@ -16,15 +16,74 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(defpackage :mirror-img/tests (defpackage :mirror-img/tests
(:use :cl :lisp-unit2)) (:use :cl :lisp-unit2)
(:export :run))
(in-package :mirror-img/tests) (in-package :mirror-img/tests)
(defparameter *mirror-img-result* nil)
(defun relative-pathname (path)
(asdf:system-relative-pathname :mirror-img/tests path))
(defun run ()
(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 ()
(run-tests :package :mirror-img/tests)
(hunchentoot:stop server))))
(define-test mirror-img (:tags '(mirror-img))
(assert-eq
(stringp
(setq *mirror-img-result*
(mirror-img:mirror-img (relative-pathname "t/testing-website/index.html")
"tmp")))
'T))
(define-test mirror-img.files-mirrored (:tags '(mirror-img))
(assert-equal
(sort (mapcar #'pathname-name
(uiop:directory-files (relative-pathname "t/tmp/localhost/")))
#'string-lessp)
'("café" "fireplace" "merry christmas!!! ^_^" "more_calming" "style" "welcoming you")))
(define-test mirror-img.correct-urls (:tags '(mirror-img))
(assert-equal
(sort (mirror-img::linked-urls
(lquery:$ (lquery:initialize *mirror-img-result*)))
#'string-lessp)
'("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")))
(define-test mirrored-pathname (:tags '(base)) (define-test mirrored-pathname (:tags '(base))
(assert-equal (assert-equal
(mirror-img::mirrored-pathname "https://invalid.tld/dir/bird apple.txt" #p"base/") (mirror-img::mirrored-pathname "https://invalid.tld/dir/bird apple.txt"
:base-dir #p"base/")
#p"base/invalid.tld/bird apple.txt")) #p"base/invalid.tld/bird apple.txt"))
(define-test linked-urls (:tags '(dom))
(assert-equal
(sort (mirror-img::linked-urls
(lquery:$ (lquery:initialize
(relative-pathname "t/testing-website/index.html"))))
#'string-lessp)
'("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%3F!/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"
"http://localhost:4242/res/welcoming you.jpg")))
(define-test url-encode-uri.space (:tags '(util)) (define-test url-encode-uri.space (:tags '(util))
(assert-equal (assert-equal
(mirror-img::url-encode-uri "https://invalid.tld/dad alive.jpg") (mirror-img::url-encode-uri "https://invalid.tld/dad alive.jpg")

View File

@ -0,0 +1,88 @@
<!DOCTYPE HTML>
<html lang="en">
<head>
<title>mirror-imgs testing site! ♥</title>
<meta charset="UTF-8"/>
<link rel="stylesheet" type="text/css" href="http://localhost:4242/res/style.css">
</head>
<body>
<main>
<h1>A sultry welcome to you</h1>
<figure>
<img src="http://localhost:4242/res/welcoming you.jpg">
<figcaption>Welcome~
<a href="https://twitter.com/Distrbeachboy/status/1758538124785852426">
🔗
</a>
</figcaption>
</figure>
<p>Take a seat over here by the fire, take a load off. Yea, just like that. Isnt it warm, here? The fire always puts me at ease, and I feel myself drifting… somewhere… drifting… just like that. Im going to count down from ten, and youll feel yourself drifting deeper, and deeper, and deeper.</p>
<!-- Im already tired of this joke… but Ive already started, so I guess I gotta keep going… =,w,= -->
<p>Ten…</p>
<p>Nine…</p>
<figure>
<img src="http://localhost:4242/res/img/b/fireplace.jpg">
<figcaption><em>Youre safe by the fire.</em>
<a href="https://www.pixiv.net/artworks/115188449">
🔗
</a>
</figcaption>
</figure>
<p>Eight…</p>
<p>Seven…</p>
<figure>
<img src="http://localhost:4242/res/img/b/Im trying hard to randomly name these directories/more_calming.jpg">
<figcaption><em>Slide down, further and further~</em>
<a href="https://twitter.com/tao15102/status/1748663360105947389">
🔗
</a>
</figcaption>
</figure>
<p>Six…</p>
<p>Five…</p>
<figure>
<img src="http://localhost:4242/res/img/level-2/café.jpg">
<figcaption><em>Let yourself steep…</em>
<a href="https://twitter.com/yukichi_nya___/status/1608750624681918465">
🔗
</a>
</figcaption>
</figure>
<p>Four…</p>
<p>Three…</p>
<figure>
<img src="http://localhost:4242/res/img/b/Im trying hard to randomly name these directories/ĉu ĉi tio sufiĉe hazardas%3F!/classy_fireplace.jpg">
<figcaption><em>Youre surrounded by your superiors.</em>
<a href="https://www.pixiv.net/artworks/115188449">
🔗
</a>
</figcaption>
</figure>
<p>Two…</p>
<p>One…</p>
<figure>
<img src="http://localhost:4242/res/img/merry christmas!!! ^_^.jpg">
<figcaption>AAAAAAAA!!!
<a href="https://www.pixiv.net/artworks/86493795">
🔗
</a>
</figcaption>
</figure>
<p>MERRY FUCKING CHRISTMAS, MOTHERFUCKER!!!!!! YOUVE BEEN <a href="https://vid.puffyan.us/watch?v=KJ38jTQcO1k" >CHRISTMAS JOKED</a>!!!!!!!!!!!</p>
</main>
</body>
</html>

Binary file not shown.

After

Width:  |  Height:  |  Size: 60 KiB

View File

@ -0,0 +1,2 @@
https://twitter.com/tao15102/status/1748663360105947389
By tao15102

View File

@ -0,0 +1,2 @@
https://www.pixiv.net/artworks/71223241
By オギモトズキン

Binary file not shown.

After

Width:  |  Height:  |  Size: 24 KiB

View File

@ -0,0 +1,2 @@
https://www.pixiv.net/artworks/115188449
By フロリダちゃん

Binary file not shown.

After

Width:  |  Height:  |  Size: 27 KiB

View File

@ -0,0 +1,2 @@
https://twitter.com/yukichi_nya___/status/1608750624681918465
By yukichi_nya___

Binary file not shown.

After

Width:  |  Height:  |  Size: 47 KiB

View File

@ -0,0 +1,2 @@
https://www.pixiv.net/artworks/86493795
By Ema3

View File

@ -0,0 +1,22 @@
body {
background-color: #d7d7af;
}
main {
max-width: 800px;
margin-left: auto;
margin-right: auto;
text-align: center;
background-color: #ffffd7;
padding: 10px;
border-radius: 10px;
}
img {
border-radius: 10px;
}
figure {
border: 2px dotted;
padding: 5px;
}

Binary file not shown.

After

Width:  |  Height:  |  Size: 17 KiB

View File

@ -0,0 +1,2 @@
https://twitter.com/Distrbeachboy/status/1758538124785852426
By Distrbeachboy