From: Phil Burk Date: Sun, 1 Jan 2023 00:04:57 +0000 (-0800) Subject: Return error code from tests (#137) X-Git-Url: https://git.gag.com/?p=debian%2Fpforth;a=commitdiff_plain;h=eaa66646ab0ebe6671c66014467485908b255cbb 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 fcf9576..61a5e28 100644 --- 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 67a9f70..031d7b8 100644 --- 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 6092bf3..a671e20 100644 --- 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 3e0c040..60bddee 100644 --- 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 3b54284..6f253af 100644 --- 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 92814e4..680e2e6 100644 --- 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 72e2c85..87fd6b8 100644 --- 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 fab1f82..2ba0492 100644 --- 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)