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
|
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{ 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{ here align -> here }t \ OF816 has no alignment restrictions
|
||||||
t{ 0 c, 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
|
t{ here 2 cells allot 2 na+ -> here }t
|
||||||
|
@ -2,6 +2,15 @@ testing OF816 words
|
|||||||
|
|
||||||
hex
|
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{ 0 bsx -> 0 }t
|
||||||
t{ 7f bsx -> 7f }t
|
t{ 7f bsx -> 7f }t
|
||||||
t{ 80 bsx -> -80 }t
|
t{ 80 bsx -> -80 }t
|
||||||
@ -11,3 +20,41 @@ t{ 0 wsx -> 0 }t
|
|||||||
t{ 7fff wsx -> 7fff }t
|
t{ 7fff wsx -> 7fff }t
|
||||||
t{ 8000 wsx -> -8000 }t
|
t{ 8000 wsx -> -8000 }t
|
||||||
t{ ffff wsx -> -1 }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
|
- tester.fs
|
||||||
- test-utils.fs
|
- test-utils.fs
|
||||||
- 7.3.8.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:
|
load:
|
||||||
- tester.fs
|
- tester.fs
|
||||||
- test-utils.fs
|
- test-utils.fs
|
||||||
|
Loading…
x
Reference in New Issue
Block a user