#!/bin/sh
exec ${srcdir:-.}/guile-test-env guile -s "$0" "$@"
!#

(define-module (test-suite test-srfi-35)
  #:use-module (itla srfi-35)
  #:use-module (test-suite lib))

(define-condition-type &c &condition
  c?
  (x c-x))

(define-condition-type &c1 &c
  c1?
  (a c1-a))

(define-condition-type &c2 &c
  c2?
  (b c2-b))

(define v1 (make-condition &c1 'x "V1" 'a "a1"))
(define v2 (condition (&c2 (x "V2") (b "b2"))))
; (define v3 (condition (&c1 (x "V3/1") (a "a3"))
;                       (&c2 (b "b3"))))


(with-test-prefix "condition of type &c1"
  (pass-if "supertype predicate" (c? v1))
  (pass-if "predicate" (c1? v1))
  (pass-if "sibling predicate" (not (c2? v1)))
  (pass-if "parent field accessor" (string=? (c-x v1) "V1"))
  (pass-if "field accessor" (string=? (c1-a v1) "a1")))
  

(with-test-prefix "condition of type &c2"
  (pass-if "supertype predicate" (c? v2))
  (pass-if "predicate" (c2? v2))
  (pass-if "sibling predicate" (not (c1? v2)))
  (pass-if "parent field accessor" (string=? (c-x v2) "V2"))
  (pass-if "field accessor" (string=? (c2-b v2) "b2")))

; (with-test-prefix "condition of compound type (&c1 &c2)"
;   (pass-if "supertype predicate" (c? v2))
;   (pass-if "c1 predicate" (c1? v2))
;   (pass-if "c2 predicate" (c2? v2))
;   (pass-if "parent field accessor" (string=? (c-x v2) "V3/1"))
;   (pass-if "c1 field accessor" (string=? (c1-a v2) "a3"))
;   (pass-if "c2 field accessor" (string=? (c2-b v2) "b3")))

; (define v4 (make-compound-condition v1 v2))

; (c? v4)        => #t
; (c1? v4)       => #t
; (c2? v4)       => #t
; (c-x v4)       => "V1"
; (c1-a v4)      => "a1"
; (c2-b v4)      => "b2"

; (define v5 (make-compound-condition v2 v3))

; (c? v5)        => #t
; (c1? v5)       => #t
; (c2? v5)       => #t
; (c-x v5)       => "V2"
; (c1-a v5)      => "a3"
; (c2-b v5)      => "b2"

;; Local Variables:
;; mode: scheme
;; End:

;;; arch-tag: 774c4de9-d9f8-4754-8d40-38912ec7f3a1