Test fix (#93)

* test_eqa made global. handling for counted tests

* test_eqa made global. added support for counted tests

* counts and additions to test routines

* better naming. smaller code. check for prem exit

exercises/practice/acronym/acronym-tests.8th

@@ -1,3 +1,4 @@
+9 tests
 "ignoring punctuation and casing" "CMOS" ( "Complementary metal-oxide semiconductor" acronym ) test_eqs
 "ignores punctuation" "FIFO" ( "First In, First Out" acronym ) test_eqs
 "from phrases with acronyms" "GIMP" ( "GNU Image Manipulation Program" acronym ) test_eqs

exercises/practice/acronym/test-words.8th

@@ -1,13 +1,23 @@
 needs console/loaded
 
+-1 var, test-count
+
+: tests \ n -- 
+    test-count ! 
+;
+
+: decr-test-count \ --
+    test-count @ n:1- test-count !
+;
 
 : isword?  \ x -- x f
    dup  >kind  ns:w   n:= 
 ;
 
 : test_eq \ s x w -- | s w x --
+   decr-test-count
    isword? !if swap then
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   w:exec
    n:= if
     con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
@@ -16,8 +26,9 @@ needs console/loaded
 ;
 
 : test_eqs \ s x w -- | s w x -- 
+   decr-test-count
    isword? !if swap then
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   w:exec
    s:= if
     con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
@@ -26,7 +37,8 @@ needs console/loaded
 ;
 
 : test_true \ s w --
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   decr-test-count
+   w:exec
    if
     con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
@@ -35,7 +47,8 @@ needs console/loaded
 ;
 
 : test_false \ s w --
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   decr-test-count
+   w:exec
    !if
     con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
@@ -44,11 +57,44 @@ needs console/loaded
 ;
 
 : test_null \ s w --
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   decr-test-count
+   w:exec
    null? if
     drop con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
     drop con:red con:onBlack . space " ... FAIL" . con:white con:onBlack cr
    then 
 ;
 
+\ compare arrays by testing elements with string equality
+: test_eqa \ s x w -- | s w x -- 
+   decr-test-count
+   isword? !if swap then
+   w:exec
+   ' s:= a:= nip nip if
+    con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
+   else
+    con:red con:onBlack . space " ... FAIL" . con:white con:onBlack cr
+   then 
+;
+
+: test_map_neq \ m m -- 
+   decr-test-count
+   isword? !if swap then
+   w:exec
+   ' n:= m:= !if
+    2drop
+    con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
+   else
+    2drop
+    con:red con:onBlack . space " ... FAIL" . con:white con:onBlack cr
+   then 
+;
+
+( test-count @ 0 n:= 
+  !if 
+  con:red con:onBlack
+  "... FAIL - not all tests completed" . 
+  con:white con:onBlack 
+  cr 
+  then ) onexit

exercises/practice/affine-cipher/affine-cipher-tests.8th

@@ -1,3 +1,4 @@
+16 tests
 
 "encode yes"
 ( "yes" 5 7 >code ) "xbt" test_eqs

exercises/practice/affine-cipher/test-words.8th

@@ -1,12 +1,23 @@
 needs console/loaded
 
+-1 var, test-count
+
+: tests \ n -- 
+    test-count ! 
+;
+
+: decr-test-count \ --
+    test-count @ n:1- test-count !
+;
+
 : isword?  \ x -- x f
    dup  >kind  ns:w   n:= 
 ;
 
 : test_eq \ s x w -- | s w x --
+   decr-test-count
    isword? !if swap then
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   w:exec
    n:= if
     con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
@@ -15,8 +26,9 @@ needs console/loaded
 ;
 
 : test_eqs \ s x w -- | s w x -- 
+   decr-test-count
    isword? !if swap then
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   w:exec
    s:= if
     con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
@@ -25,7 +37,8 @@ needs console/loaded
 ;
 
 : test_true \ s w --
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   decr-test-count
+   w:exec
    if
     con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
@@ -34,7 +47,8 @@ needs console/loaded
 ;
 
 : test_false \ s w --
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   decr-test-count
+   w:exec
    !if
     con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
@@ -43,11 +57,44 @@ needs console/loaded
 ;
 
 : test_null \ s w --
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   decr-test-count
+   w:exec
    null? if
     drop con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
     drop con:red con:onBlack . space " ... FAIL" . con:white con:onBlack cr
    then 
 ;
 
+\ compare arrays by testing elements with string equality
+: test_eqa \ s x w -- | s w x -- 
+   decr-test-count
+   isword? !if swap then
+   w:exec
+   ' s:= a:= nip nip if
+    con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
+   else
+    con:red con:onBlack . space " ... FAIL" . con:white con:onBlack cr
+   then 
+;
+
+: test_map_neq \ m m -- 
+   decr-test-count
+   isword? !if swap then
+   w:exec
+   ' n:= m:= !if
+    2drop
+    con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
+   else
+    2drop
+    con:red con:onBlack . space " ... FAIL" . con:white con:onBlack cr
+   then 
+;
+
+( test-count @ 0 n:= 
+  !if 
+  con:red con:onBlack
+  "... FAIL - not all tests completed" . 
+  con:white con:onBlack 
+  cr 
+  then ) onexit

exercises/practice/armstrong-numbers/armstrong-numbers-tests.8th

@@ -1,3 +1,4 @@
+11 tests
 "Zero is an Armstrong number"    ( 0 armstrong?  ) test_true
 "Single digit numbers are Armstrong numbers"    ( 5 armstrong?  ) test_true
 "There are no 2 digit Armstrong Numbers"    ( 10 armstrong?  ) test_false

exercises/practice/armstrong-numbers/test-words.8th

@@ -1,13 +1,23 @@
 needs console/loaded
 
+-1 var, test-count
+
+: tests \ n -- 
+    test-count ! 
+;
+
+: decr-test-count \ --
+    test-count @ n:1- test-count !
+;
 
 : isword?  \ x -- x f
    dup  >kind  ns:w   n:= 
 ;
 
 : test_eq \ s x w -- | s w x --
+   decr-test-count
    isword? !if swap then
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   w:exec
    n:= if
     con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
@@ -16,8 +26,9 @@ needs console/loaded
 ;
 
 : test_eqs \ s x w -- | s w x -- 
+   decr-test-count
    isword? !if swap then
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   w:exec
    s:= if
     con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
@@ -26,7 +37,8 @@ needs console/loaded
 ;
 
 : test_true \ s w --
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   decr-test-count
+   w:exec
    if
     con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
@@ -35,7 +47,8 @@ needs console/loaded
 ;
 
 : test_false \ s w --
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   decr-test-count
+   w:exec
    !if
     con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
@@ -44,11 +57,44 @@ needs console/loaded
 ;
 
 : test_null \ s w --
-   a:new swap 0 swap a:! 0 a:@ nip w:exec
+   decr-test-count
+   w:exec
    null? if
     drop con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
    else
     drop con:red con:onBlack . space " ... FAIL" . con:white con:onBlack cr
    then 
 ;
 
+\ compare arrays by testing elements with string equality
+: test_eqa \ s x w -- | s w x -- 
+   decr-test-count
+   isword? !if swap then
+   w:exec
+   ' s:= a:= nip nip if
+    con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
+   else
+    con:red con:onBlack . space " ... FAIL" . con:white con:onBlack cr
+   then 
+;
+
+: test_map_neq \ m m -- 
+   decr-test-count
+   isword? !if swap then
+   w:exec
+   ' n:= m:= !if
+    2drop
+    con:green con:onBlack . space " ... OK" . con:white con:onBlack cr
+   else
+    2drop
+    con:red con:onBlack . space " ... FAIL" . con:white con:onBlack cr
+   then 
+;
+
+( test-count @ 0 n:= 
+  !if 
+  con:red con:onBlack
+  "... FAIL - not all tests completed" . 
+  con:white con:onBlack 
+  cr 
+  then ) onexit

exercises/practice/atbash-cipher/atbash-cipher-tests.8th

@@ -1,3 +1,4 @@
+14 tests
 "encode yes" ( "yes" >atbash ) "bvh" test_eqs
 "encode no" ( "no" >atbash ) "ml" test_eqs
 "encode OMG" ( "OMG" >atbash ) "lnt" test_eqs