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

(deftest guard->type-specifier->guard
  (collect-mismatches
    #'samep
    #'identity
    (lambda (guard)
      (type-specifier-to-guard (guard-to-type-specifier guard)))
    (list (e-lambda "$typeSpecifierTest" ())))
  nil)

(deftest type-specifier->guard->type-specifier
  (collect-mismatches
    #'equal
    #'identity
    (lambda (ts)
      (guard-to-type-specifier (type-specifier-to-guard ts)))
    '((integer -10 10)))
  nil)

(deftest shorten-guard
  (guard-to-type-specifier
    (make-instance 'e.elib::resolved-ref :target
      (type-specifier-to-guard 'integer)))
  integer)

(defmacro define-type-specifier-print-test (name type-specifier text)
  `(deftest ,name
     (e-print (type-specifier-to-guard ,type-specifier))
     ,text))

(define-type-specifier-print-test type-print.class
  (find-class 'integer) "int")

(define-type-specifier-print-test type-print.uncustomized
  'readtable "Readtable")

(define-type-specifier-print-test type-print.and.0
  '(and) "all[]")

(define-type-specifier-print-test type-print.and.1
  '(and integer) "all[int]")

(define-type-specifier-print-test type-print.and.2
  '(and integer number) "all[int, Number]")

(define-type-specifier-print-test type-print.or.0
  '(or) "any[]")

(define-type-specifier-print-test type-print.or.1
  '(or integer) "any[int]")

(define-type-specifier-print-test type-print.or.2
  '(or integer string) "any[int, String]")

(define-type-specifier-print-test type-print.float64
  'float64 "float64")

(define-type-specifier-print-test type-print.vector.t
  '(vector t) "ConstList")

(define-type-specifier-print-test type-print.vector.t.length
  '(vector t 10) "ConstList[any, 10]")

(define-type-specifier-print-test type-print.vector.*.length
  '(vector * 10) "ConstList[any, 10]")

(define-type-specifier-print-test type-print.vector.specialized
  '(vector bit) "ConstList[Bit]")

(define-type-specifier-print-test type-print.vector.specialized.length
  '(vector bit 10) "ConstList[Bit, 10]")

(define-type-specifier-print-test type-print.vector.upgrade
  '(vector readtable) "ConstList")

(define-type-specifier-print-test type-print.vector.upgrade.length
  '(vector readtable 10) "ConstList[any, 10]")

(define-type-specifier-print-test type-print.vector.character
  ;; E code should never actually see this...
  '(vector character) "ConstList[char]")

(deftest observable-type-of-ref
  (observable-type-of (make-instance 'e.elib::resolved-ref :target 1))
  integer)

(deftest string-error.ok
  (typep (make-condition 'simple-error :format-control "hello world"
                                       :format-arguments '())
         'e.elib::string-error)
  t)

(deftest string-error.simple-not-string
  (typep (make-condition 'simple-error :format-control (formatter "foo")
                                       :format-arguments '())
         'e.elib::string-error)
  nil)

(deftest string-error.simple-extra-args
  (typep (make-condition 'simple-error :format-control ""
                                       :format-arguments '(junk))
         'e.elib::string-error)
  nil)

(deftest string-error.simple-formatty
  (typep (make-condition 'simple-error :format-control "~A"
                                       :format-arguments '(junk))
         'e.elib::string-error)
  nil)

(deftest string-error.not-simple
  (typep (make-condition 'program-error)
         'e.elib::string-error)
  nil)

(deftest string-error.not-error
  (typep (make-condition 'simple-condition)
         'e.elib::string-error)
  nil)

(deftest string-error.uncall-other-simple-error
  ;; because the uncall for string-errors is defined in the vtable for simple-errors
  (e. (make-condition 'simple-error :format-control "~A"
                                    :format-arguments '(junk))
      |__optUncall|)
  nil)