\    Title:  Tests for dstrings utilities
\   Author:  David N. Williams
\  License:  Public Domain
\  Version:  0.8.5
\  Revised:  February 28, 2009
\
\     File:  dstring-utils-test.fs
\ Log file:  dstring-utils.log

\ These are ignored unless the host if pfe.  Set to "true" to
\ load the corresponding pfe module.

  false constant USE-DSTRINGS-EXT
  false constant USE-FPNOSTACK

s" ttester.fs" included  \ gforth cvs revision 1.13 known to work
true VERBOSE !
decimal

0 value #errors
:noname  ( s -- )  #errors 1+ to #errors ERROR1 ; ERROR-XT !

\ Change this to false for terminals without ANSI color modes:
true [IF]  \ ANSI color
\ Borrowed from Krishna Myneni:
: normal-text ( -- ) 27 EMIT [CHAR] [ EMIT [CHAR] 0 EMIT [CHAR] m EMIT ; 
: red-text    ( -- ) 27 EMIT [CHAR] [ EMIT ." 31m" ;
: green-text  ( -- ) 27 EMIT [CHAR] [ EMIT ." 32m" ;
: blue-text   ( -- ) 27 EMIT [CHAR] [ EMIT ." 34m" ;
[ELSE]     \ no color
: normal-text ;
: red-text ;
: green-text ;
: blue-text ;
[THEN]

: COMMENT ( -- )  \ also borrowed from Krisnha Myneni
  blue-text   source >in @ /string
  verbose @ if type cr else 2drop then
  source >in ! drop   normal-text ;

s" FORTH-NAME" environment?
[IF] s" pfe" compare 0= [ELSE] false [THEN]
( pfe?) constant PFE-HOST

s" gforth" environment?
[IF] ( version.s) 2drop true [ELSE] false [THEN]
 ( gforth?) constant GFORTH-HOST
 
PFE-HOST [IF]
  cr comment Test host is pfe.
[THEN]
GFORTH-HOST [IF]
  cr comment Test host is gforth.
[THEN]

PFE-HOST [IF]
  USE-DSTRINGS-EXT [IF] true constant DSTRINGS-EXT [THEN]
  USE-FPNOSTACK    [IF] loadm fpnostack [THEN]
[THEN]
128 constant TRY-MAX-FNUM-DIGS  \ less than default
TRY-MAX-FNUM-DIGS constant MAX-FNUM-DIGS
s" dstring-utils.fs" included
decimal

DSTRINGS-EXT [IF]
  comment Using pfe dstrings module.
[ELSE]
  comment Using dstrings.fs.
[THEN]

s" FLOATING-EXT" environment? [IF] ( flag) drop
  :noname  ( -- fpstack? )  depth >r 1.1E0 depth >r fdrop 2r> <> ;
  execute [IF]
    comment Nonseparate floating point stack.
  [ELSE]
    comment Separate floating point stack.
  [THEN]
[THEN]

[UNDEFINED] \\ [IF]
: \\  ( -- )  -1 parse 2drop BEGIN refill 0= UNTIL ; [THEN]

: s=      ( s1 s2 -- flag )  compare 0= ;
: cat$>s   ( -- s )  ENDCAT $s> ;
: cat=    ( s -- flag ) cat$>s s= ;

s" MAX-U" environment? 0=
[IF] cr .( ***MAX-U query undefined) \\ [THEN]
constant MAX-U

s" MAX-N" environment? 0=
[IF] cr .( ***MAX-N query undefined) \\ [THEN]
constant MAX-N
MAX-N negate constant -MAX-N  \ assuming 2's complement?

TESTING  NUM+ UNUM+ UNUM>HEX+ UNUM0R+ -MON-

\ The iteration test for each cat word checks cat purity.

\ num+  ( n -- )
t{ 0 num+ s" 0" cat= -> true }t
t{ $+" ccc" -5000 num+ s" ccc-5000" cat= -> true }t
t{ MAX-N num+ cat$>s evaluate -> MAX-N }t
t{ $+" ccc" -5000 hex num+ decimal s" ccc-1388" cat= -> true }t
t{ 5 num+ 6 num+ s" 56" cat= -> true }t

\ unum+  ( u -- )
t{ 0 unum+ s" 0" cat= -> true }t
t{ $+" ccc" 5000 unum+ s" ccc5000" cat= -> true }t
t{ MAX-U unum+ cat$>s evaluate -> MAX-U }t
t{ $+" ccc" 5000 hex unum+ decimal s" ccc1388" cat= -> true }t
t{ 123 unum+ 45 num+ s" 12345" cat= -> true }t

\ unum>hex+  ( u -- )
t{ 0 unum>hex+ s" 0x0" cat= -> true }t
t{ $+" ccc" 5000 unum>hex+ s" ccc0x1388" cat= -> true }t
t{ MAX-U unum>hex+ cat$>s 2 /string hex evaluate decimal -> MAX-U }t
hex
t{ 1238 unum>hex+ 0 unum>hex+ s" 0x12380x0" cat= -> true }t
decimal

\ unum0r+  ( u r --  )
t{ 0 1 unum0r+ s" 0"  cat= -> true }t
t{ 0 2 unum0r+ s" 00" cat= -> true }t
t{ $+" ccc" 5000 4 unum0r+ s" ccc5000"    cat= -> true }t
t{ $+" ccc" 5000 2 unum0r+ s" ccc00"      cat= -> true }t
t{ $+" ccc" 5000 7 unum0r+ s" ccc0005000" cat= -> true }t
t{ $+" ccc" 5000 7 hex unum0r+ decimal s" ccc0001388" cat= -> true }t
t{ 12345 3 unum0r+ 67 1 unum0r+ s" 3457" cat= -> true }t

\ -mon-  ( month -- month.s )
t{  1 -mon- s" -Jan-" s= -> true }t
t{ 12 -mon- s" -Dec-" s= -> true }t

[DEFINED] fnum+ [IF]
TESTING  FNUM+ SET-FNUM-DIGS

3 set-fnum-digs

\ fnum+   ( f: num  -- $: num$ )
PFE-HOST [IF]
t{ 0E fnum+  s" .000E0" cat= -> true }t
0 [IF] \ actually returns ".00", sprintf problem?
t{ -0E0 fnum+  s" -.000E0" cat= -> true }t
[THEN]
[THEN]  \ FNUM+

GFORTH-HOST [IF]
t{ 0E fnum+  s" .000E1" cat= -> true }t
t{ -0E0 fnum+  s" .000E1" cat= -> true }t
[THEN]

t{ .1234e5 fnum+  s" .123E5" cat= -> true }t
t{ -.12e5  fnum+ s" -.120E5" cat= -> true }t

4 set-fnum-digs
t{ .1234e5 fnum+  s" .1234E5" cat= -> true }t
t{ -.12e5  fnum+ s" -.1200E5" cat= -> true }t

t{ .12346e0 fnum+ .5e1 fnum+ s" .1235E0.5000E1" cat= -> true }t

TRY-MAX-FNUM-DIGS 1- set-fnum-digs
\ Uncomment to test fnum-digs overflow:
\ TRY-MAX-FNUM-DIGS 1+ set-fnum-digs

[ELSE]
comment Floating point words not tested.
[THEN]

TESTING  DATE&TIME+

\ This will be wrong in the rare event that the execution time
\ interval overlaps a second boundary:

\ date&time+  ( -- )
t{ date&time+ date&time+ ENDCAT
  date&time+ ENDCAT $dup $+ $+ ENDCAT $s> $s> s= -> true }t

VERBOSE @ [IF]
blue-text
date&time+ ENDCAT $. cr
.( #ERRORS: ) #errors . normal-text cr
[THEN]