;; -*- lisp -*-

;;;; # Test suite for Quiz #2 #

;;;; To run the test suite just load this file and then execute
;;;; (5am:run! :quiz2)

(asdf:oos 'asdf:load-op :fiveam)

(defpackage :quiz2.test
  (:use :common-lisp
        :arnesi
        :5am))

(in-package :quiz2.test)

;;;; ## Infrastructure code ##

;;;; This serves to generate a random form and then print it according
;;;; to our "whitespace rules". We test the solution by ensuring that
;;;; reading what we print returns an object equal to the original.

(defun gen-symbol ()
  (whichever 'a 'b 'c 'd))

(defun gen-toplevel (&optional (depth 4))
  (whichever
   `(defun ,(gen-symbol) ,(loop repeat (random 4) collect (gen-symbol))
      ,@(gen-body depth))
   `(defstruct ,(gen-symbol)
      ,@(loop repeat (random 6) collect (gen-symbol)))
   `(defpackage ,(gen-symbol)
      (:use ,@(loop repeat (random 4) collect (whichever :common-lisp :quiz :my-package :your-package :our-package)))
      (:export ,@(loop repeat (random 4) collect (gensym (random-string 12 +lower-case-ascii-alphabet+)))))))

(defun gen-body (depth)
  (loop
     repeat (random 5)
     collect (gen-a-form depth)))

(defun gen-a-form (depth)
  (if (zerop depth)
      (gen-symbol)
      (let ((depth (1- depth)))
        (whichever
         `(if ,(gen-a-form depth)
              ,(gen-a-form depth)
              ,(gen-a-form depth))
         `(let ,(loop
                   repeat (random 5)
                   collect (list (gen-symbol) (gen-a-form depth)))
            ,@(gen-body depth))
         `(when ,(gen-a-form depth)
            ,@(gen-body depth))
         (gen-symbol)))))

(defun print-off-sides (forms &optional (stream t))
  (labels ((pap (code indent-level)
             (format stream "~vT" indent-level)
             (labels ((depth (tree)
                        (if (atom tree)
                            0
                            (1+ (reduce #'max (mapcar #'depth tree))))))
               (cond
                 ((and (consp code)
                       (<= (depth code) 1)
                       (<= (length code) 4))
                  (format stream "~S~%" code))
                 ((and (consp code)
                       (symbolp (car code)))
                  (loop
                     initially (format stream "~A~%" (car code))
                     for arg in (cdr code)
                     do (pap arg (+ indent-level 2))))
                 ((consp code)
                  (dolist (nested code)
                    (pap nested (+ indent-level 2))))
                 (t
                  (format stream "~A~%" code))))))
    (dolist* ((op &body body) forms)
      (format stream "~A~%" op)
      (dolist (form body)
        (pap form 2)))))

;;;; ## The actual test suite ##

(in-suite nil)

(test :quiz2
  (for-all ((form1 (lambda () (gen-toplevel)))
            (form2 (lambda () (gen-toplevel))))
    (let ((*readtable* (copy-readtable nil nil)))
      (set-dispatch-macro-character #\# #\! #'quiz2::read-off-side)
      (macrolet ((with-form-as-text ((var form) &body body)
                   `(let ((,var (with-output-to-string (text)
                                  (write-line "#!" text)
                                  (print-off-sides ,form text)
                                  (write-line "!#" text))))
                      ,@body)))
        (let ((result `(progn ,form1)))
          (with-form-as-text (text (list form1))
            (is (equal (read-from-string text) result))))
        (let ((result `(progn ,form1 ,form2)))
          (with-form-as-text (text (list form1 form2))
            (is (equal (read-from-string text) result))))))))