/anstests/errorreport.fth

https://github.com/jamesbowman/swapforth · Forth · 74 lines · 61 code · 13 blank · 0 comment · 0 complexity · fc7b94d1adb4ad200464b61b3b6fc538 MD5 · raw file

  1. \ To collect and report on the number of errors resulting from running the
  2. \ ANS Forth and Forth 2012 test programs
  3. \ This program was written by Gerry Jackson in 2015, and is in the public
  4. \ domain - it can be distributed and/or modified in any way but please
  5. \ retain this notice.
  6. \ This program is distributed in the hope that it will be useful,
  7. \ but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  9. \ ------------------------------------------------------------------------------
  10. \ This file is INCLUDED after Core tests are complete and only uses Core words
  11. \ already tested. The purpose of this file is to count errors in test results
  12. \ and present them as a summary at the end of the tests.
  13. DECIMAL
  14. VARIABLE CORE-ERRORS VARIABLE CORE-EXT-ERRORS
  15. VARIABLE DOUBLE-ERRORS VARIABLE EXCEPTION-ERRORS
  16. VARIABLE FACILITY-ERRORS VARIABLE FILE-ERRORS
  17. VARIABLE LOCALS-ERRORS VARIABLE MEMORY-ERRORS
  18. VARIABLE SEARCHORDER-ERRORS VARIABLE STRING-ERRORS
  19. VARIABLE TOOLS-ERRORS VARIABLE PREV-ERRORS
  20. : INIT-ERRORS ( -- )
  21. #ERRORS @
  22. DUP CORE-ERRORS ! PREV-ERRORS ! \ #ERRORS is in file tester.fr
  23. 0 CORE-EXT-ERRORS ! 0 DOUBLE-ERRORS ! 0 EXCEPTION-ERRORS !
  24. 0 FACILITY-ERRORS ! 0 FILE-ERRORS ! 0 LOCALS-ERRORS !
  25. 0 MEMORY-ERRORS ! 0 SEARCHORDER-ERRORS ! 0 STRING-ERRORS !
  26. 0 TOOLS-ERRORS !
  27. ;
  28. INIT-ERRORS
  29. \ SET-ERROR-COUNT called at the end of each test file with address of its
  30. \ own error variable
  31. : SET-ERROR-COUNT ( ad -- )
  32. #ERRORS @ PREV-ERRORS @ - SWAP !
  33. #ERRORS @ PREV-ERRORS !
  34. ;
  35. \ Report summary of errors
  36. 25 CONSTANT MARGIN
  37. : SHOW-ERROR-COUNT ( ad caddr u -- )
  38. CR SWAP OVER TYPE MARGIN - ABS
  39. >R @ ?DUP IF R> .R ELSE R> 1- SPACES [CHAR] - EMIT THEN
  40. ;
  41. : HLINE ( -- ) CR ." ---------------------------" ;
  42. : REPORT-ERRORS
  43. HLINE
  44. CR 8 SPACES ." Error Report"
  45. CR ." Word Set" 13 SPACES ." Errors"
  46. HLINE
  47. CORE-ERRORS S" Core" SHOW-ERROR-COUNT
  48. CORE-EXT-ERRORS S" Core extension" SHOW-ERROR-COUNT
  49. DOUBLE-ERRORS S" Double number" SHOW-ERROR-COUNT
  50. EXCEPTION-ERRORS S" Exception" SHOW-ERROR-COUNT
  51. FACILITY-ERRORS S" Facility" SHOW-ERROR-COUNT
  52. FILE-ERRORS S" File-access" SHOW-ERROR-COUNT
  53. LOCALS-ERRORS S" Locals" SHOW-ERROR-COUNT
  54. MEMORY-ERRORS S" Memory-allocation" SHOW-ERROR-COUNT
  55. TOOLS-ERRORS S" Programming-tools" SHOW-ERROR-COUNT
  56. SEARCHORDER-ERRORS S" Search-order" SHOW-ERROR-COUNT
  57. STRING-ERRORS S" String" SHOW-ERROR-COUNT
  58. HLINE
  59. #ERRORS S" Total" SHOW-ERROR-COUNT
  60. HLINE CR CR
  61. ;