Listing: 1 MODULE AddTestF; (* Add Benchmark *) 2 IMPORT InitCompilerMods; 3 4 FROM ModBase3 IMPORT DBFile, CloseDBF, DBFieldDescriptor, 5 BuildDBF,Record,DefaultFixUp,AppendBlank, WriteDBRec,InitDBF; 6 FROM DBIndxes IMPORT DBIndex, BuildIndex, InitIndex, CloseIndex, 7 AddRecord, FindPositionCh,SetSafetyOff, 8 AddToUpdateList,SetIndexBuffers,InsertEntry; 9 FROM DBFields IMPORT Replace; 10 FROM Timing IMPORT BeginTimer, ShowUsage; 11 12 13 FROM InOut IMPORT WriteCard; 14 (* FROM Random IMPORT RandomInit, RandomCard;*) 15 FROM Lib IMPORT RANDOM; 16 17 18 19 PROCEDURE RandStr(VAR S : ARRAY OF CHAR); ***** ^ not supported yet 20 (* Generate a string of random letters with a random length *) 21 VAR 22 I : CARDINAL; 23 Len : CARDINAL; 24 BEGIN 25 Len := 1 + (*RandomCard*)RANDOM(HIGH(S)+1) ; (* random 1 to 30 Len *) ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 26 FOR I := 0 TO Len - 1 DO 27 S[I] := CHR((*RandomCard*)RANDOM(26)+65); (* random letters *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 28 END (* for *); 29 FOR I := Len TO HIGH(S) DO (* ModBase requires space padded keys *) ***** ^ undeclared identifier ***** ^ not supported yet 30 S[I] := ' '; (* instead of a 0C terminated string *) ***** ^ not supported yet ***** ^ not supported yet 31 END (* if *); 32 END RandStr; ***** ^ not supported yet 33 (* was keylen=30 buffers 400 *) 34 CONST 35 KeyLen = 30; 36 Buffers = 400; 37 TYPE 38 KeyStr = ARRAY [0..KeyLen-1] OF CHAR; ***** ^ not supported yet ***** ^ not supported yet 39 40 VAR 41 DBF : DBFile; 42 Fields : ARRAY [1..2] OF DBFieldDescriptor; ***** ^ not supported yet ***** ^ not supported yet 43 NDX : DBIndex; 44 I : CARDINAL; 45 Name : KeyStr; ***** ^ not supported yet 46 Found : BOOLEAN; 47 48 BEGIN 49 BeginTimer(); (* start timer counting *) ***** ^ not supported yet ***** ^ not supported yet 50 (* RandomInit(1);*) 51 WITH Fields[1] DO ***** ^ not supported yet ***** ^ not supported yet 52 name := "NAME"; ***** ^ undeclared identifier ***** ^ not supported yet 53 size := 30; ***** ^ undeclared identifier 54 fldtype := 'C'; ***** ^ undeclared identifier 55 END (* with *); ***** ^ not supported yet 56 WITH Fields[2] DO ***** ^ not supported yet ***** ^ not supported yet 57 name := "PHONE"; ***** ^ undeclared identifier ***** ^ not supported yet 58 size := 13; ***** ^ undeclared identifier 59 fldtype := 'C'; ***** ^ undeclared identifier 60 END (* with *); ***** ^ not supported yet 61 InitDBF('ModBase.DBF', DBF,40000,FALSE,TRUE,FALSE,DefaultFixUp); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 62 InitIndex('ModBase.NDX',NDX,DBF,Buffers,FALSE,TRUE); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 63 IF BuildDBF( Fields,2, DBF)=0 THEN END; (* Create empty DBF file *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 64 IF BuildIndex(NDX, 'NAME')=0 THEN END ; (* create initial empty index *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 65 (* AddToUpdateList(DBF,NDX);*) 66 FOR I := 1 TO 5000 DO 67 WriteCard(I, 8); ***** ^ not supported yet ***** ^ not supported yet 68 REPEAT (* generate random keys *) 69 RandStr(Name); ***** ^ not supported yet ***** ^ not supported yet 70 FindPositionCh(NDX, Name, Found); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 71 UNTIL NOT Found; (* until not already added *) 72 AppendBlank(DBF); ***** ^ not supported yet ***** ^ not supported yet 73 Replace(DBF, 1, Name); (* store key in record *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 74 WriteDBRec(DBF); ***** ^ not supported yet ***** ^ not supported yet 75 InsertEntry(NDX,Name,Record(DBF)); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 76 (* add record to data file *) 77 (* AddRecord(DBF, NDX); *) 78 (* (* all ok now but good for diag*) 79 FindPositionCh(NDX, Name, Found); 80 IF NOT Found THEN 81 HALT; 82 END (* if *); 83 *) 84 END (* for *); 85 CloseIndex(NDX); ***** ^ not supported yet ***** ^ not supported yet 86 CloseDBF(DBF); ***** ^ not supported yet ***** ^ not supported yet 87 ShowUsage('add test'); (* display elaped time in seconds *) ***** ^ not supported yet ***** ^ not supported yet 88 END AddTestF. 89 78 errors