(     Title:  Tests for otester
       File:  otester-test.fs
   Log File:  otester.log
     Author:  David N. Williams
    License:  Public Domain
    Version:  1.4.3
    Revised:  January 20, 2021
)

[DEFINED] -VERBOSEINCLUDE [IF] -VERBOSEINCLUDE [THEN]  \ vfx

\ Forth host detection, VERBOSE initialization, comment support.
INCLUDE tester-display.fs
REDEFINED-WARNING-OFF
true VERBOSE !

?.FIRST-CR  \ before the first displayed line
?." Host: " host-s ?type ?.cr

\ debugging
[UNDEFINED] \\ [IF]
: \\  ( -- )  -1 parse 2drop BEGIN refill 0= UNTIL ;
[THEN]
[UNDEFINED] .# [IF]
: .#  ( n -- )  cr ." #" . cr ;
[THEN]

decimal
INCLUDE ttester-xf.fs
INCLUDE xtester-errors.fs

#13 BASE !  \ to test otester BASE invariance
INCLUDE otester.fs
INCLUDE otester-errors.fs

: ?.errors  ( -- )
  VERBOSE @
  IF blue-text ." XT-#ERRORS: " normal-text XT-#ERRORS @ . cr
     blue-text ." Unexpected OT-#ERRORS: " normal-text OT-#ERRORS @ .
  THEN ;

T{ BASE @ -> decimal 13 }T  \ test otester BASE invariance
\ BASE is now decimal.

: ={  O{ T{ ;    : =>   O-> -> ;    : }=  }O }T ;

\ debugging
: .#order  ( n -- )  cr 2 .r ." : " get-order .s drops ;

?." Max #wids in search order: " OT-MAX#OSTACK ?. ?.cr

wordlist constant wid1
wordlist constant wid2
wordlist constant wid3

TESTING  drops OT-A= OT-A! OT-A@ OT-A<>
(
Except for DROPS, the otester array words are renamings of generic,
current or former xtester words that have already been tested, and their
tests have been copied here and renamed.  Failure for them would mean a
renaming error.
)
T{ 0 drops       -> }T
T{ 1 2 3 3 drops -> }T
T{ 1 2 3 2 drops -> 1 }T

CREATE []         0 ,
CREATE [0]        1 ,  0 ,
CREATE [10]       1 , 10 ,
CREATE [10,11]    2 , 10 , 11 ,
CREATE [10,1]     2 , 10 ,  1 ,
CREATE [0,11]     2 ,  0 , 11 ,
CREATE [0,1]      2 ,  0 ,  1 ,
CREATE [10,11,12] 3 , 10 , 11 , 12 ,
CREATE [1,11,12]  3 ,  1 , 11 , 12 ,
CREATE [1,1,12]   3 ,  1 ,  1 , 12 ,
CREATE [1,11,2]   3 ,  1 , 11 ,  2 ,

\ OT-A= Returns
\         0 true:  equal size and elements
\        0 false:  sizes unequal
\  index+1 false:  sizes equal, deepest unequal elements at index

\ different length
T{ []    [10,11,12] OT-A= -> 0 false }T
T{ [10]  [10,1]     OT-A= -> 0 false }T
T{ [10]  [10,11,12] OT-A= -> 0 false }T

\ last different at index 0
T{ [0]        [10]      OT-A= -> 1 false }T
T{ [10,1]     [0,1]     OT-A= -> 1 false }T
T{ [10,11,12] [1,11,12] OT-A= -> 1 false }T

\ last different at index 1
T{ [10,1]     [10,11]   OT-A= -> 2 false }T
T{ [10,1]     [0,11]    OT-A= -> 2 false }T
T{ [1,1,12]   [1,11,12] OT-A= -> 2 false }T
T{ [10,11,12] [1,1,12]  OT-A= -> 2 false }T

\ last different at index 2
T{ [1,11,12] [1,11,2] OT-A= -> 3 false }T
T{ [1,1,12]  [1,11,2] OT-A= -> 3 false }T

\ the same
T{ []         []         OT-A= -> 0 true }T
T{ [10]       [10]       OT-A= -> 0 true }T
T{ [10,11,12] [10,11,12] OT-A= -> 0 true }T

T{ []         OT-A@ -> 0 }T
T{ [10]       OT-A@ -> 10 1 }T
T{ [10,11]    OT-A@ -> 11 10 2 }T
T{ [10,11,12] OT-A@ -> 12 11 10 3 }T

create max3array 4 cells allot
T{ 3  2  1 3 max3array OT-A! max3array OT-A@ -> 3  2  1 3 }T
T{   11 10 2 max3array OT-A! max3array OT-A@ -> 11 10 2 }T
T{       0 1 max3array OT-A! max3array OT-A@ -> 0 1 }T
T{         0 max3array OT-A! max3array OT-A@ -> 0 }T
\ array overwrite?
T{ -1 -1 -1 3 max3array OT-A! -> }T
T{     0  0 2 max3array OT-A! -> }T
T{ max3array 2 cells + 2@ -> -1 0 }T

