ADDTEST.LST 6.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179
  1. Listing:
  2. 1 MODULE AddTest; (* Add Benchmark *)
  3. 2 (* IMPORT PMD; *)
  4. 3 IMPORT InitCompilerMods;
  5. 4 FROM ErrorManager IMPORT WARN;
  6. 5 FROM ModBase3 IMPORT DBFile, CloseDBF, DBFieldDescriptor,
  7. 6 BuildDBF, AppendBlank, WriteDBRec,InitDBF,DefaultFixUp;
  8. 7 FROM DBIndxes IMPORT DBIndex, BuildIndex, InitIndex, CloseIndex,
  9. 8 AddRecord, FindPositionCh,SetSafetyOff,
  10. 9 AddToUpdateList,SetIndexBuffers;
  11. 10 FROM DBFields IMPORT Replace;
  12. 11 FROM Timing IMPORT BeginTimer, ShowUsage;
  13. 12
  14. 13
  15. 14 FROM InOut IMPORT WriteCard;
  16. 15 FROM Rand IMPORT RandomInit, RandomCard;
  17. 16 (* FROM Lib IMPORT RANDOM;*)
  18. 17
  19. 18
  20. 19
  21. 20 PROCEDURE RandStr(VAR S : ARRAY OF CHAR);
  22. ***** ^ not supported yet
  23. 21 (* Generate a string of random letters with a random length *)
  24. 22 VAR
  25. 23 I : CARDINAL;
  26. 24 Len : CARDINAL;
  27. 25 BEGIN
  28. 26 Len := 1 + RandomCard(*RANDOM*)(HIGH(S)+1) ; (* random 1 to 30 Len *)
  29. ***** ^ not supported yet
  30. ***** ^ undeclared identifier
  31. ***** ^ not supported yet
  32. ***** ^ not supported yet
  33. 27 FOR I := 0 TO Len - 1 DO
  34. 28 S[I] := CHR(RandomCard(*RANDOM*)(26)+65); (* random letters *)
  35. ***** ^ not supported yet
  36. ***** ^ not supported yet
  37. ***** ^ undeclared identifier
  38. ***** ^ not supported yet
  39. ***** ^ not supported yet
  40. ***** ^ not supported yet
  41. 29 END (* for *);
  42. 30 FOR I := Len TO HIGH(S) DO (* ModBase requires space padded keys *)
  43. ***** ^ undeclared identifier
  44. ***** ^ not supported yet
  45. 31 S[I] := ' '; (* instead of a 0C terminated string *)
  46. ***** ^ not supported yet
  47. ***** ^ not supported yet
  48. 32 END (* if *);
  49. 33 END RandStr;
  50. ***** ^ not supported yet
  51. 34 (* was keylen=30 buffers 400 *)
  52. 35 CONST
  53. 36 KeyLen = 30;
  54. 37 Buffers = 400;
  55. 38 TYPE
  56. 39 KeyStr = ARRAY [0..KeyLen-1] OF CHAR;
  57. ***** ^ not supported yet
  58. ***** ^ not supported yet
  59. 40
  60. 41 VAR
  61. 42 DBF : DBFile;
  62. 43 Fields : ARRAY [1..2] OF DBFieldDescriptor;
  63. ***** ^ not supported yet
  64. ***** ^ not supported yet
  65. 44 NDX : DBIndex;
  66. 45 I : CARDINAL;
  67. 46 Name : KeyStr;
  68. ***** ^ not supported yet
  69. 47 Found : BOOLEAN;
  70. 48
  71. 49 BEGIN
  72. 50 BeginTimer(); (* start timer counting *)
  73. ***** ^ not supported yet
  74. ***** ^ not supported yet
  75. 51 RandomInit(1);
  76. ***** ^ not supported yet
  77. ***** ^ not supported yet
  78. 52 WITH Fields[1] DO
  79. ***** ^ not supported yet
  80. ***** ^ not supported yet
  81. 53 name := "NAME";
  82. ***** ^ undeclared identifier
  83. ***** ^ not supported yet
  84. 54 size := 30;
  85. ***** ^ undeclared identifier
  86. 55 fldtype := 'C';
  87. ***** ^ undeclared identifier
  88. 56 END (* with *);
  89. ***** ^ not supported yet
  90. 57 WITH Fields[2] DO
  91. ***** ^ not supported yet
  92. ***** ^ not supported yet
  93. 58 name := "PHONE";
  94. ***** ^ undeclared identifier
  95. ***** ^ not supported yet
  96. 59 size := 13;
  97. ***** ^ undeclared identifier
  98. 60 fldtype := 'C';
  99. ***** ^ undeclared identifier
  100. 61 END (* with *);
  101. ***** ^ not supported yet
  102. 62 InitDBF('ModBase.DBF', DBF,40000,FALSE,TRUE,FALSE,DefaultFixUp);
  103. ***** ^ not supported yet
  104. ***** ^ not supported yet
  105. ***** ^ not supported yet
  106. ***** ^ not supported yet
  107. 63 InitIndex('ModBase.NDX',NDX,DBF,Buffers,FALSE,TRUE,TRUE);
  108. ***** ^ not supported yet
  109. ***** ^ not supported yet
  110. ***** ^ not supported yet
  111. ***** ^ not supported yet
  112. ***** ^ not supported yet
  113. 64 IF BuildDBF( Fields,2, DBF)#0 THEN
  114. ***** ^ not supported yet
  115. ***** ^ not supported yet
  116. ***** ^ not supported yet
  117. 65 WARN('Unable to create modbase.dbf');
  118. ***** ^ not supported yet
  119. ***** ^ not supported yet
  120. 66 END; (* Create empty DBF file *)
  121. 67 IF BuildIndex(NDX, 'NAME')#0 (* create initial empty index *)
  122. ***** ^ not supported yet
  123. ***** ^ not supported yet
  124. ***** ^ not supported yet
  125. 68 THEN WARN('unable to get excluse access to index') END;
  126. ***** ^ not supported yet
  127. ***** ^ not supported yet
  128. 69 AddToUpdateList(DBF,NDX);
  129. ***** ^ not supported yet
  130. ***** ^ not supported yet
  131. ***** ^ not supported yet
  132. 70 FOR I := 1 TO 5000 DO
  133. 71 WriteCard(I, 8);
  134. ***** ^ not supported yet
  135. ***** ^ not supported yet
  136. 72 REPEAT (* generate random keys *)
  137. 73 RandStr(Name);
  138. ***** ^ not supported yet
  139. ***** ^ not supported yet
  140. 74 FindPositionCh(NDX, Name, Found);
  141. ***** ^ not supported yet
  142. ***** ^ not supported yet
  143. ***** ^ not supported yet
  144. ***** ^ not supported yet
  145. 75 UNTIL NOT Found; (* until not already added *)
  146. 76 AppendBlank(DBF);
  147. ***** ^ not supported yet
  148. ***** ^ not supported yet
  149. 77 Replace(DBF, 1, Name); (* store key in record *)
  150. ***** ^ not supported yet
  151. ***** ^ not supported yet
  152. ***** ^ not supported yet
  153. 78 WriteDBRec(DBF); (* add record to data file *)
  154. ***** ^ not supported yet
  155. ***** ^ not supported yet
  156. 79 (* AddRecord(DBF, NDX); *)
  157. 80 (* (* all ok now but good for diag*)
  158. 81 FindPositionCh(NDX, Name, Found);
  159. 82 IF NOT Found THEN
  160. 83 HALT;
  161. 84 END (* if *);
  162. 85 *)
  163. 86 END (* for *);
  164. 87 CloseIndex(NDX);
  165. ***** ^ not supported yet
  166. ***** ^ not supported yet
  167. 88 CloseDBF(DBF);
  168. ***** ^ not supported yet
  169. ***** ^ not supported yet
  170. 89 ShowUsage('add test'); (* display elaped time in seconds *)
  171. ***** ^ not supported yet
  172. ***** ^ not supported yet
  173. 90 END AddTest.
  174. 91
  175. 82 errors