From e6b5011763c7f59ae8acf2c38d568c88ebd65ec1 Mon Sep 17 00:00:00 2001
From: Thomas Albers Raviola <thomas@thomaslabs.org>
Date: Fri, 18 Oct 2024 19:34:44 +0200
Subject: Add test suit

---
 Makefile               | 11 +++++++++++
 routes.asd             | 14 --------------
 scgi-routes.asd        | 28 ++++++++++++++++++++++++++++
 src/package.lisp       |  3 ++-
 src/routes.lisp        | 13 +++++++------
 tests/package.lisp     |  3 +++
 tests/test-routes.lisp | 25 +++++++++++++++++++++++++
 7 files changed, 76 insertions(+), 21 deletions(-)
 create mode 100644 Makefile
 delete mode 100644 routes.asd
 create mode 100644 scgi-routes.asd
 create mode 100644 tests/package.lisp
 create mode 100644 tests/test-routes.lisp

diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..7b47ee8
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,11 @@
+TESTOPTS=--noinform --non-interactive --eval "(require 'asdf)"\
+	--eval "(setf sb-impl::*default-external-format* :utf-8)"\
+	--eval "(asdf:load-asd (merge-pathnames \"scgi-routes.asd\"))"\
+	--eval "(asdf:load-system :scgi-routes/tests)"\
+	--eval "(if (5am:run-all-tests) (uiop:quit 0) (uiop:quit 1))"
+
+all :
+
+.PHONY : test
+test :
+	@sbcl $(TESTOPTS)
diff --git a/routes.asd b/routes.asd
deleted file mode 100644
index e131634..0000000
--- a/routes.asd
+++ /dev/null
@@ -1,14 +0,0 @@
-(asdf:defsystem #:routes
-  :description "A library for handling routing of SCGI requests."
-  :author "Thomas Albers Raviola <thomas@thomaslabs.org>"
-  :maintainer "Thomas Albers Raviola <thomas@thomaslabs.org>"
-  :license  "GPL-3"
-  :version "1.0.0"
-  :serial t
-  :depends-on (:alexandria
-               :quri
-               :split-sequence
-               :usocket-server)
-  :pathname "src"
-  :components ((:file "package")
-               (:file "routes")))
diff --git a/scgi-routes.asd b/scgi-routes.asd
new file mode 100644
index 0000000..76f885d
--- /dev/null
+++ b/scgi-routes.asd
@@ -0,0 +1,28 @@
+(asdf:defsystem #:scgi-routes
+  :name "scgi-routes"
+  :description "A library for handling routing of SCGI requests."
+  :author "Thomas Albers Raviola <thomas@thomaslabs.org>"
+  :maintainer "Thomas Albers Raviola <thomas@thomaslabs.org>"
+  :license  "GPL-3"
+  :version "1.0.0"
+  :serial t
+  :depends-on (:alexandria
+               :quri
+               :split-sequence
+               :usocket-server)
+  :pathname "src"
+  :components ((:file "package")
+               (:file "routes"))
+  :in-order-to ((test-op (test-op "scgi-routes/tests"))))
+
+(asdf:defsystem #:scgi-routes/tests
+  :name "scgi-routes tests"
+  :serial t
+  :depends-on (:scgi-routes
+               :fiveam)
+  :pathname "tests"
+  :components ((:file "package")
+               (:file "test-routes"))
+  ;; :perform (test-op (o c)
+  ;;                   (uiop/package:symbol-call "FIASCO" "RUN-TESTS" 'stumpwm-tests))
+  )
diff --git a/src/package.lisp b/src/package.lisp
index c2ea5b2..016f438 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -1,4 +1,5 @@
-(defpackage #:routes
+(defpackage #:scgi-routes
+  (:nicknames #:routes)
   (:use #:cl
         #:alexandria
         #:split-sequence)
diff --git a/src/routes.lisp b/src/routes.lisp
index 272d579..0de0307 100644
--- a/src/routes.lisp
+++ b/src/routes.lisp
@@ -1,14 +1,14 @@
-(in-package #:routes)
+(in-package #:scgi-routes)
 
 ;; Source: https://developer.mozilla.org/en-US/docs/Web/HTTP/Methods
 ;; Note: Not all http methods are yet implemented
 ;; Missing: :head :put :delete :connect :options :trace :patch
 
-(defparameter *http-methods*
-  '(:get :post))
+(define-constant +http-methods+
+  '(:get :post) :test 'equal)
 
 (deftype http-method ()
-  `(member ,@*http-methods*))
+  `(member ,@+http-methods+))
 
 (defun route-method-p (object)
   (or (typep object 'http-method)
@@ -239,11 +239,12 @@ route. If no route matches, then ERROR-HANDLER is called."
         (let* ((method (assoc-value headers :request-uri))
                (uri (assoc-value headers :request-uri))
                (query-bindings (quri:uri-query-params uri))
-               (route (uri-route uri)))
+               (route (uri-route uri))
+               (fragment (quri:uri-fragment uri)))
           (multiple-value-bind (entry path-bindings)
               (find-route route method *routes-table*)
             (if entry
-                (funcall (first entry) headers path-bindings query-bindings
+                (funcall (route-name entry) headers path-bindings query-bindings
                          fragment)
                 (funcall error-handler headers)))))
     (t (e)
diff --git a/tests/package.lisp b/tests/package.lisp
new file mode 100644
index 0000000..eb337ea
--- /dev/null
+++ b/tests/package.lisp
@@ -0,0 +1,3 @@
+(defpackage #:scgi-routes/tests
+  (:use #:cl
+        #:scgi-routes))
diff --git a/tests/test-routes.lisp b/tests/test-routes.lisp
new file mode 100644
index 0000000..45f75cc
--- /dev/null
+++ b/tests/test-routes.lisp
@@ -0,0 +1,25 @@
+(in-package #:scgi-routes/tests)
+
+(5am:def-suite* scgi-routes-tests)
+
+(5am:test test1
+  (5am:finishes
+    (routes:define-route index (:path (p1 p2 "index.cgi")
+                                :method :get
+                                :query (q1
+                                        (q2 :init-form "2")
+                                        (q3 :name "named")
+                                        (q4 :name "all" :init-form "4"
+                                            :suppliedp q4p)
+                                        (q5 :suppliedp q5p))
+                                :fragment f
+                                :content-type "text/plain")
+      (list p1 p2 q1 q2 q3 q4 q4p q5 q5p f)))
+  (5am:is
+   (equal
+    (let (ret
+          (uri "http://localhost:8080/foo/blah/index.cgi?b=1&c=2&q5"))
+      (with-output-to-string (*standard-output*)
+        (setf ret (test-route :get uri)))
+      ret)
+    (list "foo" "blah" nil "2" nil "4" t nil t nil))))
-- 
cgit v1.2.3