(in-package :try-test)

(deftest test-utils ()
  (test-on-values)
  (test-with-retry)
  (test-ensure-rest-arg)
  (test-lambda-list-with-&rest-to-arglist-form))

(deftest test-on-values ()
  (is (equal (multiple-value-list
              (on-values (values 1 "sdf" 3)
                (:truncate t)
                (+ * 1)
                (concatenate 'string * "more")))
             '(2 "sdfmore")))
  (is (equal (multiple-value-list
              (on-values (values 1 "sdf" 3)
                (:truncate t)
                (+ * 1)
                (concatenate 'string * "more")))
             '(2 "sdfmore")))
  (is (equal (multiple-value-list
              (on-values (values 1 "sdf" 3)
                (:truncate nil)
                (+ * 1)
                (concatenate 'string * "more")))
             '(2 "sdfmore" 3)))
  (is (equal (multiple-value-list
              (on-values (values 1 "sdf" 3)
                (+ * 1)
                (concatenate 'string * "more")))
             '(2 "sdfmore" 3)))
  (is (equal (multiple-value-list
              (on-values (values 1 "sdf" 3)
                (:on-length-mismatch #'identity)))
             '(1 "sdf" 3)))
  (is (equal (multiple-value-list
              (on-values (values 1 "sdf" 3)
                (:on-length-mismatch (lambda (values)
                                       (subseq values 0 2)))))
             '(1 "sdf")))
  (signals (error :pred "Options must come first.")
    (eval '(on-values 1
            t
            (:on-length-mismatch #'identity)))))

(deftest test-with-retry ()
  (with-test (with-retry/catch)
    (let ((n 0)
          (m 0))
      (is (eql (try::with-retry/catch (:catch 'retry :on-retry (incf m))
                 (incf n)
                 (when (= n 1)
                   (throw 'retry nil))
                 7)
               7))
      (is (= n 2))
      (is (= m 1)))))

(deftest test-ensure-rest-arg ()
  (is (match-values (try::ensure-rest-arg '() 'r)
        (equal * '(&rest r))
        (eq * 'r)))
  (is (match-values (try::ensure-rest-arg '(x) 'r)
        (equal * '(x &rest r))
        (eq * 'r)))
  (is (match-values (try::ensure-rest-arg '(&rest rest) 'r)
        (equal * '(&rest rest))
        (eq * 'rest)))
  (is (match-values (try::ensure-rest-arg '(x &rest rest) 'r)
        (equal * '(x &rest rest))
        (eq * 'rest)))
  (is (match-values (try::ensure-rest-arg '(&optional (o 0)) 'r)
        (equal * '(&optional (o 0) &rest r))
        (eq * 'r)))
  (is (match-values (try::ensure-rest-arg '(x &optional (o 0)) 'r)
        (equal * '(x &optional (o 0) &rest r))
        (eq * 'r)))
  (is (match-values (try::ensure-rest-arg '(&key (k nil kp)) 'r)
        (equal * '(&rest r &key (k nil kp)))
        (eq * 'r)))
  (is (match-values (try::ensure-rest-arg '(x &key (k nil kp)) 'r)
        (equal * '(x &rest r &key (k nil kp)))
        (eq * 'r)))
  (is (match-values (try::ensure-rest-arg '(x &optional (o 0) &key (k nil kp))
                                          'r)
        (equal * '(x &optional (o 0) &rest r &key (k nil kp)))
        (eq * 'r)))
  (is (match-values (try::ensure-rest-arg '(x &optional (o 0) &aux (a 7)) 'r)
        (equal * '(x &optional (o 0) &rest r &aux (a 7)))
        (eq * 'r)))
  (is (match-values (try::ensure-rest-arg
                     '(x &optional (o 0) &key (k nil kp) &aux (a 7))
                     'r)
        (equal * '(x &optional (o 0) &rest r &key (k nil kp) &aux (a 7)))
        (eq * 'r))))

(deftest test-lambda-list-with-&rest-to-arglist-form ()
  (is (equal (try::lambda-list-with-&rest-to-arglist-form
              '(x &rest r))
             '(append (list x) r)))
  (is (equal (try::lambda-list-with-&rest-to-arglist-form
              '(x &optional (o 0) &rest r))
             '(append (list x o) r)))
  (is (equal (try::lambda-list-with-&rest-to-arglist-form
              '(x &optional (o 0) &rest r &key (k nil kp)))
             '(append (list x o) r))))
