From 2778c7d8c90cde9dd67c2aa07b62f65ee8ec3838 Mon Sep 17 00:00:00 2001
From: kitty <nepeta@canaglie.net>
Date: Tue, 21 Apr 2026 17:21:44 +1000
Subject: recurse, chars, more tests

---
 test.fs | 138 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 138 insertions(+)

(limited to 'test.fs')

diff --git a/test.fs b/test.fs
index f8fa408..f84cd96 100644
--- a/test.fs
+++ b/test.fs
@@ -276,4 +276,142 @@ t{ mid-uint+1 1 rshift 2 * -> mid-uint+1 }t
 t{ mid-uint+1 2 rshift 4 * -> mid-uint+1 }t
 t{ mid-uint+1 1 rshift mid-uint+1 or 2 * -> mid-uint+1 }t
 
+testing memory stuff
+
+here 1 allot
+here
+constant 2nda
+constant 1sta
+t{ 1sta 2nda u< -> <true> }t		\ here must grow with allot
+t{ 1sta 1+ -> 2nda }t			\ ... by one address unit
+
+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{ 1s 1st !  1st @ -> 1s }t		\ can store cell-wide value
+
+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
+
+t{ 1 chars 1 < -> <false> }t
+t{ 1 chars 1 cells > -> <false> }t
+
+t{ 1 cells 1 < -> <false> }t
+t{ 1 cells 1 chars mod -> 0 }t
+
+testing characters and strings
+
+t{ char X     -> 58 }t
+t{ char Hello -> 48 }t
+t{ bl -> 20 }t
+
+t{ : gc4 s" XY" ; ->   }t
+t{ gc4 swap drop  -> 2 }t
+t{ gc4 drop dup c@ swap char+ c@ -> 58 59 }t
+: gc5 s" A String"2drop ; \ There is no space between the " and 2drop
+t{ gc5 -> }t
+
+testing dictionary
+
+t{ : gt1 123 ;   ->     }t
+t{ ' gt1 execute -> 123 }t
+t{ : gt2 ['] gt1 ; immediate -> }t
+t{ gt2 execute -> 123 }t
+
+here 3 c, char g c, char t c, char 1 c, constant gt1string
+here 3 c, char g c, char t c, char 2 c, constant gt2string
+t{ gt1string count find -> 'h gt1 -1 }t
+t{ gt2string count find -> 'h gt2 -1 }t
+
+t{ : gt3 gt2 literal ; -> }t
+t{ gt3 -> ' gt1 }t
+
+t{ gt1string count -> gt1string char+ 3 }t
+
+t{ : gt4 postpone gt1 ; immediate -> }t
+t{ : gt5 gt4 ; -> }t
+t{ gt5 -> 123 }t
+t{ : gt6 345 ; immediate -> }t
+t{ : gt7 postpone gt6 ; -> }t
+t{ gt7 -> 345 }t
+
+t{ : gt8 state @ ; immediate -> }t
+t{ gt8 -> 0 }t
+t{ : gt9 gt8 literal ; -> }t
+t{ gt9 0= -> <false> }t
+
+t{ : gi1 if 123 then ; -> }t
+t{ : gi2 if 123 else 234 then ; -> }t
+t{  0 gi1 ->     }t
+t{  1 gi1 -> 123 }t
+t{ -1 gi1 -> 123 }t
+t{  0 gi2 -> 234 }t
+t{  1 gi2 -> 123 }t
+t{ -1 gi1 -> 123 }t
+\ Multiple ELSEs in an IF statement
+: melse if 1 else 2 else 3 else 4 else 5 then ;
+t{ <false> melse -> 2 4 }t
+t{ <true>  melse -> 1 3 5 }t
+
+t{ : gi3 begin dup 5 < while dup 1+ repeat ; -> }t
+t{ 0 gi3 -> 0 1 2 3 4 5 }t
+t{ 4 gi3 -> 4 5 }t
+t{ 5 gi3 -> 5 }t
+t{ 6 gi3 -> 6 }t
+
+t{ : gi4 begin dup 1+ dup 5 > until ; -> }t
+t{ 3 gi4 -> 3 4 5 6 }t
+t{ 5 gi4 -> 5 6 }t
+t{ 6 gi4 -> 6 7 }t
+
+t{ : gi6 ( n -- 0,1,..n )
+     dup if dup >r 1- recurse r> then ; -> }t
+t{ 0 gi6 -> 0 }t
+t{ 1 gi6 -> 0 1 }t
+t{ 2 gi6 -> 0 1 2 }t
+t{ 3 gi6 -> 0 1 2 3 }t
+t{ 4 gi6 -> 0 1 2 3 4 }t
+decimal
+t{ :noname ( N -- 0, 1, .., N )
+     dup if dup >r 1- recurse r> then
+   ;
+   constant RN1 -> }t
+t{ 0 RN1 execute -> 0 }t
+t{ 4 RN1 execute -> 0 1 2 3 4 }t
+
+\ :noname ( N -- N1 )
+\    1- dup
+\    case 0 of exit endof
+\      1 of 11 swap recurse endof
+\      2 of 22 swap recurse endof
+\      3 of 33 swap recurse endof
+\      drop abs recurse exit
+\    endcase
+\ ; constant RN2
+\
+\ t{  1 RN2 execute -> 0 }t
+\ t{  2 RN2 execute -> 11 0 }t
+\ t{  4 RN2 execute -> 33 22 11 0 }t
+\ t{ 25 RN2 execute -> 33 22 11 0 }t
+hex
+
 decimal
-- 
cgit v1.2.3