;;;;

(use test)

(use condition-utils)

(define testc (make-exn-condition+ 'test "test" '(test) 'misc '(extra test 23)))
(define testc? (make-condition-predicate exn misc extra))

(test-assert "composite of exn test extra" (testc? testc))
(test "test property of extra component of (exn test extra)" 23 ((condition-property-accessor 'extra 'test) testc))

(define testc-extra-test (make-condition-property-accessor extra test))
(define testc-extra-foo (make-condition-property-accessor extra foo 'foobar))

(test 23 (testc-extra-test testc))
(test 'foobar (testc-extra-foo testc))

(define testcc)
(let ((chn (get-call-chain 1)))
  (set! testcc (make-exn-condition+ 'test "test" '(test) chn 'misc '(extra test 23))) )
(test-assert "composite of exn test extra (set!)" (testc? testcc))

(define wr-exn-res
  "\nError: (test) test: test\n    +: misc:\n    +: extra: (test 23)\n")
(test "may fail - order an issue" wr-exn-res
  (with-output-to-string (lambda () (write-exn-condition testc))))

(use standard-conditions)

(test-assert (exn-condition? testc))
(test 'test (exn-location testc))
(test "test" (exn-message testc))
(test '(test) (exn-arguments testc))
(test #f (exn-call-chain testc))

(use http-client-conditions)
(use intarweb-conditions)

(define thttpc (make-exn-condition+ 'test "test" '(test) 'http '(extra test 23)))
(test-assert (http-condition? thttpc))

(define irr-res
  '((arguments (test)) (message "test") (location test) (test 23)))
(test irr-res (condition-irritants thttpc))

(print)
(print "Writing exn condition")
(print "---------------------")
(write-exn-condition testcc)
(print)

(test-exit)