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

Fixing a bug in CASE.

Browse Source
This commit is contained in:
Brad Nelson
2022-11-08 19:42:44 -08:00
parent 23ec00d7cd
commit 4751b31c40
2 changed files with 20 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
common/case.fs
View File

@ -17,9 +17,9 @@ variable cases
forth definitions internals forth definitions internals
: CASE ( n -- ) cases @ 0 cases ! ; immediate : CASE ( n -- ) cases @ 0 cases ! ; immediate
: ENDCASE cases @ for aft postpone then then next : ENDCASE postpone drop cases @ for aft postpone then then next
cases ! postpone drop ; immediate cases ! ; immediate
: OF ( n -- ) postpone over postpone = postpone if ; immediate : OF ( n -- ) postpone over postpone = postpone if postpone drop ; immediate
: ENDOF 1 cases +! postpone else ; immediate : ENDOF 1 cases +! postpone else ; immediate
forth definitions forth definitions

17
common/case_tests.fs
View File

@ -46,3 +46,20 @@ e: test-case-dup
3 foo 3 foo
out: other: 3 out: other: 3
;e ;e
e: test-case-string
: foo
case
1 of s" one" endof
2 of s" two" endof
1 of s" onemore" endof
>r s" other" r>
endcase
;
1 foo type cr
out: one
2 foo type cr
out: two
3 foo type cr
out: other
;e