(      Title:  A utility for testing Forth
               data and floating-point stack effects
        File:  xftester.fs
   Test file:  xftester-test.fs
    Log file:  xftester.log
     License:  John Hayes, Public Domain
     Version:  1.4.3
     Revised:  January 18, 2021

For any code derived from John Hayes' tester program:
)
\  (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
\  MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
(
The rest is public domain.

This file is a driver which loads xtester.fs and ftester.fs.  Except for
the omission of the fp comparison words ABS-NEAR, REL-NEAR, SET-EXACT,
and SET-NEAR, and the private words that support them, it is functionally
equivalent to ttester-xf.fs, which basically copies the text of the two
files instead of loading them.  The code is a revision of that of
ttester, a utility for testing Forth words based on the Hayes tester, as
developed by several authors.  See the file ttester-xf.fs, or the files
xtester.fs and ftester.fs, for history and explanatory material.

These words are currently declared to be the xftester user interface:

PUBLIC INTERFACE WORDS

   tests:  T{  ->  }T  VERBOSE  TESTING  HAS-FLOATING
           X{  X->  }X  F{  F->  }F
           FT-ABS-TOLERANCE  FT-REL-TOLERANCE  FT-AREL-TOLERANCE
           SET-FT-MODE-EXACT  SET-FT-MODE-ABS
           SET-FT-MODE-REL  SET-FT-MODE-AREL  SET-FT-MODE-REL0

  config:  MAX-XT-INITIALS  MAX-XT-RESULTS
           MAX-FT-INITIALS  MAX-FT-RESULTS

PUBLIC AUXILIARY WORDS

   tests:  FT-TEST=-XT
           FT-DATUM=  FT-ABS=  FT-REL=  FT-AREL=  FT-REL0=

  errors:  XT-ERROR-XT  XT-ERROR-DEFAULT  XT-ERROR-INDEX
           FT-ERROR-XT  FT-ERROR-DEFAULT  FT-ERROR-INDEX

  arrays:  XT-INITIALS  XT-RESULTS  XT-GOALS
           FT-INITIALS  FT-RESULTS  FT-GOALS
           XT-A@  XT-A!  XT-A=
           FT-A@  FT-A!  FT-A=
)

S" xtester.fs" INCLUDED

\ From Bruce McFarling and others in c.l.f.:
s" [UNDEFINED]" pad c! pad char+ pad c@ move 
pad find nip 0=
[IF]
: [UNDEFINED]  ( "name" -- flag )
(
Leave true if name is not in the search order, else leave false.
)
  bl word find nip 0= ; immediate
[THEN]

[UNDEFINED] F+ 0= CONSTANT HAS-FLOATING

HAS-FLOATING [IF]
S" ftester.fs" INCLUDED
[THEN]

\ Set the following flag to TRUE for more verbose output; this may
\ allow you to tell which test caused your system to hang.

[UNDEFINED] VERBOSE [IF] VARIABLE VERBOSE FALSE VERBOSE ! [THEN]

: TESTING	\ ( -- ) TALKING COMMENT.
  SOURCE VERBOSE @
  IF DUP >R TYPE CR R> >IN !
  ELSE >IN ! DROP
  THEN ;

\ In the following specifications, references to the fp stack apply when
\ HAS-FLOATING is true.

: T{  ( xfinitials -- )
(
Save the data and fp stack xfinitials for restoration by }T.  Clear
xfresults and xfgoals storage.
)
  X{ [ HAS-FLOATING ] [IF] F{ [THEN] ;

: ->  ( xfresults -- )
(
Record the depth and contents of the data and fp stacks.
)
  X-> [ HAS-FLOATING ] [IF] F-> [THEN] ;

: }T  ( xfgoals -- xfinitials )
(
Save the data and fp stack xfgoals, compare them with the saved
xfresults, and restore the xfinitials.
)
  }X [ HAS-FLOATING ] [IF] }F [THEN] ;

\ END of xftester.fs