/anstests/searchordertest.fth

https://github.com/jamesbowman/swapforth · Forth · 182 lines · 98 code · 39 blank · 45 comment · 2 complexity · b4940065323e0106030ebfe880d24fc7 MD5 · raw file

  1. \ To test the ANS Forth search-order word set and search order extensions
  2. \ This program was written by Gerry Jackson in 2006, with contributions from
  3. \ others where indicated, and is in the public domain - it can be distributed
  4. \ and/or modified in any way but please retain this notice.
  5. \ This program is distributed in the hope that it will be useful,
  6. \ but WITHOUT ANY WARRANTY; without even the implied warranty of
  7. \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  8. \ The tests are not claimed to be comprehensive or correct
  9. \ ------------------------------------------------------------------------------
  10. \ Version 0.10 3 August 2014 Name changes to remove redefinition messages
  11. \ "list" changed to "wordlist" in message for ORDER tests
  12. \ 0.5 1 April 2012 Tests placed in the public domain.
  13. \ 0.4 6 March 2009 { and } replaced with T{ and }T
  14. \ 0.3 20 April 2007 ANS Forth words changed to upper case
  15. \ 0.2 30 Oct 2006 updated following GForth tests to get
  16. \ initial search order into a known state
  17. \ 0.1 Oct 2006 First version released
  18. \ ------------------------------------------------------------------------------
  19. \ The tests are based on John Hayes test program for the core word set
  20. \ and requires those files to have been loaded
  21. \ Words tested in this file are:
  22. \ FORTH-WORDLIST GET-ORDER SET-ORDER ALSO ONLY FORTH GET-CURRENT
  23. \ SET-CURRENT DEFINITIONS PREVIOUS SEARCH-WORDLIST WORDLIST FIND
  24. \ Words not fully tested:
  25. \ ORDER only tests that it executes, display is implementation
  26. \ dependent and should be visually inspected
  27. \ ------------------------------------------------------------------------------
  28. \ Assumptions and dependencies:
  29. \ - tester.fr or ttester.fs has been loaded prior to this file
  30. \ - that ONLY FORTH DEFINITIONS will work at the start of the file
  31. \ to ensure the search order is in a known state
  32. \ ------------------------------------------------------------------------------
  33. ONLY FORTH DEFINITIONS
  34. TESTING Search-order word set
  35. DECIMAL
  36. VARIABLE WID1 VARIABLE WID2
  37. : SAVE-ORDERLIST ( widn ... wid1 n -> ) DUP , 0 ?DO , LOOP ;
  38. \ ------------------------------------------------------------------------------
  39. TESTING FORTH-WORDLIST GET-ORDER SET-ORDER
  40. T{ FORTH-WORDLIST WID1 ! -> }T
  41. CREATE ORDER-LIST
  42. T{ GET-ORDER SAVE-ORDERLIST -> }T
  43. : GET-ORDERLIST ( -- widn ... wid1 n )
  44. ORDER-LIST DUP @ CELLS ( -- ad n )
  45. OVER + ( -- ad ad' )
  46. ?DO I @ -1 CELLS +LOOP ( -- )
  47. ;
  48. T{ GET-ORDER OVER -> GET-ORDER WID1 @ }T \ Forth wordlist at top
  49. T{ GET-ORDER SET-ORDER -> }T \ Effectively noop
  50. T{ GET-ORDER -> GET-ORDERLIST }T \ Check nothing changed
  51. T{ GET-ORDERLIST DROP GET-ORDERLIST 2* SET-ORDER -> }T
  52. T{ GET-ORDER -> GET-ORDERLIST DROP GET-ORDERLIST 2* }T
  53. T{ GET-ORDERLIST SET-ORDER GET-ORDER -> GET-ORDERLIST }T
  54. \ ------------------------------------------------------------------------------
  55. TESTING ALSO ONLY FORTH
  56. T{ ALSO GET-ORDER -> GET-ORDERLIST OVER SWAP 1+ }T
  57. T{ ONLY FORTH GET-ORDER -> GET-ORDERLIST }T \ See assumptions above
  58. \ ------------------------------------------------------------------------------
  59. TESTING GET-CURRENT SET-CURRENT WORDLIST (simple)
  60. T{ GET-CURRENT -> WID1 @ }T \ See assumptions above
  61. T{ WORDLIST WID2 ! -> }T
  62. T{ WID2 @ SET-CURRENT -> }T
  63. T{ GET-CURRENT -> WID2 @ }T
  64. T{ WID1 @ SET-CURRENT -> }T
  65. \ ------------------------------------------------------------------------------
  66. TESTING minimum search order list contains FORTH-WORDLIST and SET-ORDER
  67. : SO1 SET-ORDER ; \ In case it is unavailable in the forth wordlist
  68. T{ ONLY FORTH-WORDLIST 1 SET-ORDER GET-ORDERLIST SO1 -> }T
  69. T{ GET-ORDER -> GET-ORDERLIST }T
  70. \ ------------------------------------------------------------------------------
  71. TESTING GET-ORDER SET-ORDER with 0 and -1 number of wids argument
  72. : SO2A GET-ORDER GET-ORDERLIST SET-ORDER ; \ To recover search order
  73. : SO2 0 SET-ORDER SO2A ;
  74. T{ SO2 -> 0 }T \ 0 set-order leaves an empty search order
  75. : SO3 -1 SET-ORDER SO2A ;
  76. : SO4 ONLY SO2A ;
  77. T{ SO3 -> SO4 }T \ -1 SET-ORDER = ONLY
  78. \ ------------------------------------------------------------------------------
  79. TESTING DEFINITIONS PREVIOUS
  80. T{ ONLY FORTH DEFINITIONS -> }T
  81. T{ GET-CURRENT -> FORTH-WORDLIST }T
  82. T{ GET-ORDER WID2 @ SWAP 1+ SET-ORDER DEFINITIONS GET-CURRENT -> WID2 @ }T
  83. T{ GET-ORDER -> GET-ORDERLIST WID2 @ SWAP 1+ }T
  84. T{ PREVIOUS GET-ORDER -> GET-ORDERLIST }T
  85. T{ DEFINITIONS GET-CURRENT -> FORTH-WORDLIST }T
  86. \ ------------------------------------------------------------------------------
  87. TESTING SEARCH-WORDLIST WORDLIST FIND
  88. ONLY FORTH DEFINITIONS
  89. VARIABLE XT ' DUP XT !
  90. VARIABLE XTI ' .( XTI ! \ Immediate word
  91. T{ S" DUP" WID1 @ SEARCH-WORDLIST -> XT @ -1 }T
  92. T{ S" .(" WID1 @ SEARCH-WORDLIST -> XTI @ 1 }T
  93. T{ S" DUP" WID2 @ SEARCH-WORDLIST -> 0 }T
  94. : C"DUP" C" DUP" ;
  95. : C".(" C" .(" ;
  96. : C"X" C" UNKNOWN WORD" ;
  97. T{ C"DUP" FIND -> XT @ -1 }T
  98. T{ C".(" FIND -> XTI @ 1 }T
  99. T{ C"X" FIND -> C"X" 0 }T
  100. \ ------------------------------------------------------------------------------
  101. TESTING new definitions are put into the correct wordlist
  102. : ALSOWID2 ALSO GET-ORDER WID2 @ ROT DROP SWAP SET-ORDER ;
  103. ALSOWID2
  104. : W2 1234 ;
  105. DEFINITIONS
  106. : W2 -9876 ; IMMEDIATE
  107. ONLY FORTH
  108. T{ W2 -> 1234 }T
  109. DEFINITIONS
  110. T{ W2 -> 1234 }T
  111. ALSOWID2
  112. T{ W2 -> -9876 }T
  113. DEFINITIONS
  114. T{ W2 -> -9876 }T
  115. ONLY FORTH DEFINITIONS
  116. : SO5 DUP IF SWAP EXECUTE THEN ;
  117. T{ S" W2" WID1 @ SEARCH-WORDLIST SO5 -> -1 1234 }T
  118. T{ S" W2" WID2 @ SEARCH-WORDLIST SO5 -> 1 -9876 }T
  119. : C"W2" C" W2" ;
  120. T{ ALSOWID2 C"W2" FIND SO5 -> 1 -9876 }T
  121. T{ PREVIOUS C"W2" FIND SO5 -> -1 1234 }T
  122. \ ------------------------------------------------------------------------------
  123. TESTING ORDER \ Should display search order and compilation wordlist
  124. CR .( ONLY FORTH DEFINITIONS search order and compilation wordlist) CR
  125. T{ ONLY FORTH DEFINITIONS ORDER -> }T
  126. CR .( Plus another unnamed wordlist at the head of the search order) CR
  127. T{ ALSOWID2 DEFINITIONS ORDER -> }T
  128. \ ------------------------------------------------------------------------------
  129. SEARCHORDER-ERRORS SET-ERROR-COUNT
  130. CR .( End of Search Order word tests) CR
  131. ONLY FORTH DEFINITIONS \ Leave search order in the standard state