mirror of
https://github.com/mgcaret/of816.git
synced 2025-01-24 20:30:08 +00:00
add tests for OF816 words; test coverage is 67% of words
This commit is contained in:
parent
7a82a13f10
commit
85e2c0122c
@ -79,9 +79,13 @@ testing 7.3.9.2 Dictionary commands
|
||||
|
||||
testing 7.3.9.2.1 Data space allocation
|
||||
|
||||
\ mostly tested in 7.3.3: here allot align c, w, l, ,
|
||||
\ also tested in 7.3.3: here allot align c, w, l, ,
|
||||
|
||||
t{ create da1 -> }t
|
||||
t{ here 0 c, ca1+ -> here }t
|
||||
t{ here 0 w, wa1+ -> here }t
|
||||
t{ here 0 l, la1+ -> here }t
|
||||
t{ here 0 , na1+ -> here }t
|
||||
t{ here align -> here }t \ OF816 has no alignment restrictions
|
||||
t{ 0 c, here align -> here }t \ OF816 has no alignment restrictions
|
||||
t{ here 2 cells allot 2 na+ -> here }t
|
||||
|
@ -2,6 +2,15 @@ testing OF816 words
|
||||
|
||||
hex
|
||||
|
||||
: s= ( str len str len )
|
||||
2 pick over = if
|
||||
drop swap comp 0=
|
||||
else
|
||||
2drop 2drop false
|
||||
then
|
||||
;
|
||||
|
||||
\ Byte and word sign extension
|
||||
t{ 0 bsx -> 0 }t
|
||||
t{ 7f bsx -> 7f }t
|
||||
t{ 80 bsx -> -80 }t
|
||||
@ -11,3 +20,41 @@ t{ 0 wsx -> 0 }t
|
||||
t{ 7fff wsx -> 7fff }t
|
||||
t{ 8000 wsx -> -8000 }t
|
||||
t{ ffff wsx -> -1 }t
|
||||
|
||||
\ Return stack
|
||||
t{ 1 >r 2 >r rdrop r> -> 1 }t
|
||||
t{ 1 >r r+1 r> -> 2 }t
|
||||
t{ 1 >r@ r> -> 1 1 }t
|
||||
|
||||
\ Dictionary management
|
||||
t{ s" dm1" $create -> }t
|
||||
t{ last ' dm1 >link = -> true }t
|
||||
t{ ' dm1 >name s" DM1" s= -> true }t
|
||||
|
||||
\ Temporary string buffer & allocated strings
|
||||
\ and $2value for the heck of it
|
||||
\ This is indirectly tested by all s" and " tests.
|
||||
t{ s" foobar" 2dup $tmpstr s= -> true }t
|
||||
t{ a" foobaz" 2dup $2value -> }t
|
||||
t{ a" bazbar" 2dup $2value -> }t
|
||||
t{ foobaz s" foobaz" s= -> true }t
|
||||
t{ bazbar s" bazbar" s= -> true }t
|
||||
t{ foobaz bazbar aconcat 2constant fbbb -> }t
|
||||
t{ fbbb s" foobazbazbar" s= -> true }t
|
||||
t{ fbbb free-mem -> }t
|
||||
t{ $hex( 414243) 2dup $2value -> }t
|
||||
t{ abc s" ABC" s= -> true }t
|
||||
|
||||
\ Memory debug, good time to run it after the above
|
||||
t{ debug-mem -> }t
|
||||
|
||||
\ Temporary definitions
|
||||
t{ :temp 1 ; -> 1 }t
|
||||
|
||||
\ Quotations
|
||||
t{ : qt1 [: 123 ;] ; -> }t
|
||||
t{ qt1 execute -> 123 }t
|
||||
|
||||
\ Existence of a couple of words that are hard to test
|
||||
t{ ' $empty-wl 0= -> false }t
|
||||
t{ ' $env?-wl 0= -> false }t
|
||||
|
@ -52,7 +52,7 @@
|
||||
- tester.fs
|
||||
- test-utils.fs
|
||||
- 7.3.8.fs
|
||||
- name: 7.3.8 Control-flow commands in interpretation state
|
||||
- name: 7.3.8-i Control-flow commands in interpretation state
|
||||
load:
|
||||
- tester.fs
|
||||
- test-utils.fs
|
||||
|
Loading…
x
Reference in New Issue
Block a user