flesh/snippets/userlib-tests.f

#!/bin/flesh

;; Flesh: Flexible Shell
;; Copyright (C) 2021 Ava Affine
;;
;; 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 <http://www.gnu.org/licenses/>.

;; USERLIB-TESTS
;; this file implements unit tests for handwritten userlib functions

(def passed 
"prints if a test has passed"
  (test)
  (echo (concat "PASSED: " test)))

(def failed 
"prints if a test has failed"
  (test)
  (let (())
    (echo (concat "FAILED: " test))
    (exit 1)))

(def test-cases "all test cases"
  (("set updates var"
     (quote
       (let ((test-val 0))
         (set (q test-val) 3)
         (eq? test-val 3))))

   ("prepend prepends to list"
     (quote
       (let ((list (2 3 4))
             (list (prepend 1 list))
             (list-head (pop list)))
         (eq? (car list-head) 1))))

   ("map applies function across list"
     (quote
       (let ((list (1 2 3))
             (adder (lambda (x) (add 1 x))))
         (eq? (map adder list) (2 3 4)))))

   ("reduce function adds numbers"
     (quote
       (let ((list (1 2 3))
             (adder (lambda (x y) (add x y))))
         (eq? (reduce adder list) (add 1 2 3)))))

   ("cond evaluates the first branch that returns true"
     (quote
       (let ((switch-one false)
             (switch-two false)
	     (switch-three false))
         (cond (q
             ((false (toggle switch-one))
              (true (toggle switch-two))
	      (true (toggle switch-three)))))
	 (and (not switch-one) switch-two (not switch-three)))))

   ("cond doesnt do anything if all the branches are false"
     (quote
      (let ((switch-one false)
            (switch-two false)
	    (switch-three false))
       (cond (q
           ((false (toggle switch-one))
	    (false (toggle switch-two))
	    (false (toggle switch-three)))))
       (and (not switch-one) (not switch-two) (not switch-three)))))

   ("cond returns the result of the branch that is evaluated"
	  (quote
	   (let ((variable "2"))
	     (set (q variable)
		  (cond (q
			 ((true "1")))))
	     (eq? variable "1"))))

   ("cond does not choke on nil evaluated result"
	  (quote
        (cdr ((cond (q ((true (assert true)))))
              true))))

   ("contains? finds elem in list"
     (quote
       (contains? (1 2 3) 1)))

   ("contains? finds last elem in list"
     (quote
       (contains? (1 2 3) 3)))

   ("contains? doesnt find elem not in list"
     (quote
       (not (contains? (1 2 3) 4))))

   ("get-paths properly splits path into segments"
     (quote
       (let ((PATH "/seg1:/seg2")
             (split-path (get-paths)))
         (and (eq? (len split-path) 2)
              (contains? split-path "/seg1")
              (contains? split-path "/seg2")))))

   ("add-path properly adds a new path segment to PATH"
     (quote
       (let ((PATH "/seg1:/seg2")
             (new-path "/seg3"))
         (add-path new-path)
         (contains? (get-paths) new-path))))

    ("join operates as expected"
      (quote
        (let ((l ("1" 2 (3))))
          (eq? (join l ".")
               "1.2.(3)"))))

    ("extend extends sets"
      (quote
        (let ((s1 (1 2 3))
              (s2 (4 5 6)))
          (eq? (extend s1 s2)
               (1 2 3 4 5 6)))))

     ;; add more test cases here
   ))

;; run all test cases, print output
(let ((test-iter (pop test-cases)))
  (while (gt? (len test-iter) 1)
    (let ((test (car test-iter))
          (remaining (cdr test-iter))
          (test-name (car test))
          (test-body (cdr test)))
    (if (eval test-body)
      (passed test-name)
      (failed test-name))
    (set (q test-iter) (pop remaining)))))