diff --git a/test/7.3.8.fs b/test/7.3.8.fs new file mode 100644 index 0000000..fe5c256 --- /dev/null +++ b/test/7.3.8.fs @@ -0,0 +1,214 @@ +testing 7.3.8.1 Conditional branches + +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 + +testing 7.3.8.2 Case statement + +: CS1 CASE 1 OF 111 ENDOF + 2 OF 222 ENDOF + 3 OF 333 ENDOF + >R 999 R> + ENDCASE +; + +T{ 1 CS1 -> 111 }T +T{ 2 CS1 -> 222 }T +T{ 3 CS1 -> 333 }T +T{ 4 CS1 -> 999 }T + +\ Nested CASE's + +: CS2 >R CASE -1 OF CASE R@ 1 OF 100 ENDOF + 2 OF 200 ENDOF + >R -300 R> + ENDCASE + ENDOF + -2 OF CASE R@ 1 OF -99 ENDOF + >R -199 R> + ENDCASE + ENDOF + >R 299 R> + ENDCASE R> DROP +; + +T{ -1 1 CS2 -> 100 }T +T{ -1 2 CS2 -> 200 }T +T{ -1 3 CS2 -> -300 }T +T{ -2 1 CS2 -> -99 }T +T{ -2 2 CS2 -> -199 }T +T{ 0 2 CS2 -> 299 }T + +\ Boolean short circuiting using CASE + +: CS3 ( N1 -- N2 ) + CASE 1- FALSE OF 11 ENDOF + 1- FALSE OF 22 ENDOF + 1- FALSE OF 33 ENDOF + 44 SWAP + ENDCASE +; + +T{ 1 CS3 -> 11 }T +T{ 2 CS3 -> 22 }T +T{ 3 CS3 -> 33 }T +T{ 9 CS3 -> 44 }T + +\ Empty CASE statements with/without default + +T{ : CS4 CASE ENDCASE ; 1 CS4 -> }T +T{ : CS5 CASE 2 SWAP ENDCASE ; 1 CS5 -> 2 }T +T{ : CS6 CASE 1 OF ENDOF 2 ENDCASE ; 1 CS6 -> }T +T{ : CS7 CASE 3 OF ENDOF 2 ENDCASE ; 1 CS7 -> 1 }T + + +testing 7.3.8.3 Conditional loops + +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{ : GI5 BEGIN DUP 2 > + WHILE DUP 5 < WHILE DUP 1+ REPEAT 123 ELSE 345 THEN ; -> }T +T{ 1 GI5 -> 1 345 }T +T{ 2 GI5 -> 2 345 }T +T{ 3 GI5 -> 3 4 5 123 }T +T{ 4 GI5 -> 4 5 123 }T +T{ 5 GI5 -> 5 123 }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 + + +testing 7.3.8.4 Counted loops + +T{ : GD1 DO I LOOP ; -> }T +T{ 4 1 GD1 -> 1 2 3 }T +T{ 2 -1 GD1 -> -1 0 1 }T +T{ MID-UINT+1 MID-UINT GD1 -> MID-UINT }T + +T{ : GD2 DO I -1 +LOOP ; -> }T +T{ 1 4 GD2 -> 4 3 2 1 }T +T{ -1 2 GD2 -> 2 1 0 -1 }T +T{ MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT }T + +T{ : GD3 DO 1 0 DO J LOOP LOOP ; -> }T +T{ 4 1 GD3 -> 1 2 3 }T +T{ 2 -1 GD3 -> -1 0 1 }T +T{ MID-UINT+1 MID-UINT GD3 -> MID-UINT }T + +T{ : GD4 DO 1 0 DO J LOOP -1 +LOOP ; -> }T +T{ 1 4 GD4 -> 4 3 2 1 }T +T{ -1 2 GD4 -> 2 1 0 -1 }T +T{ MID-UINT MID-UINT+1 GD4 -> MID-UINT+1 MID-UINT }T + +T{ : GD5 123 SWAP 0 DO I 4 > IF DROP 234 LEAVE THEN LOOP ; -> }T +T{ 1 GD5 -> 123 }T +T{ 5 GD5 -> 123 }T +T{ 6 GD5 -> 234 }T + +t{ : gd7 1 0 do true ?leave false loop ; -> }t +t{ gd7 -> }t + + +testing 7.3.8.5 Other control flow commands + +: GE1 S" 123" ; IMMEDIATE +: GE2 S" 123 1+" ; IMMEDIATE +: GE3 S" : GE4 345 ;" ; +: GE5 EVALUATE ; IMMEDIATE + +T{ GE1 EVALUATE -> 123 }T ( TEST EVALUATE IN INTERP. STATE ) +t{ ge1 EVAL -> 123 }t ( EVAL is an alias of EVALUATE ) +T{ GE2 EVALUATE -> 124 }T +T{ GE3 EVALUATE -> }T +T{ GE4 -> 345 }T + +T{ : GE6 GE1 GE5 ; -> }T ( TEST EVALUATE IN COMPILE STATE ) +T{ GE6 -> 123 }T +T{ : GE7 GE2 GE5 ; -> }T +T{ GE7 -> 124 }T + +T{ : GT1 123 ; -> }T +T{ ' GT1 EXECUTE -> 123 }T + +\ EXIT +T{ : GD6 ( PAT: T{0 0},{0 0}{1 0}{1 1},{0 0}{1 0}{1 1}{2 0}{2 1}{2 2} ) + 0 SWAP 0 DO + I 1+ 0 DO I J + 3 = IF I UNLOOP I UNLOOP EXIT THEN 1+ LOOP + LOOP ; -> }T +T{ 1 GD6 -> 1 }T +T{ 2 GD6 -> 3 }T +T{ 3 GD6 -> 4 1 2 }T + +testing 7.3.8.6 Other control flow commands + +\ not really tested: +t{ ' quit 0> -> true }t + +DECIMAL + +: T1 9 ; +: C1 1 2 3 ['] T1 CATCH ; +T{ C1 -> 1 2 3 9 0 }T \ No THROW executed + +: T2 8 0 THROW ; +: C2 1 2 ['] T2 CATCH ; +T{ C2 -> 1 2 8 0 }T \ 0 THROW does nothing + +: T3 7 8 9 99 THROW ; +: C3 1 2 ['] T3 CATCH ; +T{ C3 -> 1 2 99 }T \ Restores stack to CATCH depth + +: T4 1- DUP 0> IF RECURSE ELSE 999 THROW -222 THEN ; +: C4 3 4 5 10 ['] T4 CATCH -111 ; +T{ C4 -> 3 4 5 0 999 -111 }T \ Test return stack unwinding + +: T5 2DROP 2DROP 9999 THROW ; +: C5 1 2 3 4 ['] T5 CATCH \ Test depth restored correctly + DEPTH >R DROP 2DROP 2DROP R> ; \ after stack has been emptied +T{ C5 -> 5 }T + +-1 CONSTANT EXC_ABORT +-2 CONSTANT EXC_ABORT" +-13 CONSTANT EXC_UNDEF +: T6 ABORT ; + +\ The 77 in T10 is necessary for the second ABORT" test as the data stack +\ is restored to a depth of 2 when THROW is executed. The 77 ensures the top +\ of stack value is known for the results check + +: T10 77 SWAP ABORT" This should not be displayed" ; +: C6 CATCH + >R R@ EXC_ABORT = IF 11 + ELSE R@ EXC_ABORT" = IF 12 + ELSE R@ EXC_UNDEF = IF 13 + THEN THEN THEN R> DROP +; + +T{ 1 2 ' T6 C6 -> 1 2 11 }T \ Test that ABORT is caught +T{ 3 0 ' T10 C6 -> 3 77 }T \ ABORT" does nothing +T{ 4 5 ' T10 C6 -> 4 77 12 }T \ ABORT" caught, no message + +: T7 S" 333 $$QWEQWEQWERT$$ 334" EVALUATE 335 ; +: T8 S" 222 T7 223" EVALUATE 224 ; +: T9 S" 111 112 T8 113" EVALUATE 114 ; + +T{ 6 7 ' T9 C6 3 -> 6 7 13 3 }T \ Test unlinking of sources diff --git a/test/test-manifest.yaml b/test/test-manifest.yaml index 71699db..ba5d390 100644 --- a/test/test-manifest.yaml +++ b/test/test-manifest.yaml @@ -2,26 +2,26 @@ load: - tester.fs - 7.3.1.fs -- name: 7.3.2.1 Arithmetic +- name: 7.3.2.1 Arithmetic - Single-precision integer arithmetic load: - tester.fs - test-utils.fs - 7.3.2.1.fs -- name: 7.3.2.2 Arithmetic +- name: 7.3.2.2 Arithmetic - Bitwise logical operators load: - tester.fs - test-utils.fs - 7.3.2.2.fs -- name: 7.3.2.3 Arithmetic +- name: 7.3.2.3 Arithmetic - Double number arithmetic load: - tester.fs - test-utils.fs - 7.3.2.3.fs -- name: 7.3.2.4 Arithmetic +- name: 7.3.2.4 Arithmetic - Data type conversion load: - tester.fs - 7.3.2.4.fs -- name: 7.3.2.5 Arithmetic +- name: 7.3.2.5 Arithmetic - Address arithmetic load: - tester.fs - 7.3.2.5.fs @@ -43,3 +43,8 @@ load: - tester.fs - 7.3.7.fs +- name: 7.3.8 Control-flow commands + load: + - tester.fs + - test-utils.fs + - 7.3.8.fs