mirror of https://github.com/mgcaret/of816.git
Add 7.3.3 and 7.3.4 unit tests
This commit is contained in:
mgcaret
parent
f50aaf6942
commit
f72ef5a72f
|
|
@ -0,0 +1,168 @@
|
|||
false CONSTANT <FALSE>
|
||||
true CONSTANT <TRUE>
|
||||
|
||||
testing 7.3.3.1 Memory access
|
||||
|
||||
\ the unaligned- words are not tested here because they are
|
||||
\ aliases to the standard version of the words since OF816
|
||||
\ has no alignment restrictions
|
||||
|
||||
\ the words are tested somewhat out of order from how they
|
||||
\ appear in IEEE 1275-1994 7.3.3.1
|
||||
|
||||
\ not tested yet: COMP, DUMP, WBFLIPS, LBFLIPS, LWFLIPS
|
||||
|
||||
HERE 1 ,
|
||||
HERE 2 ,
|
||||
CONSTANT 2ND
|
||||
CONSTANT 1ST
|
||||
T{ 1ST 2ND U< -> <TRUE> }T \ HERE MUST GROW WITH ALLOT
|
||||
T{ 1ST CELL+ -> 2ND }T \ ... BY ONE CELL
|
||||
T{ 1ST 1 CELLS + -> 2ND }T
|
||||
T{ 1ST @ 2ND @ -> 1 2 }T
|
||||
T{ 5 1ST ! -> }T
|
||||
T{ 1ST @ 2ND @ -> 5 2 }T
|
||||
T{ 6 2ND ! -> }T
|
||||
T{ 1ST @ 2ND @ -> 5 6 }T
|
||||
T{ 1ST 2@ -> 6 5 }T
|
||||
T{ 2 1 1ST 2! -> }T
|
||||
T{ 1ST 2@ -> 2 1 }T
|
||||
T{ 1S 1ST ! 1ST @ -> 1S }T \ CAN STORE CELL-WIDE VALUE
|
||||
t{ 1st off -> }t
|
||||
t{ 1st @ -> <false> }t
|
||||
t{ 1st on -> }t
|
||||
t{ 1st @ -> <true> }t
|
||||
|
||||
HERE 1 C,
|
||||
HERE 2 C,
|
||||
CONSTANT 2NDC
|
||||
CONSTANT 1STC
|
||||
T{ 1STC 2NDC U< -> <TRUE> }T \ HERE MUST GROW WITH ALLOT
|
||||
T{ 1STC CHAR+ -> 2NDC }T \ ... BY ONE CHAR
|
||||
T{ 1STC 1 CHARS + -> 2NDC }T
|
||||
T{ 1STC C@ 2NDC C@ -> 1 2 }T
|
||||
T{ 3 1STC C! -> }T
|
||||
T{ 1STC C@ 2NDC C@ -> 3 2 }T
|
||||
T{ 4 2NDC C! -> }T
|
||||
T{ 1STC C@ 2NDC C@ -> 3 4 }T
|
||||
|
||||
HERE 1 w,
|
||||
HERE 2 w,
|
||||
CONSTANT 2NDw
|
||||
CONSTANT 1STw
|
||||
T{ 1STw 2NDw U< -> <TRUE> }T \ HERE MUST GROW WITH ALLOT
|
||||
T{ 1STw wa1+ -> 2NDw }T \ ... BY ONE CHAR
|
||||
T{ 1STw 1 /w* + -> 2NDw }T
|
||||
T{ 1STw w@ 2NDw w@ -> 1 2 }T
|
||||
T{ 3 1STw w! -> }T
|
||||
T{ 1STw w@ 2NDw w@ -> 3 2 }T
|
||||
T{ 4 2NDw w! -> }T
|
||||
T{ 1STw w@ 2NDw w@ -> 3 4 }T
|
||||
|
||||
\ test sign extension of <w@
|
||||
t{ ffff 1stw w! -> }t
|
||||
t{ 1stw <w@ -> -1 }t
|
||||
|
||||
HERE 1 l,
|
||||
HERE 2 l,
|
||||
CONSTANT 2NDl
|
||||
CONSTANT 1STl
|
||||
T{ 1STl 2NDl U< -> <TRUE> }T \ HERE MUST GROW WITH ALLOT
|
||||
T{ 1STl la1+ -> 2NDl }T \ ... BY ONE CHAR
|
||||
T{ 1STl 1 /l* + -> 2NDl }T
|
||||
T{ 1STl l@ 2NDl l@ -> 1 2 }T
|
||||
T{ 3 1STl l! -> }T
|
||||
T{ 1STl w@ 2NDl l@ -> 3 2 }T
|
||||
T{ 4 2NDl l! -> }T
|
||||
T{ 1STl w@ 2NDl l@ -> 3 4 }T
|
||||
|
||||
ALIGN 1 ALLOT HERE ALIGN HERE 3 CELLS ALLOT
|
||||
CONSTANT A-ADDR CONSTANT UA-ADDR
|
||||
T{ UA-ADDR ALIGNED -> A-ADDR }T
|
||||
T{ 1 A-ADDR C! A-ADDR C@ -> 1 }T
|
||||
T{ 1234 A-ADDR ! A-ADDR @ -> 1234 }T
|
||||
T{ 123 456 A-ADDR 2! A-ADDR 2@ -> 123 456 }T
|
||||
T{ 2 A-ADDR CHAR+ C! A-ADDR CHAR+ C@ -> 2 }T
|
||||
T{ 3 A-ADDR CELL+ C! A-ADDR CELL+ C@ -> 3 }T
|
||||
T{ 1234 A-ADDR CELL+ ! A-ADDR CELL+ @ -> 1234 }T
|
||||
T{ 123 456 A-ADDR CELL+ 2! A-ADDR CELL+ 2@ -> 123 456 }T
|
||||
|
||||
T{ 0 1ST ! -> }T
|
||||
T{ 1 1ST +! -> }T
|
||||
T{ 1ST @ -> 1 }T
|
||||
T{ -1 1ST +! 1ST @ -> 0 }T
|
||||
|
||||
CREATE FBUF 00 C, 00 C, 00 C,
|
||||
CREATE SBUF 12 C, 34 C, 56 C,
|
||||
: SEEBUF FBUF C@ FBUF CHAR+ C@ FBUF CHAR+ CHAR+ C@ ;
|
||||
|
||||
T{ FBUF 0 20 FILL -> }T
|
||||
T{ SEEBUF -> 00 00 00 }T
|
||||
|
||||
T{ FBUF 1 20 FILL -> }T
|
||||
T{ SEEBUF -> 20 00 00 }T
|
||||
|
||||
T{ FBUF 3 20 FILL -> }T
|
||||
T{ SEEBUF -> 20 20 20 }T
|
||||
|
||||
T{ FBUF FBUF 3 CHARS MOVE -> }T \ BIZARRE SPECIAL CASE
|
||||
T{ SEEBUF -> 20 20 20 }T
|
||||
|
||||
T{ SBUF FBUF 0 CHARS MOVE -> }T
|
||||
T{ SEEBUF -> 20 20 20 }T
|
||||
|
||||
T{ SBUF FBUF 1 CHARS MOVE -> }T
|
||||
T{ SEEBUF -> 12 20 20 }T
|
||||
|
||||
T{ SBUF FBUF 3 CHARS MOVE -> }T
|
||||
T{ SEEBUF -> 12 34 56 }T
|
||||
|
||||
T{ FBUF FBUF CHAR+ 2 CHARS MOVE -> }T
|
||||
T{ SEEBUF -> 12 12 34 }T
|
||||
|
||||
T{ FBUF CHAR+ FBUF 2 CHARS MOVE -> }T
|
||||
T{ SEEBUF -> 12 34 34 }T
|
||||
|
||||
84 CONSTANT CHARS/PAD \ Minimum size of PAD in chars
|
||||
CHARS/PAD CHARS CONSTANT AUS/PAD
|
||||
: CHECKPAD ( caddr u ch -- f ) \ f = TRUE if u chars = ch
|
||||
SWAP 0
|
||||
?DO
|
||||
OVER I CHARS + C@ OVER <>
|
||||
IF 2DROP UNLOOP FALSE EXIT THEN
|
||||
LOOP
|
||||
2DROP TRUE
|
||||
;
|
||||
|
||||
T{ PAD DROP -> }T
|
||||
T{ 0 INVERT PAD C! -> }T
|
||||
T{ PAD C@ CONSTANT MAXCHAR -> }T
|
||||
T{ PAD CHARS/PAD 2DUP MAXCHAR FILL MAXCHAR CHECKPAD -> TRUE }T
|
||||
T{ PAD CHARS/PAD 2DUP CHARS ERASE 0 CHECKPAD -> TRUE }T
|
||||
T{ PAD CHARS/PAD 2DUP MAXCHAR FILL PAD 0 ERASE MAXCHAR CHECKPAD -> TRUE }T
|
||||
T{ PAD 43 CHARS + 9 CHARS ERASE -> }T
|
||||
T{ PAD 43 MAXCHAR CHECKPAD -> TRUE }T
|
||||
T{ PAD 43 CHARS + 9 0 CHECKPAD -> TRUE }T
|
||||
T{ PAD 52 CHARS + CHARS/PAD 52 - MAXCHAR CHECKPAD -> TRUE }T
|
||||
|
||||
t{ pad chars/pad 2dup blank bl checkpad -> true }t
|
||||
|
||||
\ Check that use of WORD and pictured numeric output do not corrupt PAD
|
||||
\ Minimum size of buffers for these are 33 chars and (2*n)+2 chars respectively
|
||||
\ where n is number of bits per cell
|
||||
|
||||
PAD CHARS/PAD ERASE
|
||||
2 BASE !
|
||||
MAX-UINT MAX-UINT <# #S CHAR 1 DUP HOLD HOLD #> 2DROP
|
||||
DECIMAL
|
||||
BL WORD 12345678123456781234567812345678 DROP
|
||||
T{ PAD CHARS/PAD 0 CHECKPAD -> TRUE }T
|
||||
|
||||
|
||||
testing 7.3.3.2 Memory allocation
|
||||
|
||||
\ todo: adapt alloc/free tests
|
||||
|
||||
t{ 100 alloc-mem debug-mem 100 free-mem -> }t
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,77 @@
|
|||
testing 7.3.4.1 Text input
|
||||
|
||||
t{ 1 -> 1 }t ( t{ 1 -> 2 }t ) t{ 2 -> 2 }t
|
||||
t{ 1 -> 1 }t \ t{ 1 -> 2 }t
|
||||
|
||||
t{ >in @ 0> -> true }t
|
||||
t{ ascii / parse test/ swap 0> -> 4 true }t
|
||||
t{ parse-word test swap 0> -> 4 true }t
|
||||
t{ source 0> swap 0> -> true true }t
|
||||
t{ word test count swap 0> -> 4 true }t
|
||||
|
||||
testing 7.3.4.2 Console input
|
||||
\ not functionally tested
|
||||
|
||||
t{ ' key? 0> -> true }t
|
||||
t{ ' key 0> -> true }t
|
||||
t{ ' expect 0> -> true }t
|
||||
t{ ' span 0> -> true }t
|
||||
t{ ' accept 0> -> true }t
|
||||
|
||||
testing 7.3.4.3 ASCII constants
|
||||
|
||||
hex
|
||||
|
||||
t{ bell -> 07 }t
|
||||
t{ bl -> 20 }t
|
||||
t{ bs -> 08 }t
|
||||
t{ carret -> 0D }t
|
||||
t{ linefeed -> 0A }t
|
||||
t{ ascii A -> 41 }t
|
||||
t{ char A -> 41 }t
|
||||
|
||||
t{ : an-a [char] A ; -> }t
|
||||
t{ an-a -> 41 }t
|
||||
|
||||
t{ control A -> 01 }t
|
||||
|
||||
testing 7.3.4.4 Console output
|
||||
|
||||
t{ ." test" -> }t
|
||||
t{ .( test ) -> }t
|
||||
t{ 41 emit -> }t
|
||||
t{ parse-word test type -> }t
|
||||
|
||||
testing 7.3.4.5 Output formatting
|
||||
|
||||
t{ cr -> }t
|
||||
t{ space -> }t
|
||||
t{ 10 spaces -> }t
|
||||
t{ #line @ 0>= -> true }t
|
||||
t{ #out @ 0>= -> true }t
|
||||
|
||||
testing 7.3.4.6 Display pause
|
||||
\ not functionally tested
|
||||
|
||||
t{ ' exit? 0> -> true }t
|
||||
|
||||
testing 7.3.4.7 String literals
|
||||
|
||||
t{ " test" swap 0> -> 4 true }t
|
||||
t{ s" test" swap 0> -> 4 true }t
|
||||
t{ " test"(41)" swap 0> -> 5 true }t
|
||||
t{ s" testA" drop " test"(41)" comp -> 0 }t
|
||||
|
||||
testing 7.3.4.8 String manipulation
|
||||
\ these aren't very good but hey
|
||||
|
||||
\ count tested above, sort of, and sort of again, here
|
||||
\ along with pack
|
||||
t{ s" AAAAA" drop >r s" BBBB" r> pack count swap 0> -> 4 true }t
|
||||
|
||||
t{ ascii a ascii A lcc = -> true }t
|
||||
t{ ascii b ascii b lcc = -> true }t
|
||||
t{ ascii A ascii a upc = -> true }t
|
||||
t{ ascii B ascii B upc = -> true }t
|
||||
t{ s" abc " -trailing nip 3 = -> true }t
|
||||
|
||||
|
|
@ -25,6 +25,15 @@
|
|||
load:
|
||||
- tester.fs
|
||||
- 7.3.2.5.fs
|
||||
- name: 7.3.3 Memory control
|
||||
load:
|
||||
- tester.fs
|
||||
- test-utils.fs
|
||||
- 7.3.3.fs
|
||||
- name: 7.3.4 Text input
|
||||
load:
|
||||
- tester.fs
|
||||
- 7.3.4.fs
|
||||
- name: 7.3.6 Comparison operators
|
||||
load:
|
||||
- tester.fs
|
||||
|
|
|
|||
Loading…
Reference in New Issue