;;; IMPLEMENTS: Unit tests for st-conditions.scm
  AUTHOR :  
  DATE : 16 January 2017

;; (require 'st-conditions)

(define zero-divide #f)
(define frob-error  #f)
(define write-to-non-port #f)

;; (define-syntax capture-condition  ;; to explore
;;   (syntax-rules ()
;;     ((capture-condition form)
;;      ;;==>
;;      (call/cc
;;       (lambda (exit)
;;         (with-exception-handler
;;          (lambda (c) (exit c))
;;          (lambda ()  form))))
;; ) ) )

(define (setup-st-conditions)
  (set! zero-divide
        (capture-condition (/ 3 0)))
  (set! frob-error
        (capture-condition
         (error "frob" 'a "bee" #\c 47)))
  (set! write-to-non-port
        (capture-condition (write 3 0)))
)

(define (cleanup-st-conditions)
  (set! zero-divide #f)
  (set! frob-error  #f)
  (set! write-to-non-port #f)
)

(add-test-suite 'st-conditions
                setup-st-conditions
                cleanup-st-conditions)

(add-equivalent-alist-test 'st-conditions
;;(add-equal-test 'st-conditions                           
 '((isMessage . #t)
   (message . "/: zero divisor: 3 0 \n")
   (isWho . #t)
   (isAssertion . #t)
   (who . "/"))
 (dict->alist (condition->dictionary zero-divide))
 "zero-divide condition asDictionary")

(add-equivalent-alist-test 'st-conditions
  '((isMessage . #t)
      (isError . #t)
      (message . "frob")
      (irritants a "bee" #\c 47)
      (isIrritants . #t))
 (dict->alist (condition->dictionary frob-error))
 "Scheme error condition asDictionary")

(add-equivalent-alist-test 'st-conditions
 '((isMessage . #t)
   (isError . #t)
   (message . "not a textual output port")
   (isWho . #t)
   (who . write-char)
   (irritants 0)
   (isIrritants . #t))
 (dict->alist (condition->dictionary write-to-non-port))
 "write-to-non-port condition asDictionary")

;; (ensure-exception-raised 'st-conditions
     ( make - error - string - predicate    " Failed message send : # glerph to " )
;;    (perform: %%test-object 'glerph)
;;    "obj glerph -> doesNotUnderstand")


;;;			--- E O F ---			;;;


 IMPLEMENTS: Unit tests for st-conditions.scm
 (require 'st-conditions)
 (define-syntax capture-condition  ;; to explore
   (syntax-rules ()
     ((capture-condition form)
      ;;==>
      (call/cc
       (lambda (exit)
         (with-exception-handler
          (lambda (c) (exit c))
          (lambda ()  form))))
 ) ) )
(add-equal-test 'st-conditions                           
 (ensure-exception-raised 'st-conditions
    (perform: %%test-object 'glerph)
    "obj glerph -> doesNotUnderstand")
			--- E O F ---			;;;
  AUTHOR :  
  DATE : 16 January 2017


(define zero-divide #f)
(define frob-error  #f)
(define write-to-non-port #f)


(define (setup-st-conditions)
  (set! zero-divide
        (capture-condition (/ 3 0)))
  (set! frob-error
        (capture-condition
         (error "frob" 'a "bee" #\c 47)))
  (set! write-to-non-port
        (capture-condition (write 3 0)))
)

(define (cleanup-st-conditions)
  (set! zero-divide #f)
  (set! frob-error  #f)
  (set! write-to-non-port #f)
)

(add-test-suite 'st-conditions
                setup-st-conditions
                cleanup-st-conditions)

(add-equivalent-alist-test 'st-conditions
 '((isMessage . #t)
   (message . "/: zero divisor: 3 0 \n")
   (isWho . #t)
   (isAssertion . #t)
   (who . "/"))
 (dict->alist (condition->dictionary zero-divide))
 "zero-divide condition asDictionary")

(add-equivalent-alist-test 'st-conditions
  '((isMessage . #t)
      (isError . #t)
      (message . "frob")
      (irritants a "bee" #\c 47)
      (isIrritants . #t))
 (dict->alist (condition->dictionary frob-error))
 "Scheme error condition asDictionary")

(add-equivalent-alist-test 'st-conditions
 '((isMessage . #t)
   (isError . #t)
   (message . "not a textual output port")
   (isWho . #t)
   (who . write-char)
   (irritants 0)
   (isIrritants . #t))
 (dict->alist (condition->dictionary write-to-non-port))
 "write-to-non-port condition asDictionary")

     ( make - error - string - predicate    " Failed message send : # glerph to " )



