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