case structure and test

src/case.4th

@@ -0,0 +1,28 @@
+Based on Dr. Eaker/Baden/WJR CASE statement, but modified
+
+n CASE                        DUP
+    test1 OF ... ENDOF        n test1 IF ... ELSE DUP THEN
+    test2 OF ... ENDOF        n test2 IF ... ELSE DUP THEN
+    testn OF ... ENDOF        n testn IF ... ELSE DUP THEN
+    ... ( default case )      ...
+ENDCASE                       DROP
+----
+
+decimal 2 capacity 1- thru
+
+----
+: CASE     ( n -- n n )
+ STATE @ NOT ABORT" Interpreter mode" COMPILE DUP ; IMMEDIATE
+
+: OF       ( n n -- n ) 
+ [COMPILE] IF ; IMMEDIATE
+
+: ENDOF    ( -- )
+ COMPILE EXIT [COMPILE] ELSE COMPILE DUP [COMPILE] THEN ;
+ IMMEDIATE
+
+: .ENDOF      ( n -- )
+ COMPILE DROP [COMPILE] ENDOF ; IMMEDIATE
+
+: ENDCASE  ( n -- )
+ DROP ;

tests/t-case.4th

@@ -0,0 +1,28 @@
+Testing routines for CASE.BLK
+
+----
+: {13,19}  13 19 BETWEEN ;
+
+: SELECT ( n -- )
+ CASE
+  1     = OF       ." Got first!"             CR  .ENDOF
+  1 1+  = OF       ." Got" 2 .r               CR   ENDOF
+  2 2 + = OF       ." Got" 2 .r               CR   ENDOF
+  {13,19} OF  0 .r ."  y.o. is a teenager!"   CR   ENDOF
+  0 >     OF  0 .r ."  is bigger than zero."  CR   ENDOF
+  0 <     OF  0 .r ."  is smaller than zero." CR   ENDOF
+  ( default case: )
+  ." Sorry, I wasn't expecting <" 0 .r ." >, try again." CR
+ ENDCASE ;
+-->
+----
+: TEST
+ ." Testing case -1: " -1 SELECT
+ ." Testing case  2: "  2 SELECT
+ ." Testing case  1: "  1 SELECT
+ ." Testing case  4: "  4 SELECT 
+ ." Testing case  0: "  0 SELECT
+ ." Testing case  3: "  3 SELECT
+ ." Testing case 17: " 17 SELECT ;
+
+CR TEST