module aux_tests.
  accumulate test_helpers, classicjava_aux.
  import set_equals.

  local direct_subclass_test int -> string -> string -> o.
  local not_direct_subclass_test int -> string -> string -> o.
  local subtypeof_test int ->  string -> string -> o.
  local not_subtypeof_test int ->  string -> string -> o.
  local fieldsof_test int -> string -> (list fielddecl) -> o.
  local example (list declaration) -> o.

  %% adapters from test_helpers.
  check_exists 1 J :- direct_subclass_test J _ _.
  check_exists 2 J :- not_direct_subclass_test J _ _.
  check_exists 3 J :- subtypeof_test J _ _.
  check_exists 4 J :- not_subtypeof_test J _ _.
  check_exists 5 J :- fieldsof_test J _ _.
  check 1 J :- direct_subclass_test J Sub Sup, example CT,
               direct_subclass CT Sub Sup.
  check 2 J :- not_direct_subclass_test J Sub Sup, example CT,
               not (direct_subclass CT Sub Sup).
  check 3 J :- subtypeof_test J Sub Sup, example CT,
               subtypeof CT Sub Sup.
  check 4 J :- not_subtypeof_test J Sub Sup, example CT,
               not (subtypeof CT Sub Sup).
  check 5 J :- fieldsof_test J C Fs, example CT, fieldsof CT C Fs',
               set_equals Fs Fs'.

  % example declarations for use in testing
  example (
    (class "ColoredStack" "Stack" ((field (cn "Color") "color") :: nil) nil) ::
    (class "Stack" "Object" ((field (cn "List") "elems") :: 
                             (field (cn "Number") "size") :: nil) nil) ::
    (class "CachedStack" "Stack" ((field (cn "Object") "cache") :: nil) nil) ::
    (class "E" "D" ((field (cn "Object") "fe1") :: 
                    (field (cn "Object") "fe2") :: nil) nil) ::
    (class "B" "A" ((field (cn "Object") "fb1") :: 
                    (field (cn "Object") "fb2") :: nil) nil) ::
    (class "C" "B" ((field (cn "Object") "fc1") :: 
                    (field (cn "Object") "fc2") :: nil) nil) ::
    (class "D" "C" ((field (cn "Object") "fd1") :: 
                    (field (cn "Object") "fd2") :: nil) nil) ::
    (class "A" "Object" ((field (cn "Object") "fa1") :: 
                         (field (cn "Object") "fa2") :: nil) nil) ::
    nil).

  % direct_subclass examples that succeed
  direct_subclass_test 1 "Stack" "Object".
  direct_subclass_test 2 "ColoredStack" "Stack".
  direct_subclass_test 3 "CachedStack" "Stack".
  direct_subclass_test 4 "B" "A".
  direct_subclass_test 5 "C" "B".
  direct_subclass_test 6 "D" "C".
  direct_subclass_test 7 "E" "D".

  % direct_subclass examples that should fail (so their negation succeeds).
  not_direct_subclass_test 1 "Object" "Object".
  not_direct_subclass_test 2 "CachedStack" "ColoredStack".
  not_direct_subclass_test 3 "ColoredStack" "CachedStack".
  not_direct_subclass_test 4 "Stack" "CachedStack".
  not_direct_subclass_test 5 "Stack" "A".
  not_direct_subclass_test 6 "A" "B".
  not_direct_subclass_test 7 "C" "A".
  not_direct_subclass_test 8 "D" "A".
  not_direct_subclass_test 9 "E" "A".

  % subtypeof examples that succeed
  subtypeof_test J X Y :- J < 8, !, direct_subclass_test J X Y.
  subtypeof_test 8 "Object" "Object".
  subtypeof_test 9 "ColoredStack" "Object".
  subtypeof_test 10 "A" "A".
  subtypeof_test 11 "C" "A".
  subtypeof_test 12 "D" "A".
  subtypeof_test 13 "E" "A".

  % subtypeof examples that should fail (so their negation succeeds).
  not_subtypeof_test 1 "CachedStack" "ColoredStack".
  not_subtypeof_test 2 "ColoredStack" "CachedStack".
  not_subtypeof_test 3 "A" "B".
  not_subtypeof_test 4 "A" "C".
  not_subtypeof_test 5 "A" "D".
  not_subtypeof_test 6 "A" "E".

  %               class name     expected answer
  fieldsof_test 1 "Object"       nil.
  fieldsof_test 2 "ColoredStack" ((field (cn "Color") "color")::
                                  (field (cn "List") "elems")::
                                  (field (cn "Number") "size")::
                                  nil).
  fieldsof_test 3 "Stack"        ((field (cn "List") "elems")::
                                  (field (cn "Number") "size")::
                                  nil).
  fieldsof_test 4 "CachedStack"  ((field (cn "Object") "cache")::
                                  (field (cn "List") "elems")::
                                  (field (cn "Number") "size")::
                                  nil).
  fieldsof_test 5 "E"            ((field (cn "Object") "fe1")::
                                  (field (cn "Object") "fe2")::
                                  (field (cn "Object") "fd1")::
                                  (field (cn "Object") "fd2")::
                                  (field (cn "Object") "fc1")::
                                  (field (cn "Object") "fc2")::
                                  (field (cn "Object") "fb1")::
                                  (field (cn "Object") "fb2")::
                                  (field (cn "Object") "fa1")::
                                  (field (cn "Object") "fa2")::
                                  nil).
  fieldsof_test 6 "C"            ((field (cn "Object") "fc1")::
                                  (field (cn "Object") "fc2")::
                                  (field (cn "Object") "fb1")::
                                  (field (cn "Object") "fb2")::
                                  (field (cn "Object") "fa1")::
                                  (field (cn "Object") "fa2")::
                                  nil).
  fieldsof_test 7 "A"            ((field (cn "Object") "fa1")::
                                  (field (cn "Object") "fa2")::
                                  nil).
end
