#lang scheme
(require tests/eli-tester
         "sstruct.ss")

(test
 (local [(define-sstruct a ())]
   (test 
    ; Constructors exist
    (a)
    ; Predicates exist
    (a? (a))
    ; Match works
    (match (a)
      [(a)
       #t])
    =>
    #t))
 
 (local [(define-sstruct a ())
         (define-sstruct (b struct:a) ())]
   (test 
    ; Super types work
    (a? (b))
    ; in match too
    (match (b)
      [(a)
       #t])
    =>
    #t))
 
 ; You can override the constructor
 (local [(define-sstruct a ()
           #:constructor make-a)]
   (test
    (a? (make-a))
    ; And match still works
    (match (make-a)
      [(make-a)
       #t])
    =>
    #t))
 
 ; You can override the predicate
 (local [(define-sstruct a ()
           #:predicate an-a?)]
   (test
    a? =error> "unbound"
    (an-a? (a))
    ; Match still works
    (match (a)
      [(a)
       #t])
    =>
    #t))
 
 ; XXX #:super
 ; XXX #:inspector
 ; XXX #:transparent
 ; XXX #:guard
 ; XXX #:property
 ; XXX #:prefab
 
 (local [(define-sstruct a ()
           #:omit-define-syntaxes)]
   (test
    (match (a)
      [(a) #t])
    =error>
    "xxx"))
 
 ; XXX test for fields and overriding names
 (local [(define-sstruct a ()
           #:omit-define-values)]
   (test
    a? =error> "unbound"
    a =error> "unbound"
    ; XXX Is this the right way to see if the syntax is bound?
    (syntax-local-value #'a)))
 
 (local [(define-sstruct a (x))]
   (test (a-x (a 5)) => 5
         (match (a 5)
           [(a x) x])
         => 5))
 
 (local [(define-sstruct a ([x #:mutable]))
         (define an-a (a 5))]
   (test (a-x an-a) => 5
         (set-a-x! an-a 6) => (void)
         (a-x an-a) => 6))
 
 (local [(define-sstruct a (x)
           #:mutable)
         (define an-a (a 5))]
   (test (a-x an-a) => 5
         (set-a-x! an-a 6) => (void)
         (a-x an-a) => 6))
 
 (local [(define-sstruct a ([x #:accessor gimme-the-x]))]
   (test (gimme-the-x (a 5)) => 5
         (match (a 5)
           [(a x) x]) 
         => 5
         a-x =error> "unbound"))
 
 (define-sstruct a ([x #:mutator set-the-x!])) =error> "not mutable"
 
 ; XXX why should this be an error?
 (define-sstruct a ([x #:mutable]) #:mutable) =error> "struct is mutable"
 
 (local [(define-sstruct a ([x #:mutable
                               #:mutator set-the-x!]))
         (define an-a (a 5))]
   (test (a-x an-a) => 5
         set-a-x! =error> "unbound"
         (set-the-x! an-a 6) => (void)
         (a-x an-a) => 6))
 
 (local [(define-sstruct a ([x #:mutator set-the-x!])
           #:mutable)
         (define an-a (a 5))]
   (test (a-x an-a) => 5
         set-a-x! =error> "unbound"
         (set-the-x! an-a 6) => (void)
         (a-x an-a) => 6))
 
 (local [(define-sstruct a (#:x x))]
   (test (a 5) =error> "#:x"
         (a #:x 5)
         (a-x (a #:x 5)) => 5
         (match (a #:x 5)
           [(a #:x x) x])
         =>
         5))
 
 (define-sstruct a (#:x x #:x y)) =error> "duplicate keyword"
 
 (local [(define-sstruct a (#:x y))]
   (test (a 5) =error> "#:x"
         (a #:x 5)
         (a-y (a #:x 5)) => 5
         (match (a #:x 5)
           [(a #:x x) x])
         =>
         5))
 
 (local [(define-sstruct a (#:x [x #:accessor gimme-the-x]))]
   (test (a 5) =error> "#:x"
         (a #:x 5)
         (gimme-the-x (a #:x 5)) => 5
         (match (a #:x 5)
           [(a #:x x) x])
         =>
         5))
 
 (local [(define-sstruct a (#:x x y))]
   (test (a 5) =error> "#:x"
         (a #:x 5 6)
         (a 6 #:x 5)
         (a-x (a 6 #:x 5)) => 5
         (a-y (a #:x 5 6)) => 6
         (match (a 6 #:x 5)
           [(a #:x x y) (values x y)])
         =>
         (values 5 6)
         (match (a 6 #:x 5)
           [(a y #:x x) (values x y)])
         =>
         (values 5 6)))
 
 (local [(define-sstruct a (#:x [x #:mutable]))
         (define an-a (a #:x 5))]
   (test (a-x an-a) => 5
         (set-a-x! an-a 6) => (void)
         (a-x an-a) => 6))
 
 (local [(define-sstruct a (#:x [x #:mutable
                                   #:mutator set-the-x!]))
         (define an-a (a #:x 5))]
   (test (a-x an-a) => 5
         (set-the-x! an-a 6) => (void)
         (a-x an-a) => 6))
 
 (local [(define-sstruct a ([x 7]))]
   (test (a)
         (a-x (a)) => 7
         (a-x (a 5)) => 5))
 
 (local [(define-sstruct a (y [x (add1 y)]))]
   (test (a 1)
         (a-x (a 1)) => 2
         (a-x (a 5)) => 6))
 
 (local [(define-sstruct a (#:x x))]
   (test (with-output-to-string (λ () (printf "~S" (a #:x 5))))
         =>
         "(a #:x 5)"))
 
 (local [(define-sstruct parent (x))
         (define-sstruct (child struct:parent) (x))]
   (test (parent-x (child 1 2)) => 1
         (child-x (child 1 2)) => 2))
 
 (local [(define-sstruct parent (#:x x))
         (define-sstruct (child struct:parent) (#:x x))]
   #t)
 =error>
 "duplicate keyword"
 
 (local [(define-sstruct parent (#:x x))
         (define-sstruct (child struct:parent) (#:y x))]
   (test (parent-x (child #:x 5 #:y 6)) => 5
         (child-x (child #:x 5 #:y 6)) => 6))
 
 (local [(define-sstruct parent (x #:y y z))
         (define-sstruct (child struct:parent) (a b #:c c))
         (define child->vector
           (match-lambda
             [(child x #:y y z a b #:c c)
              (vector x y z a b c)]))]
   (test (child->vector (child 1 #:y 2 3 4 5 #:c 6))
         => (vector 1 2 3 4 5 6)
         (child->vector (child 1 3 4 #:y 2 5 #:c 6))
         => (vector 1 2 3 4 5 6)
         (child->vector (child #:c 6 1 3 4 #:y 2 5))
         => (vector 1 2 3 4 5 6)))
 
 )