From 00db3c61a5bc6c68ab39da16bf6f61b703a9997b Mon Sep 17 00:00:00 2001 From: Hermes Agent Date: Tue, 12 May 2026 14:30:31 +0000 Subject: [PATCH] fix: dialog draw-border arg, markdown/slot nil guards, +integration test suite --- run-all-tests.lisp | 6 +- src/components/dialog.lisp | 2 +- src/components/markdown.lisp | 4 + src/components/slot.lisp | 5 +- tests/integration-tests.lisp | 263 +++++++++++++++++++++++++++++++++++ tests/markdown-tests.lisp | 151 +++++++++++++++----- tests/slot-tests.lisp | 36 ++++- 7 files changed, 423 insertions(+), 44 deletions(-) create mode 100644 tests/integration-tests.lisp diff --git a/run-all-tests.lisp b/run-all-tests.lisp index 2eb57ef..e3bf81f 100644 --- a/run-all-tests.lisp +++ b/run-all-tests.lisp @@ -17,7 +17,8 @@ "tests/dialog-tests.lisp" "tests/mouse-tests.lisp" "tests/slot-tests.lisp" - "tests/framebuffer-tests.lisp")) + "tests/framebuffer-tests.lisp" + "tests/integration-tests.lisp")) (load f)) ;; Run all test suites, exit non-zero if any fails @@ -33,7 +34,8 @@ (:cl-tty-slot-test "SLOT-SUITE") (:cl-tty-layout-test "LAYOUT-SUITE") (:cl-tty-modern-backend-test "MODERN-BACKEND-SUITE") - (:cl-tty-framebuffer-test "FRAMEBUFFER-SUITE"))) + (:cl-tty-framebuffer-test "FRAMEBUFFER-SUITE") + (:cl-tty-integration-test "INTEGRATION-SUITE"))) (let* ((pkg (find-package (first suite))) (suite-name (second suite)) (s (etypecase suite-name diff --git a/src/components/dialog.lisp b/src/components/dialog.lisp index c375d5c..01fd3de 100644 --- a/src/components/dialog.lisp +++ b/src/components/dialog.lisp @@ -35,7 +35,7 @@ (dotimes (row h) (draw-rect screen 0 row w 1 :bg :bright-black)) ;; Dialog panel - (draw-border screen x y dw dh :single :title (dialog-title dialog)) + (draw-border screen x y dw dh :style :single :title (dialog-title dialog)) (when (dialog-content dialog) ;; Content rendering delegated to component system (draw-text screen (1+ x) (1+ y) diff --git a/src/components/markdown.lisp b/src/components/markdown.lisp index 9c1b748..0ccfbe4 100644 --- a/src/components/markdown.lisp +++ b/src/components/markdown.lisp @@ -31,6 +31,7 @@ ;; ─── Block-level parser ─────────────────────────────────────────────────────── (defun split-string-into-lines (string) + (unless string (return-from split-string-into-lines (coerce nil 'vector))) (let ((result nil) (start 0)) (flet ((add-line (end) (push (subseq string start end) result))) (loop for i from 0 below (length string) @@ -212,6 +213,7 @@ i)))) (defun parse-blocks (text) + (unless text (return-from parse-blocks nil)) (let ((lines (split-string-into-lines text)) (nodes nil) (i 0)) (loop while (< i (length lines)) do (let* ((line (string-trim (list #\return) (aref lines i))) @@ -502,6 +504,7 @@ (nreverse tokens))) (defun highlight-code (code language) + (unless code (return-from highlight-code nil)) (let ((highlighter (get-highlighter (and language (string-downcase language))))) (unless highlighter (return-from highlight-code (list (cons code :plain)))) (let ((tokens nil)) @@ -672,6 +675,7 @@ lines)) (defun render-markdown (text) + (unless text (return-from render-markdown "")) (let ((nodes (parse-blocks text)) (parts nil)) (dolist (line (render-md nodes)) (push line parts)) (with-output-to-string (s) diff --git a/src/components/slot.lisp b/src/components/slot.lisp index eb68c0a..26c9fbb 100644 --- a/src/components/slot.lisp +++ b/src/components/slot.lisp @@ -15,7 +15,10 @@ (defun slot-render (slot-name &rest args) (let ((entries (gethash (string slot-name) *slots*))) (when entries - (mapcar (lambda (entry) (apply (cdr entry) args)) entries)))) + (mapcar (lambda (entry) + (let ((fn (cdr entry))) + (when fn (apply fn args)))) + entries)))) (defun slot-p (slot-name) (nth-value 1 (gethash (string slot-name) *slots*))) diff --git a/tests/integration-tests.lisp b/tests/integration-tests.lisp new file mode 100644 index 0000000..65c4afb --- /dev/null +++ b/tests/integration-tests.lisp @@ -0,0 +1,263 @@ +;;; integration-tests.lisp — Full pipeline integration tests for cl-tty +;;; +;;; Composes all major components through the rendering pipeline onto a +;;; framebuffer backend and verifies cell-level output. + +(defpackage :cl-tty-integration-test + (:use :cl :fiveam + :cl-tty.backend :cl-tty.box :cl-tty.layout + :cl-tty.input :cl-tty.select :cl-tty.container + :cl-tty.rendering :cl-tty.dialog)) + +(in-package :cl-tty-integration-test) + +(def-suite integration-suite + :description "Full pipeline integration tests for cl-tty") + +(in-suite integration-suite) + +;; ─── Helper: extract cell text from a region ────────────────────── + +(defun fb-string (fb x y &optional (len 1)) + "Read a string of LEN characters from framebuffer FB starting at (X,Y)." + (let* ((cells (fb-framebuffer fb)) + (w (framebuffer-width cells)) + (h (framebuffer-height cells))) + (with-output-to-string (s) + (loop for i from 0 below len + for cx = (+ x i) + while (< cx w) + do (princ (cell-char (aref cells y cx)) s))))) + +(defun fb-lines (fb &key (start-row 0) (end-row nil)) + "Extract all lines from framebuffer FB as a list of strings." + (let* ((cells (fb-framebuffer fb)) + (w (framebuffer-width cells)) + (h (framebuffer-height cells)) + (max-row (min (or end-row h) h))) + (loop for y from start-row below max-row + collect (fb-string fb 0 y w)))) + +(defun fb-contains (fb text) + "Return T if framebuffer FB contains TEXT anywhere." + (let ((all-text (format nil "~{~a~^~%~}" (fb-lines fb)))) + (search text all-text :test #'char-equal))) + +;; ─── Test: Box with title renders correctly ─────────────────────── + +(test box-title-renders-on-fb + "A Box with a title draws border and title text on framebuffer." + (let* ((fb (make-framebuffer-backend :width 40 :height 10)) + (bx (make-box :border-style :single :title "My Box" :width 40 :height 10))) + (compute-layout (box-layout-node bx) 40 10) + (render-box bx fb) + ;; Framebuffer uses ASCII border chars (+, -, |) + (is-true (fb-contains fb "My Box") "title text appears") + (is-true (fb-contains fb "+") "top-left corner appears") + (is-true (fb-contains fb "-") "horizontal border appears") + ;; Check the title at row 0, col 2 + (is (equal "My Box" (fb-string fb 2 0 6)) "title at correct position"))) + +;; ─── Test: Text component with word-wrap ────────────────────────── + +(test text-component-on-fb + "Text component renders word-wrapped content on framebuffer." + (let* ((fb (make-framebuffer-backend :width 20 :height 6)) + (tx (make-text "Hello brave new world of terminal UI" + :wrap-mode :word :width 20 :height 4))) + (compute-layout (text-layout-node tx) 20 4) + (render-text tx fb) + (is-true (fb-contains fb "Hello") "first word appears") + (is-true (fb-contains fb "brave") "second word appears") + (is-true (fb-contains fb "world") "third word wraps"))) + +;; ─── Test: TextInput with value ─────────────────────────────────── + +(test textinput-value-on-fb + "TextInput renders its value and cursor on framebuffer." + (let* ((fb (make-framebuffer-backend :width 40 :height 3)) + (ti (make-text-input :value "hello world" :cursor 5))) + (setf (text-input-layout-node ti) + (make-layout-node :width 40 :height 1)) + (compute-layout (text-input-layout-node ti) 40 1) + (render ti fb) + ;; Verify value via direct cell inspection + (is (equal "hello world" (fb-string fb 0 0 11)) "value appears at row 0") + ;; Check cursor block at position 5 + (let* ((cells (fb-framebuffer fb)) + (cursor-char (cell-char (aref cells 0 5)))) + (is (eql #\█ cursor-char) "cursor block is drawn at position 5")))) + +;; ─── Test: TextInput empty shows placeholder ────────────────────── + +(test textinput-placeholder-on-fb + "TextInput with empty value shows placeholder text." + (let* ((fb (make-framebuffer-backend :width 40 :height 3)) + (ti (make-text-input :value "" :placeholder "Type here..."))) + (setf (text-input-layout-node ti) + (make-layout-node :width 40 :height 1)) + (compute-layout (text-input-layout-node ti) 40 1) + (render ti fb) + (is (equal "Type here..." (fb-string fb 0 0 12)) "placeholder appears at row 0"))) + +;; ─── Test: ScrollBox with children ──────────────────────────────── + +(test scrollbox-children-on-fb + "ScrollBox renders visible children offset by scroll position." + (let* ((fb (make-framebuffer-backend :width 40 :height 10)) + (children nil)) + ;; Create 8 text children, each 1 line tall + (dotimes (i 8) + (let ((tx (make-text (format nil "Line ~D" (1+ i)) + :wrap-mode :none :width 40 :height 1))) + (push tx children))) + (setf children (nreverse children)) + (let ((sb (make-scroll-box :children children :scroll-y 2))) + ;; Set scroll-box layout to 40x8 viewport using component-layout-node + (let ((ln (component-layout-node sb))) + (setf (layout-node-width ln) 40) + (setf (layout-node-height ln) 8)) + ;; Layout each child too + (dolist (c children) + (compute-layout (component-layout-node c) 40 1)) + (render sb fb) + ;; Because scroll-y=2, Line 1 and Line 2 are scrolled out + ;; Line 3 should be first visible + (is-true (fb-contains fb "Line 3") "scroll-y=2 shows Line 3 first") + (is-true (fb-contains fb "Line 4") "Line 4 is visible") + (is-true (fb-contains fb "Line 5") "Line 5 is visible") + ;; Line 1 and 2 should NOT be visible (scrolled out) + (is-false (fb-contains fb "Line 1") "Line 1 scrolled out") + (is-false (fb-contains fb "Line 2") "Line 2 scrolled out")))) + +;; ─── Test: Select renders options ───────────────────────────────── + +(test select-options-on-fb + "Select renders option titles on framebuffer." + (let* ((fb (make-framebuffer-backend :width 40 :height 10)) + (sel (make-select + :options '((:title "Red" :value :red) + (:title "Green" :value :green) + (:title "Blue" :value :blue))))) + (let ((ln (select-layout-node sel))) + (setf (layout-node-width ln) 40) + (setf (layout-node-height ln) 5)) + (render sel fb) + (is-true (fb-contains fb "Red") "first option appears") + (is-true (fb-contains fb "Green") "second option appears") + (is-true (fb-contains fb "Blue") "third option appears"))) + +;; ─── Test: Dialog renders with backdrop ─────────────────────────── + +(test dialog-appears-on-fb + "Dialog renders a dimmed backdrop and dialog panel with title." + (let* ((fb (make-framebuffer-backend :width 80 :height 24)) + (d (make-instance 'dialog :title "Confirm" :size :small))) + (push-dialog d) + (render-dialog d fb 80 24) + ;; Dialog title appears somewhere in the output + (is-true (fb-contains fb "Confirm") "dialog title appears") + ;; Dialog border (ASCII) + (is-true (fb-contains fb "+") "dialog border appears") + (is-true (fb-contains fb "|") "dialog vertical border appears") + ;; Clean up + (pop-dialog))) + +;; ─── Test: Dialog push/pop with render ──────────────────────────── + +(test dialog-push-pop-render + "Dialog push/pop cycle works with rendering." + (let* ((fb (make-framebuffer-backend :width 80 :height 24)) + (d1 (make-instance 'dialog :title "Dialog One")) + (d2 (make-instance 'dialog :title "Dialog Two"))) + (push-dialog d1) + (push-dialog d2) + (render-dialog (first *dialog-stack*) fb 80 24) + (is-true (fb-contains fb "Dialog Two") "top dialog renders") + (pop-dialog) + (backend-clear fb) + (render-dialog (first *dialog-stack*) fb 80 24) + (is-true (fb-contains fb "Dialog One") "second dialog renders after pop") + (pop-dialog))) + +;; ─── Test: Toast renders ────────────────────────────────────────── + +(test toast-appears-on-fb + "Toast notification renders with colored background." + (let* ((fb (make-framebuffer-backend :width 80 :height 24))) + (toast "Hello from toast!" :variant :info :duration 0) + (render-toast (first *toasts*) fb 80) + (is-true (fb-contains fb "Hello from toast!") "toast message appears") + (dismiss-toast (first *toasts*)))) + +;; ─── Test: render-screen pipeline ───────────────────────────────── + +(test render-screen-pipeline + "render-screen processes a component tree through the full pipeline." + (let* ((fb (make-framebuffer-backend :width 40 :height 12)) + (root (make-box :border-style :single :title "Root" + :width 40 :height 12))) + (render-screen root fb) + (is-true (fb-contains fb "Root") "title renders via render-screen") + ;; Border characters (ASCII on framebuffer) + (is-true (fb-contains fb "+") "border renders"))) + +;; ─── Test: Full composition via framebuffer ─────────────────────── + +(test full-composition-via-fb + "All components compose correctly on a single framebuffer." + (let* ((fb (make-framebuffer-backend :width 60 :height 24))) + ;; + ;; 1. Box with title at top + ;; + (let ((bx (make-box :border-style :single :title "Dashboard" + :width 60 :height 24))) + (compute-layout (box-layout-node bx) 60 24) + (render-box bx fb)) + + ;; + ;; 2. Text content inside + ;; + (let ((tx (make-text "Welcome to the dashboard." + :wrap-mode :word :width 56 :height 3))) + (setf (layout-node-x (text-layout-node tx)) 2) + (setf (layout-node-y (text-layout-node tx)) 2) + (compute-layout (text-layout-node tx) 56 3) + (render-text tx fb)) + + ;; + ;; 3. TextInput + ;; + (let ((ti (make-text-input :value "search query" :cursor 6))) + (setf (text-input-layout-node ti) (make-layout-node)) + (setf (layout-node-x (text-input-layout-node ti)) 2) + (setf (layout-node-y (text-input-layout-node ti)) 6) + (setf (layout-node-width (text-input-layout-node ti)) 56) + (setf (layout-node-height (text-input-layout-node ti)) 1) + (render ti fb)) + + ;; + ;; 4. Select options + ;; + (let ((sel (make-select + :options '((:title "Option A" :value :a) + (:title "Option B" :value :b) + (:title "Option C" :value :c))))) + (setf (select-layout-node sel) (make-layout-node)) + (setf (layout-node-x (select-layout-node sel)) 2) + (setf (layout-node-y (select-layout-node sel)) 8) + (setf (layout-node-width (select-layout-node sel)) 56) + (setf (layout-node-height (select-layout-node sel)) 3) + (render sel fb)) + + ;; + ;; Verifications + ;; + (is-true (fb-contains fb "Dashboard") "box title appears") + (is-true (fb-contains fb "Welcome") "text content appears") + ;; Check TextInput value at its position + (is (equal "search query" (fb-string fb 2 6 12)) "TextInput value at row 6") + ;; Check Select options at their positions + (is-true (fb-contains fb "Option A") "Select option A appears") + (is-true (fb-contains fb "Option B") "Select option B appears") + (is-true (fb-contains fb "Option C") "Select option C appears"))) diff --git a/tests/markdown-tests.lisp b/tests/markdown-tests.lisp index 6c87b0a..e03cacd 100644 --- a/tests/markdown-tests.lisp +++ b/tests/markdown-tests.lisp @@ -11,14 +11,91 @@ (in-suite :cl-tty-markdown-test) +;; ─── Parser edge cases ───────────────────────────────────────── + +(def-test render-markdown-nil ( ) + "render-markdown handles nil gracefully." + (is (string= "" (render-markdown nil)))) + +(def-test render-markdown-empty ( ) + "render-markdown handles empty string." + (let ((result (render-markdown ""))) + (is (stringp result)) + (is (string= "" result)))) + +(def-test parse-blocks-nil ( ) + "parse-blocks handles nil gracefully." + (is-false (parse-blocks nil))) + +(def-test split-string-into-lines-nil ( ) + "parse-blocks handles nil input (tests internal split-string-into-lines)." + (is-false (parse-blocks nil))) + +(def-test nested-bold-inside-italic ( ) + "Nested formatting: bold inside italic." + (let ((children (parse-inline "***hello*** world"))) + (is (= 3 (length children))) + (let ((first-node (first children))) + (is-true (eql :bold (getf first-node :type)))))) + +(def-test nested-italic-inside-bold ( ) + "Nested formatting: italic inside bold." + (let ((children (parse-inline "**bold *italic* bold**"))) + (is (= 1 (length children))) + (let ((bold (first children))) + (is-true (eql :bold (getf bold :type))) + (let ((inner (getf bold :children))) + (is (= 3 (length inner))) + (is-true (eql :italic (getf (second inner) :type))))))) + +(def-test inline-code-inside-bold ( ) + "Code inside bold." + (let ((children (parse-inline "**bold `code` bold**"))) + (is (= 1 (length children))) + (let ((bold (first children))) + (is-true (eql :bold (getf bold :type))) + (let ((inner (getf bold :children))) + (is (= 3 (length inner))) + (is-true (eql :inline-code (getf (second inner) :type))))))) + +(def-test unclosed-code-block ( ) + "Unclosed code block accumulates remaining lines as content." + (let* ((lines '("```lisp" "(defun foo ())" " (bar)")) + (text (format nil "~{~a~%~}" lines)) + (result (parse-blocks text)) + (node (first result))) + (is-true (eql :code-block (getf node :type))) + (is (equal "lisp" (getf (getf node :properties) :language))) + (is-true (search "bar" (getf node :content))))) + +(def-test code-block-no-language ( ) + "Code block with no language is still parsed." + (let* ((lines '("```" "plain" "```")) + (text (format nil "~{~a~%~}" lines)) + (result (parse-blocks text)) + (node (first result))) + (is-true (eql :code-block (getf node :type))) + (is-false (getf (getf node :properties) :language)))) + +(def-test markdown-very-long-line ( ) + "A very long paragraph line does not cause issues." + (let* ((long-line (make-string 500 :initial-element #\x)) + (result (render-markdown long-line))) + (is (stringp result)) + (is-true (> (length result) 0)))) + +(def-test markdown-only-blank ( ) + "Only blank lines produce empty output." + (is (string= "" (render-markdown (format nil "~%~%"))))) + ;; ─── Parser tests ───────────────────────────────────────────────────────────── -(def-test heading-parsing () +(def-test heading-parsing ( ) (let* ((result (parse-blocks "# Hello World")) (node (first result))) (is-true (eql :heading (getf node :type))) (is (= 1 (getf (getf node :properties) :level))))) -(def-test heading-levels () +(def-test heading-levels ( ) (loop for level from 1 to 6 do (let* ((hashes (make-string level :initial-element #\#)) (text (format nil "~a Heading ~d" hashes level)) @@ -27,7 +104,7 @@ (is-true (eql :heading (getf node :type))) (is (= level (getf (getf node :properties) :level)))))) -(def-test heading-with-inline-formatting () +(def-test heading-with-inline-formatting ( ) (let* ((result (parse-blocks "# Hello **World**")) (node (first result)) (children (getf node :children))) (is-true (eql :heading (getf node :type))) @@ -35,40 +112,40 @@ (is-true (eql :text (getf (first children) :type))) (is-true (eql :bold (getf (second children) :type))))) -(def-test paragraph-parsing () +(def-test paragraph-parsing ( ) (let* ((result (parse-blocks "This is a paragraph.")) (node (first result))) (is-true (eql :paragraph (getf node :type))))) -(def-test paragraph-multi-line () +(def-test paragraph-multi-line ( ) (let* ((result (parse-blocks "Line one\nLine two")) (node (first result))) (is-true (eql :paragraph (getf node :type))))) -(def-test bold-parsing () +(def-test bold-parsing ( ) (let* ((children (parse-inline "hello **world** here")) (bold-node (second children))) (is (= 3 (length children))) (is-true (eql :bold (getf bold-node :type))))) -(def-test italic-parsing () +(def-test italic-parsing ( ) (let* ((children (parse-inline "hello *world* here")) (italic-node (second children))) (is (= 3 (length children))) (is-true (eql :italic (getf italic-node :type))))) -(def-test bold-italic-combined () +(def-test bold-italic-combined ( ) (let ((children (parse-inline "**bold** and *italic*"))) (is (= 3 (length children))) (is-true (eql :bold (getf (first children) :type))) (is-true (eql :italic (getf (third children) :type))))) -(def-test inline-code-parsing () +(def-test inline-code-parsing ( ) (let* ((children (parse-inline "use `foo` here")) (code-node (second children))) (is (= 3 (length children))) (is-true (eql :inline-code (getf code-node :type))) (is (equal "foo" (getf code-node :content))))) -(def-test link-parsing () +(def-test link-parsing ( ) (let* ((children (parse-inline "click [here](https://x.com)")) (link-node (second children))) (is (= 2 (length children))) @@ -79,98 +156,100 @@ (is-true (eql :text (getf (first link-text) :type))) (is (equal "here" (getf (first link-text) :content)))))) -(def-test code-block-parsing () - (let* ((text (format nil "```lisp~%(defun hello ())~% (print \"hi\")~%```")) +(def-test code-block-parsing ( ) + (let* ((lines '("```lisp" "(defun hello ())" " (print \"hi\")" "```")) + (text (format nil "~{~a~%~}" lines)) (result (parse-blocks text)) (node (first result))) (is-true (eql :code-block (getf node :type))) (is (equal "lisp" (getf (getf node :properties) :language))) (is-true (search "(defun hello" (getf node :content))))) -(def-test code-block-unknown-language () - (let* ((text (format nil "```~%plain code~%```")) +(def-test code-block-unknown-language ( ) + (let* ((lines '("```" "plain code" "```")) + (text (format nil "~{~a~%~}" lines)) (result (parse-blocks text)) (node (first result))) (is-true (eql :code-block (getf node :type))) (is-false (getf (getf node :properties) :language)))) -(def-test blockquote-parsing () +(def-test blockquote-parsing ( ) (let* ((result (parse-blocks "> This is a quote")) (node (first result))) (is-true (eql :blockquote (getf node :type))))) -(def-test list-item-parsing () +(def-test list-item-parsing ( ) (let* ((result (parse-blocks "- First item")) (node (first result))) (is-true (eql :list-item (getf node :type))))) -(def-test ordered-list-parsing () +(def-test ordered-list-parsing ( ) (let* ((result (parse-blocks "1. First item")) (node (first result))) (is-true (eql :ordered-item (getf node :type))))) -(def-test thematic-break-parsing () +(def-test thematic-break-parsing ( ) (let* ((result (parse-blocks "---")) (node (first result))) (is-true (eql :thematic-break (getf node :type))))) ;; ─── Diff tests ─────────────────────────────────────────────────────────────── -(def-test classify-diff-added () +(def-test classify-diff-added ( ) (is (eql :added (classify-diff-line "+this is added")))) -(def-test classify-diff-removed () +(def-test classify-diff-removed ( ) (is (eql :removed (classify-diff-line "-this is removed")))) -(def-test classify-diff-hunk () - (is (eql :hunk-header (classify-diff-line "@@ -1,3 +1,4 @@")))) +(def-test classify-diff-hunk ( ) + (is (eql :hunk-header (classify-diff-line "@@ -1,3 +1,4 @@" )))) -(def-test classify-diff-context () +(def-test classify-diff-context ( ) (is (eql :context (classify-diff-line " normal context")))) ;; ─── Syntax highlighting tests ──────────────────────────────────────────────── -(def-test highlight-lisp-keyword () +(def-test highlight-lisp-keyword ( ) (let ((tokens (highlight-code "(defun hello ()" "lisp"))) (is-true (some (lambda (pair) (and (search "defun" (car pair)) (eql :keyword (cdr pair)))) tokens)))) -(def-test highlight-lisp-builtin () +(def-test highlight-lisp-builtin ( ) "Test that a Lisp builtin like nil is highlighted as :builtin." (let ((tokens (highlight-code "(if t nil)" "lisp"))) (is-true (some (lambda (pair) (and (string= (car pair) "nil") (eql :builtin (cdr pair)))) tokens)))) -(def-test highlight-unknown-language () +(def-test highlight-unknown-language ( ) (let ((tokens (highlight-code "hello world" "unknown-xyz"))) (every (lambda (pair) (eql :plain (cdr pair))) tokens))) -(def-test highlight-comment () +(def-test highlight-comment ( ) (let ((tokens (highlight-code "; this is a comment" "lisp"))) (is-true (some (lambda (pair) (eql :comment (cdr pair))) tokens)))) ;; ─── Render tests ───────────────────────────────────────────────────────────── -(def-test render-heading-output () +(def-test render-heading-output ( ) (let* ((node (make-md-node :heading :properties (list :level 2) :children (list (make-md-node :text :content "Test")))) (lines (render-md-node node))) (is (= 1 (length lines))) (is-true (> (length (first lines)) 0)))) -(def-test render-paragraph-output () +(def-test render-paragraph-output ( ) (let* ((node (make-md-node :paragraph :children (list (make-md-node :text :content "Hello")))) (lines (render-md-node node))) (is (= 1 (length lines))) (is-true (search "Hello" (first lines))))) -(def-test render-thematic-break-output () +(def-test render-thematic-break-output ( ) (let* ((node (make-md-node :thematic-break)) (lines (render-md-node node))) (is (= 1 (length lines))))) -(def-test render-code-block-output () +(def-test render-code-block-output ( ) (let* ((node (make-md-node :code-block :content "(print \"hello\")" :properties (list :language "lisp"))) (lines (render-md-node node))) (is-true (> (length lines) 0)))) -(def-test render-diff-block-output () +(def-test render-diff-block-output ( ) (let* ((node (make-md-node :diff-block :properties (list :lines '("--- a/file" "+++ b/file" "@@ -1 +1 @@" @@ -182,22 +261,22 @@ ;; ─── Integration tests ──────────────────────────────────────────────────────── -(def-test markdown-integration () +(def-test markdown-integration ( ) (let* ((md (format nil "# Title~%~%This is **bold** and `code`.~%~%- Item 1~%- Item 2~%~%> A quote~%~%```lisp~%(defun hello ())~% (print \"hi\")~%```~%~%---")) (nodes (parse-blocks md)) (lines (render-md nodes))) (is-true (> (length lines) 5)) (is-true (search "# Title" (first lines))))) -(def-test render-markdown-string () +(def-test render-markdown-string ( ) (let ((result (render-markdown "**bold** text"))) (is-true (stringp result)) (is-true (> (length result) 0)))) -(def-test md-node-text-simple () +(def-test md-node-text-simple ( ) (let ((node (make-md-node :text :content "hello"))) (is (equal "hello" (md-node-text node))))) -(def-test md-node-text-nested () +(def-test md-node-text-nested ( ) (let ((node (make-md-node :paragraph :children (list (make-md-node :text :content "hello") (make-md-node :bold :children diff --git a/tests/slot-tests.lisp b/tests/slot-tests.lisp index ac972c1..ab9b63a 100644 --- a/tests/slot-tests.lisp +++ b/tests/slot-tests.lisp @@ -4,23 +4,51 @@ (def-suite slot-suite :description "Slot system tests") (in-suite slot-suite) -(def-test defslot-register () +(def-test defslot-register ( ) (clear-slot :test-slot) (defslot :test-slot :order 1 :render-fn (lambda () "hello")) (is-true (slot-p :test-slot))) -(def-test slot-render-calls () +(def-test slot-render-calls ( ) (clear-slot :test-slot) (defslot :test-slot :order 1 :render-fn (lambda () "a")) (defslot :test-slot :order 2 :render-fn (lambda () "b")) (is (equal '("a" "b") (slot-render :test-slot)))) -(def-test slot-render-empty () +(def-test slot-render-empty ( ) (clear-slot :ghost) (is-false (slot-render :ghost))) -(def-test clear-slot-removes () +(def-test clear-slot-removes ( ) (clear-slot :test-slot) (defslot :test-slot :order 1 :render-fn (lambda () "x")) (clear-slot :test-slot) (is-false (slot-p :test-slot))) + +(def-test defslot-nil-render-fn ( ) + "defslot with nil (default) render-fn should not crash slot-render." + (clear-slot :nil-slot) + (defslot :nil-slot :order 1) + (is-true (slot-p :nil-slot)) + (is (equal '(nil) (slot-render :nil-slot))) + (clear-slot :nil-slot)) + +(def-test defslot-duplicate-same-order ( ) + "Multiple defslot calls with the same order should all register." + (clear-slot :dup-slot) + (defslot :dup-slot :order 5 :render-fn (lambda () "first")) + (defslot :dup-slot :order 5 :render-fn (lambda () "second")) + (let ((result (slot-render :dup-slot))) + (is (= 2 (length result))) + ;; Entries with same order are prepended, so "second" comes first + (is (equal "second" (first result))) + (is (equal "first" (second result)))) + (clear-slot :dup-slot)) + +(def-test slot-render-with-args ( ) + "slot-render passes arguments to all registered render-fns." + (clear-slot :args-slot) + (defslot :args-slot :order 1 :render-fn (lambda (x y) (format nil "~a+~a" x y))) + (let ((result (slot-render :args-slot 3 4))) + (is (equal '("3+4") result))) + (clear-slot :args-slot))