From 42b3ae71f9c845a4a860202d192158e047ed4ca2 Mon Sep 17 00:00:00 2001
From: Brad Nelson <flagxor@gmail.com>
Date: Sun, 31 Jan 2021 23:13:09 -0800
Subject: [PATCH] Adding more tests.

Still a mystery why stack leaks happen on failed tests.
---
 ueforth/common/base_tests.fs | 19 +++++++++++++++++++
 ueforth/common/boot.fs       |  2 +-
 ueforth/common/testing.fs    |  3 ++-
 3 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/ueforth/common/base_tests.fs b/ueforth/common/base_tests.fs
index 5670aac..ca39b25 100644
--- a/ueforth/common/base_tests.fs
+++ b/ueforth/common/base_tests.fs
@@ -5,7 +5,26 @@
 : test-dup-values   456 dup 456 = assert 456 = assert ;
 : test-2drop   123 456 2drop depth 0= assert ;
 : test-nip   123 456 nip depth 1 = assert 456 = assert ;
+: 8throw   8 throw ;
+: test-catch ['] 8throw catch 8 = assert depth 0= assert ;
+: throw-layer 456 >r 123 123 123 8throw 123 123 123 r> ;
+: test-catch2 9 ['] throw-layer catch 8 = assert 9 = assert depth 0= assert ;
 : test-rdrop   111 >r 222 >r rdrop r> 111 = assert ;
 : test-*/    1000000 22 7 */ 3142857 = assert ;
 : test-bl   bl 32 = assert ;
 : test-0=   123 0= 0= assert 0 0= assert ;
+: test-cells   123 cells cell+ cell/ 124 = assert ;
+: test-aligned    127 aligned 128 = assert ;
+: test-[char]   [char] * 42 = assert ;
+2 3 * 4 * 5 * 6 * 7 * 8 * 9 * 10 * 11 * 12 * constant 2-12*
+: test-fornext    1 10 for r@ 2 + * next 2-12* = assert ;
+: test-foraft    1 11 for aft r@ 2 + * then next 2-12* = assert ;
+: test-doloop     1 13 2 do i * loop 2-12* = assert ;
+: inc-times ( a n -- a+n ) 0 ?do 1+ loop ;
+: test-?do     123 40 inc-times 163 = assert ;
+: test-?do2     123 0 inc-times 123 = assert ;
+: test-<>   123 456 <> assert ;
+: test-<>2   123 123 <> 0= assert ;
+: inc/2-times ( a n -- a+n/2 ) 0 ?do 1+ 2 +loop ;
+: test-+loop   123 0 inc/2-times 123 = assert ;
+: test-+loop2   123 6 inc/2-times 126 = assert ;
diff --git a/ueforth/common/boot.fs b/ueforth/common/boot.fs
index 758ca71..ea6f02d 100644
--- a/ueforth/common/boot.fs
+++ b/ueforth/common/boot.fs
@@ -124,7 +124,7 @@ variable handler
 : catch ( xt -- n )
   sp@ >r handler @ >r rp@ handler ! execute r> handler ! r> drop 0 ;
 : throw ( n -- )
-  dup if handler @ rp! r> handler !  r> swap >r sp! drop r> else drop then ;
+  dup if handler @ rp! r> handler ! r> swap >r sp! drop r> else drop then ;
 ' throw 'notfound !
 
 ( Values )
diff --git a/ueforth/common/testing.fs b/ueforth/common/testing.fs
index d6883a5..2aab543 100644
--- a/ueforth/common/testing.fs
+++ b/ueforth/common/testing.fs
@@ -10,7 +10,8 @@ variable tests-found   variable tests-run    variable tests-passed
    last @ begin dup while dup test? if 2dup >r >r swap execute r> r> then >link repeat 2drop ;
 : reset-test-counters   0 tests-found !   0 tests-run !   0 tests-passed ! ;
 : count-test ( xt -- ) drop 1 tests-found +! ;
-: wrap-test ( xt -- ) depth 1 <> if ."  depth leak! " 1 throw then execute depth 0= assert ;
+: check-fresh   depth if ."  DEPTH LEAK! " depth . 1 throw then ;
+: wrap-test ( xt -- ) >r check-fresh r> execute check-fresh ;
 : red   1 fg ;   : green   2 fg ;   : hr   40 for [char] - emit next cr ;
 : run-test ( xt -- ) dup >name type ['] wrap-test catch
    if red ."  FAILED" normal cr else green ."  OK" normal cr 1 tests-passed +! then 1 tests-run +! ;