T{ 0 max3array OT-A! max3array @ -> 0 }T
T{ max3array OT-A@ -> 0 }T
\ max3array has zero elements
T{ 2 1 max3array OT-A<> -> -1 }T \ unequal num
T{   0 max3array OT-A<> ->  0 }T \ equal num

T{ 3 2 1 3 max3array OT-A!
   max3array @ 
   max3array cell+ @ max3array 2 cells + @ max3array 3 cells + @
     -> 3 1 2 3 }T
T{ max3array OT-A@ -> 3 2 1 3 }T
T{ 3 2 1 3 max3array OT-A<> -> 0 }T  \ equal array
T{       0 max3array OT-A<> -> -1 }T \ unequal num
T{     1 1 max3array OT-A<> -> -1 }T \ unequal num
T{ 3 2 3 3 max3array OT-A<> -> 1 }T  \ unequal elem
T{ 4 2 1 3 max3array OT-A<> -> 3 }T  \ unequal elem

TESTING  O{ O-> }O

={ get-order => get-order }=
={ also => also }=

\ helpers
[UNDEFINED] >ORDER [IF]
: >ORDER  ( wid -- ) ( o: -- wid )  >r get-order r> swap 1+ set-order ;
[THEN]
[UNDEFINED] ORDER> [IF]
: ORDER>  ( o: wid -- ) ( -- wid )  get-order swap >r 1- set-order r> ;
[THEN]

\ Test >ORDER and ORDER> helpers.
T{ get-order wid1 >order previous -> get-order }T
T{ wid1 >order get-order          -> previous get-order 1+ wid1 swap }T
T{ get-order wid1 >order order>   -> get-order wid1 }T
T{ wid1 >order get-order order> >order -> get-order previous }T

TESTING  initial order clobber exceptions
(
Uncomment one of the ={ ... => ... }= lines to see the ABORT"
exception message.
)

also
\ results underflow start order
\ ={ previous => }=
T{ O{ previous ' O-> CATCH -> -2 }T

\ goals underflow start order
\ ={ => previous }=
T{ O{ O-> previous ' }O CATCH -> -2 }T

\ results clobber start order
\ ={ previous wid1 >order wid2 >order => wid2 >order }=
T{ O{ previous wid1 >order wid2 >order ' O-> CATCH -> -2 }T

\ goals clobber start order
\ ={ wid1 >order => previous wid2 >order wid1 >order }=
T{ O{ wid1 >order O-> previous wid2 >order wid1 >order ' }O CATCH -> -2 }T
previous

VERBOSE @ [IF]
ot-#errors @

TESTING  error reporting

?." Inspect the error lines:

\ different num results and goals
={ wid1 >order => }=
T{ OT-ERROR-INDEX @ -> 0 }T
={ => wid1 >order }=
T{ OT-ERROR-INDEX @ -> 0 }T

\ same num but results and goals disagree, deepest is leftward
={ wid1 >order wid3 >order => wid2 >order wid3 >order }=
T{ OT-ERROR-INDEX @ -> 2 }T
={ wid1 >order wid2 >order => wid1 >order wid3 >order }=
T{ OT-ERROR-INDEX @ -> 1 }T
\ deepest error should be red
={ wid1 >order wid2 >order => wid2 >order wid1 >order }=
T{ OT-ERROR-INDEX @ -> 2 }T

ot-#errors !
[THEN]

={ wid1 >order previous => }=
={ get-order wid1 >order order> => get-order wid1 }=
={ get-order wid1               => get-order wid1 >order order> }=
={ wid1 >order get-order order> >order
     => wid1 >order get-order }=

: >o:    ( wid <"name"> -- )  create ,
  DOES>  ( o: -- wid )        @ >order ;

wid1 >o: wid1>o
wid2 >o: wid2>o
wid3 >o: wid3>o

\ helpers
[UNDEFINED] ORDER@ [IF]
: ORDER@  ( o: wid -- wid ) ( -- wid )   get-order over >r drops r> ;
[THEN]
[UNDEFINED] ORDER! [IF]
: ORDER!  ( wid -- ) ( o: wid' -- wid )  previous >order ;
[THEN]

\ Test ORDER@ and ORDER! helpers.
T{ get-order order@        -> get-order over }T
T{ wid1>o order@ previous  -> wid1 }T
T{ get-order wid1>o wid2 order! get-order previous
     -> get-order wid2>o get-order previous }T

={ wid1>o => wid1 >order }=
={ wid2>o => wid2 >order }=

={ wid1>o order@ previous => wid1 }=
={ wid1>o wid2 order!     => wid2>o }=

\ preservation of start order
wid3>o get-order
={ wid1>o => wid1>o }=
ot-initials OT-A!
T{ get-order -> ot-initials OT-A@ }T
previous

?.errors GFORTH-HOST [IF] ?.cr [THEN]