TEST.LST 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325
  1. Listing:
  2. 1 MODULE Test;
  3. 2
  4. 3 FROM ModBase3 IMPORT UpdateDBFile,WriteDBRec,DeleteRecord,ReadDBRec,
  5. 4 AppendBlank;
  6. 5 FROM Scrn2DBF IMPORT FrameToDBF, DBFToFrame;
  7. 6 FROM PosUtils IMPORT Equal;
  8. 7 FROM StrEdit IMPORT CrunchBlanks,DeleteRightJustified,CAPstr;
  9. 8 FROM M2Strings IMPORT Length;
  10. 9 FROM LowLevel IMPORT Fill;
  11. 10 FROM StringIO IMPORT PrintMessage;
  12. 11 FROM Drectory IMPORT SetDefaultDrive,ChDir,GetCurrentDir;
  13. 12 FROM EnvironUtils IMPORT ReadEnvironment;
  14. 13 FROM SmartScreen IMPORT ClearScreen;
  15. 14 FROM VWindows IMPORT ClearPart, CurrentWindow, SetCursorHeight;
  16. 15 FROM ScrnTypes IMPORT DisplayFrame,InitDisplayFrame,AFrameName;
  17. 16 FROM FramePainter IMPORT ShowDisplayFrame;
  18. 17 FROM InputManager IMPORT ControlFrame;
  19. 18 FROM FrameManager IMPORT EraseFrame;
  20. 19 FROM Prompts IMPORT Prompt,PromptStr;
  21. 20 FROM SYSTEM IMPORT ADR,SIZE;
  22. 21 FROM ControlUtils IMPORT ControlSeparately, LoadFrameList,Control;
  23. 22 FROM DspFiles IMPORT OpenDisplayFile,ReadDisplayFrame;
  24. 23 FROM HandleIO IMPORT FileExists;
  25. 24 FROM Prompts IMPORT Prompt;
  26. ***** ^ duplicate identifier
  27. ***** ^ duplicate identifier
  28. 25 FROM LowLevel IMPORT Fill;
  29. ***** ^ duplicate identifier
  30. ***** ^ duplicate identifier
  31. 26 FROM GenLists IMPORT GenList, NewList,ListLength,GetElmt;
  32. 27 FROM ScrnTypes IMPORT AFrameName, InitDisplayFrame,DisplayFile;
  33. ***** ^ duplicate identifier
  34. ***** ^ duplicate identifier
  35. ***** ^ duplicate identifier
  36. 28 FROM DBFTest IMPORT TestDBF, OpenTestDBF,
  37. 29 CloseTestDBF,
  38. 30
  39. 31 FindTestByTest,
  40. 32 NextTest,PrevTest,FirstTest,LastTest;
  41. 33 IMPORT InitCompilerMods;
  42. 34
  43. 35
  44. 36 VAR
  45. 37 Status : INTEGER;
  46. 38 Environ : ARRAY [0..60] OF CHAR;
  47. ***** ^ not supported yet
  48. ***** ^ not supported yet
  49. 39 J : CARDINAL;
  50. 40 TopMenu : GenList;
  51. 41 FirstTime: BOOLEAN;
  52. 42 NextFrame,EndingFrame : AFrameName;
  53. 43 SelChar : CHAR;
  54. 44 NoData : BOOLEAN; (* true when no data is on the screen *)
  55. 45 TestDF : DisplayFrame;
  56. 46 DSPFile : DisplayFile;
  57. 47 PullDnMenu : GenList;
  58. 48
  59. 49
  60. 50 PROCEDURE FileMenu(SelChar: CHAR);
  61. 51 VAR
  62. 52 B : BOOLEAN;
  63. 53 Str : ARRAY [0..80] OF CHAR;
  64. ***** ^ not supported yet
  65. ***** ^ not supported yet
  66. 54 BEGIN
  67. 55 CASE SelChar OF
  68. 56 'A' : ReadDisplayFrame(DSPFile,TestDF,'Test'); (*Clear out any of the fields *)
  69. ***** ^ not supported yet
  70. ***** ^ not supported yet
  71. ***** ^ not supported yet
  72. ***** ^ not supported yet
  73. 57 ShowDisplayFrame(TestDF,0,0,0,0);
  74. ***** ^ not supported yet
  75. ***** ^ not supported yet
  76. ***** ^ not supported yet
  77. 58 Control(TestDF); (* alow user input *)
  78. ***** ^ not supported yet
  79. ***** ^ not supported yet
  80. 59 AppendBlank(TestDBF);
  81. ***** ^ not supported yet
  82. ***** ^ not supported yet
  83. 60 B := FrameToDBF(TestDBF,TestDF); (* do something if couldn't add*)
  84. ***** ^ not supported yet
  85. ***** ^ not supported yet
  86. ***** ^ not supported yet
  87. 61 WriteDBRec(TestDBF);
  88. ***** ^ not supported yet
  89. ***** ^ not supported yet
  90. 62 |'F' : FirstTest();
  91. ***** ^ not supported yet
  92. ***** ^ not supported yet
  93. 63 DBFToFrame(TestDBF,TestDF);
  94. ***** ^ not supported yet
  95. ***** ^ not supported yet
  96. ***** ^ not supported yet
  97. 64 ShowDisplayFrame(TestDF,0,0,0,0);
  98. ***** ^ not supported yet
  99. ***** ^ not supported yet
  100. ***** ^ not supported yet
  101. 65 |'L' : LastTest();
  102. ***** ^ not supported yet
  103. ***** ^ not supported yet
  104. 66 DBFToFrame(TestDBF,TestDF);
  105. ***** ^ not supported yet
  106. ***** ^ not supported yet
  107. ***** ^ not supported yet
  108. 67 ShowDisplayFrame(TestDF,0,0,0,0);
  109. ***** ^ not supported yet
  110. ***** ^ not supported yet
  111. ***** ^ not supported yet
  112. 68
  113. 69 |'N' : IF NextTest()
  114. ***** ^ not supported yet
  115. ***** ^ not supported yet
  116. 70 THEN
  117. 71 DBFToFrame(TestDBF,TestDF);
  118. ***** ^ not supported yet
  119. ***** ^ not supported yet
  120. ***** ^ not supported yet
  121. 72 ShowDisplayFrame(TestDF,0,0,0,0);
  122. ***** ^ not supported yet
  123. ***** ^ not supported yet
  124. ***** ^ not supported yet
  125. 73 END;
  126. 74
  127. 75 |'P' : IF PrevTest()
  128. ***** ^ not supported yet
  129. ***** ^ not supported yet
  130. 76 THEN
  131. 77 DBFToFrame(TestDBF,TestDF);
  132. ***** ^ not supported yet
  133. ***** ^ not supported yet
  134. ***** ^ not supported yet
  135. 78 ShowDisplayFrame(TestDF,0,0,0,0);
  136. ***** ^ not supported yet
  137. ***** ^ not supported yet
  138. ***** ^ not supported yet
  139. 79 END;
  140. 80
  141. 81
  142. 82 |'T' : (* The first unused letter in the index name or 'Q' *)
  143. 83 Fill(ADR(Str),SIZE(Str),0);
  144. ***** ^ not supported yet
  145. ***** ^ not supported yet
  146. ***** ^ not supported yet
  147. ***** ^ not supported yet
  148. ***** ^ not supported yet
  149. ***** ^ not supported yet
  150. 84
  151. 85 PromptStr('Enter Test Test ',Str);
  152. ***** ^ not supported yet
  153. ***** ^ not supported yet
  154. ***** ^ not supported yet
  155. 86
  156. 87
  157. 88 CrunchBlanks(Str);
  158. ***** ^ not supported yet
  159. ***** ^ not supported yet
  160. 89 IF NOT FindTestByTest(Str)
  161. ***** ^ not supported yet
  162. ***** ^ not supported yet
  163. 90 THEN
  164. 91 Prompt('Test Not Found');
  165. ***** ^ not supported yet
  166. ***** ^ not supported yet
  167. 92 ELSE
  168. 93 DBFToFrame(TestDBF,TestDF);
  169. ***** ^ not supported yet
  170. ***** ^ not supported yet
  171. ***** ^ not supported yet
  172. 94 ShowDisplayFrame(TestDF,0,0,0,0);
  173. ***** ^ not supported yet
  174. ***** ^ not supported yet
  175. ***** ^ not supported yet
  176. 95 END;
  177. 96 END; (* end of case *)
  178. 97 END FileMenu;
  179. ***** ^ not supported yet
  180. 98
  181. 99 PROCEDURE EditMenu(SelChar : CHAR);
  182. 100 VAR
  183. 101 B:BOOLEAN;
  184. 102 BEGIN
  185. 103 CASE SelChar OF
  186. 104 'U' : Control(TestDF);
  187. ***** ^ not supported yet
  188. ***** ^ not supported yet
  189. 105 B:=FrameToDBF(TestDBF,TestDF);
  190. ***** ^ not supported yet
  191. ***** ^ not supported yet
  192. ***** ^ not supported yet
  193. 106 WriteDBRec(TestDBF);
  194. ***** ^ not supported yet
  195. ***** ^ not supported yet
  196. 107 |'D' : DeleteRecord(TestDBF);
  197. ***** ^ not supported yet
  198. ***** ^ not supported yet
  199. 108 NoData := TRUE;
  200. 109 END;
  201. 110 END EditMenu;
  202. ***** ^ not supported yet
  203. 111
  204. 112
  205. 113 BEGIN
  206. 114
  207. 115 (* if there is an environment variable set to m2test=path *)
  208. 116 (* the program will set the default drive and path *)
  209. 117 (* this is needed because running under the debuggers the *)
  210. 118 (* debugger will start the program with the default drive *)
  211. 119 (* and path = c:\ - aint nothing gona work if looking for *)
  212. 120 (* files there *)
  213. 121 ReadEnvironment('M2TEST', Environ);
  214. ***** ^ not supported yet
  215. ***** ^ not supported yet
  216. ***** ^ not supported yet
  217. 122 CrunchBlanks(Environ);
  218. ***** ^ not supported yet
  219. ***** ^ not supported yet
  220. 123 IF Length(Environ) > 0
  221. ***** ^ not supported yet
  222. ***** ^ not supported yet
  223. 124 THEN
  224. 125 CAPstr(Environ);
  225. ***** ^ not supported yet
  226. ***** ^ not supported yet
  227. 126 IF Environ[1] = ':'
  228. ***** ^ not supported yet
  229. ***** ^ not supported yet
  230. 127 THEN SetDefaultDrive(Environ[0]);
  231. ***** ^ not supported yet
  232. ***** ^ not supported yet
  233. ***** ^ not supported yet
  234. 128 DeleteRightJustified(Environ,0,2);
  235. ***** ^ not supported yet
  236. ***** ^ not supported yet
  237. ***** ^ not supported yet
  238. 129 END;
  239. 130 IF 0#ChDir(Environ)
  240. ***** ^ not supported yet
  241. ***** ^ not supported yet
  242. 131 THEN (* this is bullet proof code here *)
  243. 132 END;
  244. 133 END;
  245. 134
  246. 135 PrintMessage(GetCurrentDir('z',Environ)); (* check *)
  247. ***** ^ not supported yet
  248. ***** ^ not supported yet
  249. ***** ^ not supported yet
  250. 136 IF NOT OpenDisplayFile(DSPFile,'Test.DSP')
  251. ***** ^ not supported yet
  252. ***** ^ not supported yet
  253. ***** ^ not supported yet
  254. 137 THEN
  255. 138 Prompt('Could not open Test.dsp file');
  256. ***** ^ not supported yet
  257. ***** ^ not supported yet
  258. 139 HALT;
  259. ***** ^ undeclared identifier
  260. 140 END;
  261. 141 ClearScreen();
  262. ***** ^ not supported yet
  263. ***** ^ not supported yet
  264. 142 InitDisplayFrame(TestDF,CurrentWindow);
  265. ***** ^ not supported yet
  266. ***** ^ not supported yet
  267. ***** ^ not supported yet
  268. 143 NewList(PullDnMenu);
  269. ***** ^ not supported yet
  270. ***** ^ not supported yet
  271. 144 LoadFrameList(DSPFile,'TopMenu',PullDnMenu);
  272. ***** ^ not supported yet
  273. ***** ^ not supported yet
  274. ***** ^ not supported yet
  275. ***** ^ not supported yet
  276. 145 NoData := TRUE;
  277. 146 OpenTestDBF(TRUE);
  278. ***** ^ not supported yet
  279. ***** ^ not supported yet
  280. 147 ReadDisplayFrame(DSPFile,TestDF,'Test');
  281. ***** ^ not supported yet
  282. ***** ^ not supported yet
  283. ***** ^ not supported yet
  284. ***** ^ not supported yet
  285. 148 REPEAT
  286. 149 NextFrame := 'TopMenu';
  287. ***** ^ not supported yet
  288. ***** ^ not supported yet
  289. 150 ControlSeparately(PullDnMenu,NextFrame,SelChar,EndingFrame);
  290. ***** ^ not supported yet
  291. ***** ^ not supported yet
  292. ***** ^ not supported yet
  293. ***** ^ not supported yet
  294. 151 IF Equal(EndingFrame,'FileMenu')
  295. ***** ^ not supported yet
  296. ***** ^ not supported yet
  297. ***** ^ not supported yet
  298. 152 THEN FileMenu(SelChar);
  299. ***** ^ not supported yet
  300. ***** ^ not supported yet
  301. 153 ELSIF Equal(EndingFrame,'EditMenu')
  302. ***** ^ not supported yet
  303. ***** ^ not supported yet
  304. ***** ^ not supported yet
  305. 154 THEN EditMenu(SelChar);
  306. ***** ^ not supported yet
  307. ***** ^ not supported yet
  308. 155 END;
  309. 156
  310. 157 UNTIL SelChar='X'; (* Assumes 'X' is only used to exit *)
  311. 158 CloseTestDBF();
  312. ***** ^ not supported yet
  313. ***** ^ not supported yet
  314. 159 ClearScreen();
  315. ***** ^ not supported yet
  316. ***** ^ not supported yet
  317. 160
  318. 161
  319. 162
  320. 163 END Test.
  321. 156 errors