PageRenderTime 43ms CodeModel.GetById 16ms RepoModel.GetById 0ms app.codeStats 1ms

/tests/coreplustest.fth

https://gitlab.com/BGCX261/zmforth-hg-to-git
Forth | 101 lines | 81 code | 20 blank | 0 comment | 1 complexity | 0727ce9e66e56a77e66fd5285ea4ab15 MD5 | raw file
Possible License(s): GPL-3.0
  1. \ More tests on the the ANS Forth Core word set
  2. \ This program is free software; you can redistribute it and/or
  3. \ modify it any way.
  4. \ This program is distributed in the hope that it will be useful,
  5. \ but WITHOUT ANY WARRANTY; without even the implied warranty of
  6. \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  7. \ The tests are not claimed to be comprehensive or correct
  8. \ -----------------------------------------------------------------------------
  9. \ Version 0.2 6 March 2009 { and } replaced with T{ and }T
  10. \ Added extra RECURSE tests
  11. \ 0.1 20 April 2007 Created
  12. \ -----------------------------------------------------------------------------
  13. \ The tests are based on John Hayes test program for the core word set
  14. \ and requires those files to have been loaded
  15. \ This file provides some more tests on Core words where the original Hayes
  16. \ tests are thought to be incomplete
  17. \ Words tested in this file are:
  18. \ DO +LOOP RECURSE
  19. \
  20. \
  21. \ -----------------------------------------------------------------------------
  22. \ Assumptions and dependencies:
  23. \ - tester.fr has been loaded prior to this file
  24. \ -----------------------------------------------------------------------------
  25. DECIMAL
  26. 0 INVERT CONSTANT <true>
  27. 0 CONSTANT <false>
  28. Testing DO +LOOP with run-time increment, negative increment, infinite loop
  29. \ Contributed by Reinhold Straub
  30. VARIABLE iterations
  31. VARIABLE increment
  32. : gd7 ( limit start increment -- )
  33. increment !
  34. 0 iterations !
  35. DO
  36. 1 iterations +!
  37. I
  38. iterations @ 6 = IF LEAVE THEN
  39. increment @
  40. +LOOP iterations @
  41. ;
  42. T{ 4 4 -1 gd7 -> 4 1 }T
  43. T{ 1 4 -1 gd7 -> 4 3 2 1 4 }T
  44. T{ 4 1 -1 gd7 -> 1 0 -1 -2 -3 -4 6 }T
  45. T{ 4 1 0 gd7 -> 1 1 1 1 1 1 6 }T
  46. T{ 0 0 0 gd7 -> 0 0 0 0 0 0 6 }T
  47. T{ 1 4 0 gd7 -> 4 4 4 4 4 4 6 }T
  48. T{ 1 4 1 gd7 -> 4 5 6 7 8 9 6 }T
  49. T{ 4 1 1 gd7 -> 1 2 3 3 }T
  50. T{ 4 4 1 gd7 -> 4 5 6 7 8 9 6 }T
  51. T{ 2 -1 -1 gd7 -> -1 -2 -3 -4 -5 -6 6 }T
  52. T{ -1 2 -1 gd7 -> 2 1 0 -1 4 }T
  53. T{ 2 -1 0 gd7 -> -1 -1 -1 -1 -1 -1 6 }T
  54. T{ -1 2 0 gd7 -> 2 2 2 2 2 2 6 }T
  55. T{ -1 2 1 gd7 -> 2 3 4 5 6 7 6 }T
  56. T{ 2 -1 1 gd7 -> -1 0 1 3 }T
  57. T{ -20 30 -10 gd7 -> 30 20 10 0 -10 -20 6 }T
  58. T{ -20 31 -10 gd7 -> 31 21 11 1 -9 -19 6 }T
  59. T{ -20 29 -10 gd7 -> 29 19 9 -1 -11 5 }T
  60. \ -----------------------------------------------------------------------------
  61. Testing RECURSE with :NONAME
  62. T{ :NONAME ( n -- 0,1,..n ) DUP IF DUP >R 1- RECURSE R> THEN ;
  63. CONSTANT rn1 -> }T
  64. T{ 0 rn1 EXECUTE -> 0 }T
  65. T{ 4 rn1 EXECUTE -> 0 1 2 3 4 }T
  66. Testing multiple RECURSE's in 1 definition
  67. :NONAME ( n -- n1 )
  68. 1- DUP
  69. CASE 0 OF EXIT ENDOF
  70. 1 OF 11 SWAP RECURSE ENDOF
  71. 2 OF 22 SWAP RECURSE ENDOF
  72. 3 OF 33 SWAP RECURSE ENDOF
  73. DROP ABS RECURSE EXIT
  74. endcase
  75. ; CONSTANT rn2
  76. T{ 1 rn2 EXECUTE -> 0 }T
  77. T{ 2 rn2 EXECUTE -> 11 0 }T
  78. T{ 4 rn2 EXECUTE -> 33 22 11 0 }T
  79. T{ 25 rn2 EXECUTE -> 33 22 11 0 }T
  80. \ -----------------------------------------------------------------------------
  81. CR .( End of additional Core tests) CR