1 ;;; rail-tests.el --- End-to-end tests for the RAIL tools -*- lexical-binding: t; -*- 2 3 ;;; Commentary: 4 5 ;; These tests exercise the RAIL handler functions directly. The MCP 6 ;; framework calls each handler with one alist of arguments, so a direct call 7 ;; follows the same path as a tool call. Each test runs against a temporary 8 ;; stream file, so no test touches the project stream file. 9 ;; 10 ;; Run the tests with the runner script in this directory: 11 ;; 12 ;; ./run-tests.sh 13 14 ;;; Code: 15 16 (require 'ert) 17 (require 'json) 18 19 ;;; Fixtures 20 21 (defvar rail-tests--preamble 22 (concat "#+TITLE: Test stream\n" 23 "#+TODO: TODO IN-PROGRESS TESTING TESTED BLOCKED | CANCELLED DONE\n" 24 "#+TAGS: [ Kind : feat fix refactor chore docs ]\n" 25 "#+TAGS: [ Scope : core app web ui ]\n" 26 "#+TAGS: [ Impact : minor major ]\n" 27 "\n" 28 "# Local Variables:\n" 29 "# org-log-done: time\n" 30 "# End:\n") 31 "Preamble of the temporary stream file. 32 The `#+TODO:' line gives the keyword sequence. The `#+TAGS:' lines give 33 the tag vocabulary, grouped into axes. The local variable 34 `org-log-done' makes Org write a CLOSED timestamp.") 35 36 (defun rail-tests--decode (json-string) 37 "Return JSON-STRING decoded into Lisp with alists for objects. 38 Decode JSON null to nil and JSON false to `:json-false', which are the 39 same sentinels that the handlers encode from. A round trip therefore 40 gives back the value that the handler started with." 41 (json-parse-string json-string 42 :object-type 'alist 43 :null-object nil 44 :false-object :json-false)) 45 46 (defun rail-tests--call (handler args) 47 "Call HANDLER with ARGS and return the decoded result. 48 Signal an error when the handler reports one, so a failure is visible." 49 (let ((result (rail-tests--decode (funcall handler args)))) 50 (when (alist-get 'error result) 51 (error "Handler failed: %s" (alist-get 'error result))) 52 result)) 53 54 (defmacro rail-tests--with-stream (root &rest body) 55 "Create a temporary project directory, bind ROOT to it, then run BODY. 56 Delete the directory and its buffers after BODY." 57 (declare (indent 1)) 58 `(let* ((,root (file-name-as-directory (make-temp-file "rail-test" t))) 59 (file (expand-file-name rail-stream-file-name ,root)) 60 (enable-local-variables :all) 61 (org-id-track-globally nil) 62 (create-lockfiles nil)) 63 (unwind-protect 64 (progn 65 (with-temp-file file (insert rail-tests--preamble)) 66 ,@body) 67 (dolist (buf (buffer-list)) 68 (when (and (buffer-file-name buf) 69 (string-prefix-p ,root (buffer-file-name buf))) 70 (with-current-buffer buf (set-buffer-modified-p nil)) 71 (kill-buffer buf))) 72 (delete-directory ,root t)))) 73 74 (defun rail-tests--capture (root title tags &optional body) 75 "Capture a request in ROOT with TITLE, TAGS, and optional BODY. 76 Return the new entry's Org ID." 77 (alist-get 'id (rail-tests--call 78 #'rail-tools--capture-handler 79 (list (cons 'root root) 80 (cons 'title title) 81 (cons 'tags tags) 82 (cons 'body (or body "Request body.")))))) 83 84 (defun rail-tests--file-text (root) 85 "Return the text of the stream file in ROOT." 86 (with-temp-buffer 87 (insert-file-contents (expand-file-name rail-stream-file-name root)) 88 (buffer-string))) 89 90 ;;; Root discovery 91 92 (ert-deftest rail-test-locate-root-finds-the-stream-file () 93 "`rail-locate-root' finds the root from a nested directory." 94 (rail-tests--with-stream root 95 (let ((nested (expand-file-name "a/b/c/" root))) 96 (make-directory nested t) 97 (should (equal (rail-locate-root nested) root))))) 98 99 (ert-deftest rail-test-locate-root-returns-nil-without-a-stream-file () 100 "`rail-locate-root' returns nil when no ancestor holds the file." 101 (let ((empty (file-name-as-directory (make-temp-file "rail-empty" t)))) 102 (unwind-protect 103 (should (null (rail-locate-root empty))) 104 (delete-directory empty t)))) 105 106 (ert-deftest rail-test-root-argument-overrides-the-default () 107 "An explicit `root' argument selects the file, not `rail-project-root'." 108 (rail-tests--with-stream root 109 (should (equal (rail-tools--file (list (cons 'root root))) 110 (expand-file-name rail-stream-file-name root))))) 111 112 (ert-deftest rail-test-absent-root-uses-the-default () 113 "An absent `root' argument falls back to `rail-project-root'." 114 (rail-tests--with-stream root 115 (let ((rail-project-root root)) 116 (should (equal (rail-tools--file nil) 117 (expand-file-name rail-stream-file-name root)))))) 118 119 (ert-deftest rail-test-a-missing-directory-signals-an-error () 120 "A `root' that is not a directory signals an error." 121 (should-error (rail-tools--file 122 (list (cons 'root "/rail/no/such/directory"))))) 123 124 ;;; Capture 125 126 (ert-deftest rail-test-capture-creates-an-addressable-todo () 127 "Capture writes a TODO entry with an ID, a SCHEDULED time, and tags." 128 (rail-tests--with-stream root 129 (let* ((id (rail-tests--capture root "Add a widget" ["feat" "web"])) 130 (entry (rail-tests--call #'rail-tools--show-handler 131 (list (cons 'root root) (cons 'id id))))) 132 (should (stringp id)) 133 (should (equal (alist-get 'state entry) "TODO")) 134 (should (equal (alist-get 'heading entry) "Add a widget")) 135 (should (equal (append (alist-get 'tags entry) nil) '("feat" "web"))) 136 (should (stringp (alist-get 'scheduled entry))) 137 (should (null (alist-get 'closed entry)))))) 138 139 (ert-deftest rail-test-capture-puts-the-newest-request-first () 140 "Capture inserts each new request above the previous request." 141 (rail-tests--with-stream root 142 (rail-tests--capture root "First request" ["feat" "core"]) 143 (rail-tests--capture root "Second request" ["fix" "app"]) 144 (let ((rows (rail-tests--decode 145 (rail-tools--list-handler (list (cons 'root root)))))) 146 (should (equal (length rows) 2)) 147 (should (equal (alist-get 'title (aref rows 0)) "Second request")) 148 (should (equal (alist-get 'title (aref rows 1)) "First request"))))) 149 150 (ert-deftest rail-test-capture-rejects-a-tag-outside-the-vocabulary () 151 "Capture rejects any tag that the closed vocabulary does not hold." 152 (rail-tests--with-stream root 153 (let ((result (rail-tests--decode 154 (rail-tools--capture-handler 155 (list (cons 'root root) 156 (cons 'title "Bad tags") 157 (cons 'tags ["feat" "trivial"])))))) 158 (should (string-match-p "Unknown tag" (alist-get 'error result)))))) 159 160 ;;; Status 161 162 (ert-deftest rail-test-set-status-moves-through-the-open-keywords () 163 "Set-status accepts each open keyword from the file's own sequence." 164 (rail-tests--with-stream root 165 (let ((id (rail-tests--capture root "Track status" ["feat" "core"]))) 166 (dolist (state '("IN-PROGRESS" "TESTING" "TESTED")) 167 (let ((result (rail-tests--call 168 #'rail-tools--set-status-handler 169 (list (cons 'root root) (cons 'id id) 170 (cons 'state state))))) 171 (should (equal (alist-get 'state result) state)))) 172 (should (equal (alist-get 'state (rail-tests--call 173 #'rail-tools--verify-handler 174 (list (cons 'root root) (cons 'id id)))) 175 "TESTED"))))) 176 177 (ert-deftest rail-test-set-status-refuses-done () 178 "Set-status refuses DONE, because completion needs result evidence." 179 (rail-tests--with-stream root 180 (let* ((id (rail-tests--capture root "Refuse done" ["feat" "core"])) 181 (result (rail-tests--decode 182 (rail-tools--set-status-handler 183 (list (cons 'root root) (cons 'id id) 184 (cons 'state "DONE")))))) 185 (should (string-match-p "rail-complete" (alist-get 'error result)))))) 186 187 (ert-deftest rail-test-block-and-cancel-record-a-reason () 188 "Block and cancel write the reason, so the decision is never silent." 189 (rail-tests--with-stream root 190 (let ((blocked (rail-tests--capture root "Blocked work" ["feat" "app"])) 191 (dropped (rail-tests--capture root "Dropped work" ["feat" "ui"]))) 192 (rail-tests--call #'rail-tools--block-handler 193 (list (cons 'root root) (cons 'id blocked) 194 (cons 'reason "The route does not exist"))) 195 (rail-tests--call #'rail-tools--cancel-handler 196 (list (cons 'root root) (cons 'id dropped) 197 (cons 'reason "The user withdrew the request"))) 198 (let ((text (rail-tests--file-text root))) 199 (should (string-match-p 200 "- BLOCKED NOTE \\[.*\\] :: The route does not exist" text)) 201 (should (string-match-p 202 "- CANCELLED NOTE \\[.*\\] :: The user withdrew" text)) 203 ;; The note lives in the LOGBOOK drawer, not as a body line. 204 (should-not (string-match-p "- blocked ::" text)) 205 (should-not (string-match-p "- cancelled ::" text))) 206 (should (equal "BLOCKED" 207 (alist-get 'state (rail-tests--call 208 #'rail-tools--verify-handler 209 (list (cons 'root root) 210 (cons 'id blocked)))))) 211 (should (equal "CANCELLED" 212 (alist-get 'state (rail-tests--call 213 #'rail-tools--verify-handler 214 (list (cons 'root root) 215 (cons 'id dropped))))))))) 216 217 (ert-deftest rail-test-block-requires-a-reason () 218 "Block refuses a blank reason." 219 (rail-tests--with-stream root 220 (let* ((id (rail-tests--capture root "Needs a reason" ["feat" "app"])) 221 (result (rail-tests--decode 222 (rail-tools--block-handler 223 (list (cons 'root root) (cons 'id id) 224 (cons 'reason " ")))))) 225 (should (string-match-p "reason" (alist-get 'error result)))))) 226 227 ;;; Checklist, logbook, and tags 228 229 (ert-deftest rail-test-checklist-adds-and-toggles-items () 230 "The checklist adds an item, then toggles it, and reports booleans." 231 (rail-tests--with-stream root 232 (let ((id (rail-tests--capture root "Split the task" ["feat" "core"]))) 233 (let ((added (rail-tests--call 234 #'rail-tools--check-handler 235 (list (cons 'root root) (cons 'id id) 236 (cons 'action "add") (cons 'item "step one"))))) 237 (should (equal (alist-get 'done (aref (alist-get 'items added) 0)) 238 :json-false))) 239 (let ((toggled (rail-tests--call 240 #'rail-tools--check-handler 241 (list (cons 'root root) (cons 'id id) 242 (cons 'action "toggle") (cons 'item "step one"))))) 243 (should (eq (alist-get 'done (aref (alist-get 'items toggled) 0)) t))) 244 (should (string-match-p "Checklist \\[1/1\\]" (rail-tests--file-text root)))))) 245 246 (ert-deftest rail-test-log-appends-and-keeps-earlier-notes () 247 "The logbook keeps every note, newest first." 248 (rail-tests--with-stream root 249 (let ((id (rail-tests--capture root "Log progress" ["feat" "core"]))) 250 (rail-tests--call #'rail-tools--log-handler 251 (list (cons 'root root) (cons 'id id) 252 (cons 'note "First note"))) 253 (rail-tests--call #'rail-tools--log-handler 254 (list (cons 'root root) (cons 'id id) 255 (cons 'note "Second note"))) 256 (let* ((entry (rail-tests--call #'rail-tools--show-handler 257 (list (cons 'root root) (cons 'id id)))) 258 (notes (append (alist-get 'logbook entry) nil))) 259 (should (equal (length notes) 2)) 260 (should (string-match-p "Second note" (nth 0 notes))) 261 (should (string-match-p "First note" (nth 1 notes))))))) 262 263 (ert-deftest rail-test-retag-validates-against-the-vocabulary () 264 "Retag replaces the tags, and refuses a tag outside the vocabulary." 265 (rail-tests--with-stream root 266 (let ((id (rail-tests--capture root "Retag me" ["feat" "core"]))) 267 (let ((result (rail-tests--call 268 #'rail-tools--retag-handler 269 (list (cons 'root root) (cons 'id id) 270 (cons 'tags ["fix" "web" "minor"]))))) 271 (should (equal (append (alist-get 'tags result) nil) 272 '("fix" "web" "minor")))) 273 (let ((result (rail-tests--decode 274 (rail-tools--retag-handler 275 (list (cons 'root root) (cons 'id id) 276 (cons 'tags ["nonsense"])))))) 277 (should (string-match-p "Unknown tag" (alist-get 'error result))))))) 278 279 ;;; Result and completion 280 281 (ert-deftest rail-test-set-result-writes-model-and-notes () 282 "The result line holds the model, the commit, the tests, and the notes." 283 (rail-tests--with-stream root 284 (let* ((id (rail-tests--capture root "Record a result" ["fix" "core"])) 285 (result (rail-tests--call 286 #'rail-tools--set-result-handler 287 (list (cons 'root root) (cons 'id id) 288 (cons 'commit "abc1234") (cons 'tests "246 pass") 289 (cons 'model "test-agent") 290 (cons 'notes "the sentinel was wrong"))))) 291 (should (equal (alist-get 'result result) 292 "model=test-agent commit=abc1234 tests=246 pass; the sentinel was wrong"))))) 293 294 (ert-deftest rail-test-set-result-omits-absent-optional-fields () 295 "The result line holds only the commit and the tests when nothing else is given." 296 (rail-tests--with-stream root 297 (let* ((id (rail-tests--capture root "Plain result" ["fix" "core"])) 298 (result (rail-tests--call 299 #'rail-tools--set-result-handler 300 (list (cons 'root root) (cons 'id id) 301 (cons 'commit "abc1234") (cons 'tests "246 pass"))))) 302 (should (equal (alist-get 'result result) 303 "commit=abc1234 tests=246 pass"))))) 304 305 (ert-deftest rail-test-set-result-replaces-an-earlier-line () 306 "A second result call replaces the earlier result line." 307 (rail-tests--with-stream root 308 (let ((id (rail-tests--capture root "Replace result" ["fix" "core"]))) 309 (dolist (commit '("aaa1111" "bbb2222")) 310 (rail-tests--call #'rail-tools--set-result-handler 311 (list (cons 'root root) (cons 'id id) 312 (cons 'commit commit) (cons 'tests "1 pass")))) 313 (let ((text (rail-tests--file-text root))) 314 (should-not (string-match-p "aaa1111" text)) 315 (should (string-match-p "bbb2222" text)))))) 316 317 (ert-deftest rail-test-complete-sets-done-with-result-and-closed () 318 "Completion writes the result, sets DONE, and confirms the CLOSED time." 319 (rail-tests--with-stream root 320 (let* ((id (rail-tests--capture root "Finish the work" ["feat" "core"])) 321 (result (rail-tests--call 322 #'rail-tools--complete-handler 323 (list (cons 'root root) (cons 'id id) 324 (cons 'commit "def5678") (cons 'tests "247 pass") 325 (cons 'model "test-agent"))))) 326 (should (equal (alist-get 'state result) "DONE")) 327 (should (string-match-p "commit=def5678" (alist-get 'result result))) 328 (should (string-match-p "\\[.*\\]" (alist-get 'closed result))) 329 ;; The closing note is a CLOSING NOTE item in the LOGBOOK drawer, 330 ;; not a `- result ::' body line. 331 (let ((text (rail-tests--file-text root))) 332 (should (string-match-p ":LOGBOOK:" text)) 333 (should (string-match-p 334 "- CLOSING NOTE \\[.*\\] :: model=test-agent commit=def5678" 335 text)) 336 (should-not (string-match-p "- result ::" text))) 337 (let ((entry (rail-tests--call #'rail-tools--verify-handler 338 (list (cons 'root root) (cons 'id id))))) 339 (should (equal (alist-get 'state entry) "DONE")) 340 (should (stringp (alist-get 'closed entry))))))) 341 342 (ert-deftest rail-test-complete-refuses-a-file-without-closed-logging () 343 "Completion refuses to run when the file does not log a CLOSED time. 344 Org must write the CLOSED timestamp, so the tool never writes it." 345 (let* ((root (file-name-as-directory (make-temp-file "rail-nolog" t))) 346 (file (expand-file-name rail-stream-file-name root)) 347 (enable-local-variables :all) 348 (org-id-track-globally nil) 349 (create-lockfiles nil) 350 (org-log-done nil)) 351 (unwind-protect 352 (progn 353 ;; This preamble holds no `org-log-done' local variable. 354 (with-temp-file file 355 (insert "#+TITLE: No logging\n" 356 "#+TODO: TODO IN-PROGRESS | CANCELLED DONE\n")) 357 (let ((id (rail-tests--capture root "No logging" ["feat" "core"]))) 358 ;; Close the buffer, so the next open reads the local variables 359 ;; of the file as it now stands. 360 (dolist (buf (buffer-list)) 361 (when (equal (buffer-file-name buf) file) 362 (with-current-buffer buf (set-buffer-modified-p nil)) 363 (kill-buffer buf))) 364 (let ((result (rail-tests--decode 365 (rail-tools--complete-handler 366 (list (cons 'root root) (cons 'id id) 367 (cons 'commit "def5678") 368 (cons 'tests "1 pass")))))) 369 (should (stringp (alist-get 'error result))) 370 (should (string-match-p "org-log-done" 371 (alist-get 'error result)))))) 372 (dolist (buf (buffer-list)) 373 (when (and (buffer-file-name buf) 374 (string-prefix-p root (buffer-file-name buf))) 375 (with-current-buffer buf (set-buffer-modified-p nil)) 376 (kill-buffer buf))) 377 (delete-directory root t)))) 378 379 ;;; Reading 380 381 (ert-deftest rail-test-list-encodes-an-absent-value-as-json-null () 382 "A heading without an ID reports JSON null, not the text \"null\"." 383 (rail-tests--with-stream root 384 (let ((file (expand-file-name rail-stream-file-name root))) 385 (with-current-buffer (find-file-noselect file) 386 (goto-char (point-min)) 387 (insert "* TODO Entry without an identifier :feat:core:\n") 388 (save-buffer)) 389 (let* ((json (rail-tools--list-handler (list (cons 'root root)))) 390 (rows (rail-tests--decode json))) 391 (should (null (alist-get 'id (aref rows 0)))) 392 (should-not (string-match-p "\"null\"" json)))))) 393 394 (ert-deftest rail-test-list-filters-by-state-and-tag () 395 "The list filters narrow the result by TODO keyword and by tag." 396 (rail-tests--with-stream root 397 (let ((first (rail-tests--capture root "Filter one" ["feat" "core"]))) 398 (rail-tests--capture root "Filter two" ["fix" "web"]) 399 (rail-tests--call #'rail-tools--set-status-handler 400 (list (cons 'root root) (cons 'id first) 401 (cons 'state "IN-PROGRESS"))) 402 (let ((by-state (rail-tests--decode 403 (rail-tools--list-handler 404 (list (cons 'root root) (cons 'state "IN-PROGRESS"))))) 405 (by-tag (rail-tests--decode 406 (rail-tools--list-handler 407 (list (cons 'root root) (cons 'tag "web")))))) 408 (should (equal (length by-state) 1)) 409 (should (equal (alist-get 'title (aref by-state 0)) "Filter one")) 410 (should (equal (length by-tag) 1)) 411 (should (equal (alist-get 'title (aref by-tag 0)) "Filter two")))))) 412 413 (ert-deftest rail-test-inspect-reports-the-sequence-and-the-axes () 414 "Inspect reports the file's keyword sequence and the file's tag axes." 415 (rail-tests--with-stream root 416 (let* ((result (rail-tests--call #'rail-tools--inspect-handler 417 (list (cons 'root root)))) 418 (keywords (append (alist-get 'todo_keywords result) nil)) 419 (axes (alist-get 'tags result))) 420 (should (member "IN-PROGRESS" keywords)) 421 (should (member "DONE" keywords)) 422 ;; The axes come from the file's own #+TAGS: lines, not from the code. 423 (should (equal (mapcar #'car axes) '(kind scope impact))) 424 (should (equal (append (alist-get 'impact axes) nil) '("minor" "major"))) 425 (should (equal (append (alist-get 'scope axes) nil) '("core" "app" "web" "ui")))))) 426 427 (ert-deftest rail-test-a-file-without-tags-accepts-any-tag () 428 "A file that declares no #+TAGS: vocabulary accepts any tag. 429 The tool carries no vocabulary of its own, so an undeclared file places 430 no restriction on the tags." 431 (let* ((root (file-name-as-directory (make-temp-file "rail-notags" t))) 432 (file (expand-file-name rail-stream-file-name root)) 433 (org-id-track-globally nil) 434 (create-lockfiles nil)) 435 (unwind-protect 436 (progn 437 (with-temp-file file 438 (insert "#+TITLE: No vocabulary\n" 439 "#+TODO: TODO | DONE\n")) 440 (let* ((cap (rail-tests--call 441 #'rail-tools--capture-handler 442 (list (cons 'root root) 443 (cons 'title "Any tag is fine") 444 (cons 'tags ["anything" "at" "all"])))) 445 (id (alist-get 'id cap))) 446 (should (stringp id)) 447 (should (equal (append (alist-get 'tags cap) nil) 448 '("anything" "at" "all"))))) 449 (dolist (buf (buffer-list)) 450 (when (and (buffer-file-name buf) 451 (string-prefix-p root (buffer-file-name buf))) 452 (with-current-buffer buf (set-buffer-modified-p nil)) 453 (kill-buffer buf))) 454 (delete-directory root t)))) 455 456 ;;; The full path 457 458 (ert-deftest rail-test-the-full-request-path-runs-end-to-end () 459 "One request moves from capture to DONE through every step." 460 (rail-tests--with-stream root 461 (let ((id (rail-tests--capture root "Ship the feature" ["feat" "web"] 462 "Add a widget to the page."))) 463 (rail-tests--call #'rail-tools--check-handler 464 (list (cons 'root root) (cons 'id id) 465 (cons 'action "add") (cons 'item "write the code"))) 466 (rail-tests--call #'rail-tools--set-status-handler 467 (list (cons 'root root) (cons 'id id) 468 (cons 'state "IN-PROGRESS"))) 469 (rail-tests--call #'rail-tools--log-handler 470 (list (cons 'root root) (cons 'id id) 471 (cons 'note "Started the work"))) 472 (rail-tests--call #'rail-tools--check-handler 473 (list (cons 'root root) (cons 'id id) 474 (cons 'action "toggle") 475 (cons 'item "write the code"))) 476 (rail-tests--call #'rail-tools--set-status-handler 477 (list (cons 'root root) (cons 'id id) 478 (cons 'state "TESTED"))) 479 (rail-tests--call #'rail-tools--complete-handler 480 (list (cons 'root root) (cons 'id id) 481 (cons 'commit "0badc0de") (cons 'tests "3 pass") 482 (cons 'model "test-agent"))) 483 (let ((entry (rail-tests--call #'rail-tools--show-handler 484 (list (cons 'root root) (cons 'id id))))) 485 (should (equal (alist-get 'state entry) "DONE")) 486 (should (stringp (alist-get 'closed entry))) 487 (should (string-match-p "commit=0badc0de" (alist-get 'result entry))) 488 ;; The logbook now holds the progress note plus the closing note. 489 (should (equal (length (alist-get 'logbook entry)) 2)) 490 (should (seq-some (lambda (n) (string-match-p "CLOSING NOTE" n)) 491 (alist-get 'logbook entry))) 492 (should (eq (alist-get 'done (aref (alist-get 'checklist entry) 0)) t)) 493 (should (string-match-p "Add a widget" (alist-get 'body entry))))))) 494 495 (provide 'rail-tests) 496 497 ;;; rail-tests.el ends here 498