alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fixed empty strings, added stride tests.

Browse Source
This commit is contained in:
Brad Nelson
2022-01-09 11:38:02 -08:00
parent 6de02783fc
commit 3cc3884631
3 changed files with 39 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
ueforth/common/base_tests.fs
View File

@ -117,3 +117,8 @@ e: test-compiler-off
: test [ 123 111 + literal ] ; : test [ 123 111 + literal ] ;
test 234 = assert test 234 = assert
;e ;e
e: test-empty-string
: test s" " ;
test 0 = assert drop
;e

6
ueforth/common/core.h
View File

@ -136,8 +136,10 @@ static int match(char sep, char ch) {
} }
static cell_t parse(cell_t sep, cell_t *ret) { static cell_t parse(cell_t sep, cell_t *ret) {
while (g_sys.tin < g_sys.ntib && if (sep == ' ') {
match(sep, g_sys.tib[g_sys.tin])) { ++g_sys.tin; } while (g_sys.tin < g_sys.ntib &&
match(sep, g_sys.tib[g_sys.tin])) { ++g_sys.tin; }
}
*ret = (cell_t) (g_sys.tib + g_sys.tin); *ret = (cell_t) (g_sys.tib + g_sys.tin);
while (g_sys.tin < g_sys.ntib && while (g_sys.tin < g_sys.ntib &&
!match(sep, g_sys.tib[g_sys.tin])) { ++g_sys.tin; } !match(sep, g_sys.tib[g_sys.tin])) { ++g_sys.tin; }

30
ueforth/common/utils_tests.fs
View File

@ -70,3 +70,33 @@ e: test-see-fornext
see test see test
out: : test >R DONEXT ; out: : test >R DONEXT ;
;e ;e
e: test-string-strides
: test0 1 if ." " then ;
: test1 1 if ." >" then ;
: test2 1 if ." ->" then ;
: test3 1 if ." -->" then ;
: test4 1 if ." --->" then ;
: test5 1 if ." ---->" then ;
: test6 1 if ." ----->" then ;
: test7 1 if ." ------>" then ;
: test8 1 if ." ------->" then ;
see test0
out: : test0 1 0BRANCH s" " type ;
see test1
out: : test1 1 0BRANCH s" >" type ;
see test2
out: : test2 1 0BRANCH s" ->" type ;
see test3
out: : test3 1 0BRANCH s" -->" type ;
see test4
out: : test4 1 0BRANCH s" --->" type ;
see test5
out: : test5 1 0BRANCH s" ---->" type ;
see test6
out: : test6 1 0BRANCH s" ----->" type ;
see test7
out: : test7 1 0BRANCH s" ------>" type ;
see test8
out: : test8 1 0BRANCH s" ------->" type ;
;e