; Copyright 2005-2007 Kevin Reid, under the terms of the MIT X license
; found at http://www.opensource.org/licenses/mit-license.html ................

(defclass for-test () ())

(defmacro with-temporary-vat (&body body)
  `(block with-temporary-vat-block
     (with-vat (:label "with-temporary-vat")
       (return-from with-temporary-vat-block ,@body))))

(deftest unexternalizable-optimization.no
  (macrolet ((x (&environment e) (unexternalizable-optimization-p e)))
    (x))
  nil)

(deftest unexternalizable-optimization.yes
  (macrolet ((x (&environment e) (unexternalizable-optimization-p e)))
    (with-unexternalizable-optimization (x)))
  t)

(deftest vtable-prefix-enough
  (princ-to-string (nth-value 1 (ignore-errors
    (eval `(def-vtable for-test
             (:|run| ()
               :hi))))))
  "Method \"run\" has 0 parameters, which is not enough to accept 1 prefix argument.")

(deftest smethod.shows-types.quote
  (with-temporary-vat
    (e-print (e. (e. (e. (efun ((x 'string) y) (list x y)) |__getAllegedType|) |getMessageTypes|) |get| "run/2")))
  "to run(x :String, y)")

(deftest smethod.shows-types.global
  (with-temporary-vat
    (e-print (e. (e. (e. (efun ((x +the-void-guard+) y) (list x y)) |__getAllegedType|) |getMessageTypes|) |get| "run/2")))
  "to run(x :void, y)")

(deftest smethod.coerces
  (efuncall (efun ((x 'string)) x)
            (e-lambda nil ()
              (:|__conformTo| (guard) (declare (ignore guard)) "hi")))
  "hi")

(deftest boolean-print-readably-package
  (with-output-to-string (*standard-output*)
    (with-standard-io-syntax
      (dolist (*print-readably* '(nil t))
        (dolist (*read-eval* '(nil t))
          (terpri)
          (dolist (*package* '(#.*package* #.(find-package :keyword)))
            (dolist (b (list +e-true+ +e-false+))
              (princ " ")
              (handler-case
                (prin1 b)
                (print-not-readable (c) (prin1 ':NR)))))))))
  "
 #.+E-TRUE+ #.+E-FALSE+ #.E.ELIB:+E-TRUE+ #.E.ELIB:+E-FALSE+
 #.+E-TRUE+ #.+E-FALSE+ #.E.ELIB:+E-TRUE+ #.E.ELIB:+E-FALSE+
 :NR :NR :NR :NR
 #.+E-TRUE+ #.+E-FALSE+ #.E.ELIB:+E-TRUE+ #.E.ELIB:+E-FALSE+")

(deftest cl-print-var-slot
  (with-standard-io-syntax
    (write-to-string (make-instance 'e-var-slot :value 1) :readably nil))
  "#<var & 1>")