Return error code from tests (#137)

Use new BYE-CODE to pass an error back to the shell.
Use test tools for t_alloc.fth

Fixes #82

diff --git a/.github/workflows/cmake.yml b/.github/workflows/cmake.yml
index fcf957624fe35a805a6042572139e2c034cc44a0..61a5e28625d4513846d6095d4e1506c52600c5cc 100644 (file)
--- a/.github/workflows/cmake.yml
+++ b/.github/workflows/cmake.yml
@@ -31,8 +31,9 @@ jobs:
     - name: Test
       working-directory: ${{github.workspace}}/fth
       run: |
-        ./pforth_standalone t_corex.fth | tee temp.txt && grep "0 failed" temp.txt
-        ./pforth_standalone t_strings.fth | tee temp.txt && grep "0 failed" temp.txt
-        ./pforth_standalone t_locals.fth | tee temp.txt && grep "0 failed" temp.txt
-        ./pforth_standalone t_alloc.fth | tee temp.txt && grep "PASSED" temp.txt
-      
+        ./pforth_standalone t_corex.fth
+        ./pforth_standalone t_strings.fth
+        ./pforth_standalone t_locals.fth
+        ./pforth_standalone t_alloc.fth
+        ./pforth_standalone t_floats.fth
+        ./pforth_standalone t_file.fth

diff --git a/csrc/pf_core.c b/csrc/pf_core.c
index 67a9f70bd257426b2bb0a3d6320f2dca4f5835c3..031d7b8f44766fab305d87f87930b07b07dc7292 100644 (file)
--- a/csrc/pf_core.c
+++ b/csrc/pf_core.c
@@ -59,7 +59,8 @@ cell_t          gDepthAtColon;
 cell_t          gVarContext;      /* Points to last name field. */
 cell_t          gVarState;        /* 1 if compiling. */
 cell_t          gVarBase;         /* Numeric Base. */
-cell_t          gVarEcho;           /* Echo input. */
+cell_t          gVarByeCode;      /* Echo input. */
+cell_t          gVarEcho;         /* Echo input. */
 cell_t          gVarTraceLevel;   /* Trace Level for Inner Interpreter. */
 cell_t          gVarTraceStack;   /* Dump Stack each time if true. */
 cell_t          gVarTraceFlags;   /* Enable various internal debug messages. */
@@ -572,7 +573,7 @@ ThrowCode pfDoForth( const char *DicFileName, const char *SourceName, cell_t IfI
     PF_USER_TERM;
 #endif
 
-    return Result;
+    return Result ? Result : gVarByeCode;
 
 error2:
     MSG("pfDoForth: Error occured.\n");

diff --git a/csrc/pf_guts.h b/csrc/pf_guts.h
index 6092bf34994f94032a667bcc8e33aee62a976865..a671e2052a00b7fd022926ea47bbc8b32a5a5425 100644 (file)
--- a/csrc/pf_guts.h
+++ b/csrc/pf_guts.h
@@ -289,12 +289,12 @@ enum cforth_primitive_ids
     ID_FILE_RENAME,    /* (RENAME-FILE) */
     ID_FILE_RESIZE,    /* RESIZE-FILE */
     ID_SLEEP_P,        /* (SLEEP) V2.0.0 */
-/* If you add a word here, take away one reserved word below. */
+    ID_VAR_BYE_CODE,   /* BYE-CODE */
+    /* If you add a word here, take away one reserved word below. */
 #ifdef PF_SUPPORT_FP
 /* Only reserve space if we are adding FP so that we can detect
 ** unsupported primitives when loading dictionary.
 */
-    ID_RESERVED01,
     ID_RESERVED02,
     ID_RESERVED03,
     ID_RESERVED04,
@@ -491,6 +491,7 @@ extern cell_t         gDepthAtColon;
 extern cell_t        gVarContext;    /* Points to last name field. */
 extern cell_t        gVarState;      /* 1 if compiling. */
 extern cell_t        gVarBase;       /* Numeric Base. */
+extern cell_t        gVarByeCode;    /* BYE-CODE returned on exit */
 extern cell_t        gVarEcho;       /* Echo input from file. */
 extern cell_t        gVarEchoAccept; /* Echo input from ACCEPT. */
 extern cell_t        gVarTraceLevel;

diff --git a/csrc/pf_inner.c b/csrc/pf_inner.c
index 3e0c040d6eaf2ca0f197d34dbb185c5ec9a8b5b2..60bddee62ed035262a97e330d62f212e4e6d2062 100644 (file)
--- a/csrc/pf_inner.c
+++ b/csrc/pf_inner.c
@@ -1787,6 +1787,7 @@ DBUG(("XX ah,m,l = 0x%8x,%8x,%8x - qh,l = 0x%8x,%8x\n", ah,am,al, qh,ql ));
             endcase;
 
         case ID_VAR_BASE: DO_VAR(gVarBase); endcase;
+        case ID_VAR_BYE_CODE: DO_VAR(gVarByeCode); endcase;
         case ID_VAR_CODE_BASE: DO_VAR(gCurrentDictionary->dic_CodeBase); endcase;
         case ID_VAR_CODE_LIMIT: DO_VAR(gCurrentDictionary->dic_CodeLimit); endcase;
         case ID_VAR_CONTEXT: DO_VAR(gVarContext); endcase;

diff --git a/csrc/pfcompil.c b/csrc/pfcompil.c
index 3b54284da03f7564b862bea6dfb912cd7a54e13f..6f253af961597d0f328f299211559535d75c60e4 100644 (file)
--- a/csrc/pfcompil.c
+++ b/csrc/pfcompil.c
@@ -361,6 +361,7 @@ PForthDictionary pfBuildDictionary( cell_t HeaderSize, cell_t CodeSize )
     CreateDicEntryC( ID_TO_R, ">R", 0 );
     CreateDicEntryC( ID_TYPE, "TYPE", 0 );
     CreateDicEntryC( ID_VAR_BASE, "BASE", 0 );
+    CreateDicEntryC( ID_VAR_BYE_CODE, "BYE-CODE", 0 );
     CreateDicEntryC( ID_VAR_CODE_BASE, "CODE-BASE", 0 );
     CreateDicEntryC( ID_VAR_CODE_LIMIT, "CODE-LIMIT", 0 );
     CreateDicEntryC( ID_VAR_CONTEXT, "CONTEXT", 0 );

diff --git a/fth/t_alloc.fth b/fth/t_alloc.fth
index 92814e4f26b5f605d6467966e85d479c10417b9c..680e2e67efc145884c4d65665dc2e90fb46c792d 100644 (file)
--- a/fth/t_alloc.fth
+++ b/fth/t_alloc.fth
@@ -3,6 +3,8 @@
 \
 \ Copyright 1994 3DO, Phil Burk
 
+INCLUDE? }T{  t_tools.fth
+
 anew task-t_alloc.fth
 decimal
 
@@ -85,7 +87,7 @@ NUM_TAF_SLOTS array TAF-SIZES
         THEN
 ;
 
-: TAF.TERM
+: TAF.TERM ( -- error , 0 if PASSED )
         NUM_TAF_SLOTS 0
         DO
                 i taf-addresses @
@@ -96,7 +98,9 @@ NUM_TAF_SLOTS array TAF-SIZES
 \
         taf.max.alloc? dup ." Final    MAX = " . cr
         ." Original MAX = " taf-max-alloc @ dup . cr
-        = IF ." Test PASSED." ELSE ." Test FAILED!" THEN cr
+        = IF ." Test PASSED." 0
+        ELSE ." Test FAILED!" 1
+        THEN cr
 
 ;
 
@@ -112,5 +116,10 @@ NUM_TAF_SLOTS array TAF-SIZES
 ;
 
 .( Testing ALLOCATE and FREE) cr
-10000 taf.test
+
+TEST{
+
+T{ 10000 taf.test }T{ 0 }T
+
+}TEST
 

diff --git a/fth/t_tools.fth b/fth/t_tools.fth
index 72e2c85164fd41583099f6e4e7d19d4b9070918f..87fd6b8d930578e5f761d813516a8383aef92d16 100644 (file)
--- a/fth/t_tools.fth
+++ b/fth/t_tools.fth
@@ -14,17 +14,21 @@ decimal
 variable TEST-DEPTH
 variable TEST-PASSED
 variable TEST-FAILED
+40 constant TEST_EXIT_FAILURE \ returned form pForth to shell
 
 : TEST{
-        depth test-depth !
-        0 test-passed !
-        0 test-failed !
+    depth test-depth !
+    0 test-passed !
+    0 test-failed !
 ;
 
 
 : }TEST
-        test-passed @ 4 .r ."  passed, "
-        test-failed @ 4 .r ."  failed." cr
+    test-passed @ 4 .r ."  passed, "
+    test-failed @ 4 .r ."  failed." cr
+    test-failed @ 0> IF
+        TEST_EXIT_FAILURE bye-code !
+    THEN
 ;
 
 

diff --git a/platforms/unix/Makefile b/platforms/unix/Makefile
index fab1f8250be130227f02ab681c1f65ce3389451d..2ba0492d48929566227b58ae5670bedf002b80ba 100644 (file)
--- a/platforms/unix/Makefile
+++ b/platforms/unix/Makefile
@@ -140,6 +140,7 @@ test: $(PFORTHAPP)
        wd=$$(pwd); (cd $(FTHDIR); $${wd}/$(PFORTHAPP) -q t_alloc.fth)
        wd=$$(pwd); (cd $(FTHDIR); $${wd}/$(PFORTHAPP) -q t_floats.fth)
        wd=$$(pwd); (cd $(FTHDIR); $${wd}/$(PFORTHAPP) -q t_file.fth)
+       @echo "PForth Tests PASSED"
 
 clean:
        rm -f $(PFOBJS) $(PFEMBOBJS)