(    Title:  Test rawhex.fs user words
      File:  rawhex-test.fs
   Version:  0.9.0
   Revised:  July 25, 2009
    Author:  David N. Williams
   License:  LGPL
)
\ Copyright (C) 2005, 2009  David N. Williams
(
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or at your option any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser General Public License for more details.

This code is intended to be ANS Forth compatible up to case
sensitivity.
)

s" rawhex.fs" included
s" ttester.fs"  included
true verbose !
set-exact
decimal
variable #errors   0 #errors !

:noname  ( c-addr u -- )
(
Display an error message followed by the line that had the
error.
)
  1 #errors +! error1 ; error-xt !

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

verbose @ [IF]
cr
cr .( An address unit is ) bits/au . .( bits.)
cr .( There are ) bits/cell . .( bits/cell.)
cr .( There are ) bits/float . .( bits/float.)

:noname  ( -- fp.separate? )
  depth >r 1e depth >r fdrop 2r> = ; execute
cr .( Floating-point stack is )
[IF] .( *separate*) [ELSE] .( *not separate*) [THEN]
.(  from the data stack.)
[THEN]

cr
testing  HEX>UQ  LSHIFT>UD  (QLSHIFT)

hex 
t{ s" 0123456789ABCDEFFEDCBA9876543210" hex>uq ->
   76543210 FEDCBA98 89ABCDEF 01234567 true }t
t{ s" 89ABCDEFFEDCBA9876543210"hex>uq ->
   76543210 FEDCBA98 89ABCDEF 0 true }t
t{ s" FEDCBA9876543210"hex>uq -> 76543210 FEDCBA98 0 0 true }t
t{ s" 76543210"hex>uq -> 76543210 0 0 0 true }t
t{ s" " hex>uq -> 0 0 0 0 true }t
decimal

hex
t{ ABBBBBBC 0 lshift>ud -> ABBBBBBC 0 }t
t{ ABBBBBBC 4 lshift>ud -> BBBBBBC0 A }t
t{ ABBBBBBC bits/cell lshift>ud -> 0 ABBBBBBC }t
decimal

hex
t{ ABBBBBBB C0000000 D0000000 E0000000 4 (qlshift) ->
   BBBBBBB0 A C D }t
t{ ABBBBBBB C0000000 D0000000 E0000000 0 (qlshift) ->
   ABBBBBBB C0000000 D0000000 E0000000 }t
t{ ABBBBBBB C0000000 D0000000 E0000000 20 (qlshift) ->
   0 ABBBBBBB C0000000 D0000000 }t

testing  HEX8>RAW32  HEX16>RAW64  HEX20>RAW80  HEX32>RAW128

\ Uncomment one of these to test faulty input exceptions:
\ s" " hex8>raw32
\ s" 012345678" hex8>raw32
\ s" 0123h5678" hex8>raw32
\ s" " hex16>raw64
\ s" 01234567 012345678" hex16>raw64
\ s" 0x234567 012345678" hex16>raw64
\ s" 01234567 012345678 012345678" hex20>raw80
\ s" 0123456 01234567 012345678" hex20>raw80
\  s" 01234567 01234567 012345678 01234567" hex32>raw128
\ s" 0123456 01234567 01234567 01234567" hex32>raw128

hex
t{ s"  0 123  4567" hex8>raw32 -> 01234567 }t
t{ s"  0 123  456789AB CDEF" hex16>raw64 -> 89ABCDEF 01234567 }t
t{ s" 00AB00DE" hex8>raw32 -> 00AB00DE }t
t{ s" 0123 4567 89AB cdef 0123" hex20>raw80 -> 01230000 89ABCDEF 01234567 }t
t{ s" 0123 4567 89AB cdef 0123 4567 89ab CDEF" hex32>raw128
   -> 89ABCDEF 01234567 89ABCDEF 01234567 }t
decimal

testing  RAW32>HEX8  RAW64>HEX16  RAW80>HEX20  RAW128>HEX32

hex
t{ 00AB00DE          raw32>hex8 s" 00AB 00DE"           compare -> 0 }t
t{ 89ABCDEF 01234567 raw64>hex16 s" 0123 4567 89AB CDEF" compare -> 0 }t
t{ 89ABCDEF 01234567 89ABCDEF raw80>hex20
   s" 89AB CDEF 0123 4567 89AB" compare -> 0 }t
t{ 89ABCDEF 01234567 89ABCDEF 01234567 raw128>hex32
   s" 0123 4567 89AB CDEF 0123 4567 89AB CDEF" compare -> 0 }t

false  \ change to TRUE to inspect word defaults
verbose @ and [IF]
see hex>raw   see raw>hex
cr [THEN]

verbose @ [IF]
.( #ERRORS: ) #errors @ . cr
[THEN]