dbdigest.pp 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805
  1. {
  2. This file is part of the Free Pascal test suite.
  3. Copyright (c) 2002 by the Free Pascal development team.
  4. This program inserts the last tests run
  5. into TESTSUITE database.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {$mode objfpc}
  13. {$h+}
  14. {$ifndef win32}
  15. {$linklib pthread}
  16. {$endif}
  17. program dbdigest;
  18. uses
  19. sysutils,teststr,testu,tresults,dbtests;
  20. Var
  21. StatusCount : Array[TTestStatus] of Integer;
  22. UnknownLines : integer;
  23. Procedure ExtractTestFileName(Var Line : string);
  24. Var I : integer;
  25. begin
  26. I:=Pos(' ',Line);
  27. If (I<>0) then
  28. Line:=Copy(Line,1,I-1);
  29. end;
  30. Function Analyse(Var Line : string; Var Status : TTestStatus) : Boolean;
  31. Var
  32. TS : TTestStatus;
  33. begin
  34. Result:=False;
  35. For TS:=FirstStatus to LastStatus do
  36. begin
  37. Result:=Pos(StatusText[TS],Line)=1;
  38. If Result then
  39. begin
  40. Status:=TS;
  41. Delete(Line,1,Length(StatusText[TS]));
  42. ExtractTestFileName(Line);
  43. Break;
  44. end;
  45. end;
  46. end;
  47. Type
  48. TConfigOpt = (
  49. coDatabaseName,
  50. coHost,
  51. coUserName,
  52. coPassword,
  53. coPort,
  54. coLogFile,
  55. coLongLogFile,
  56. coOS,
  57. coCPU,
  58. coCategory,
  59. coVersion,
  60. coDate,
  61. coSubmitter,
  62. coMachine,
  63. coComment,
  64. coTestSrcDir,
  65. coRelSrcDir,
  66. coVerbose,
  67. coSQL
  68. );
  69. { Additional options only for dbdigest.cfg file }
  70. TConfigAddOpt = (
  71. coCompilerDate,
  72. coCompilerFullVersion,
  73. coSvnCompilerRevision,
  74. coSvnTestsRevision,
  75. coSvnRTLRevision,
  76. coSvnPackagesRevision
  77. );
  78. Const
  79. ConfigStrings : Array [TConfigOpt] of string = (
  80. 'databasename',
  81. 'host',
  82. 'username',
  83. 'password',
  84. 'port',
  85. 'logfile',
  86. 'longlogfile',
  87. 'os',
  88. 'cpu',
  89. 'category',
  90. 'version',
  91. 'date',
  92. 'submitter',
  93. 'machine',
  94. 'comment',
  95. 'testsrcdir',
  96. 'relsrcdir',
  97. 'verbose',
  98. 'sql'
  99. );
  100. ConfigOpts : Array[TConfigOpt] of char =(
  101. 'd', { coDatabaseName }
  102. 'h', { coHost }
  103. 'u', { coUserName }
  104. 'p', { coPassword }
  105. 'P', { coPort }
  106. 'l', { coLogFile }
  107. 'L', { coLongLogFile }
  108. 'o', { coOS }
  109. 'c', { coCPU }
  110. 'a', { coCategory }
  111. 'v', { coVersion }
  112. 't', { coDate }
  113. 's', { coSubmitter }
  114. 'm', { coMachine }
  115. 'C', { coComment }
  116. 'S', { coTestSrcDir }
  117. 'r', { coRelSrcDir }
  118. 'V', { coVerbose }
  119. 'Q' { coSQL }
  120. );
  121. ConfigAddStrings : Array [TConfigAddOpt] of string = (
  122. 'compilerdate',
  123. 'compilerfullversion',
  124. 'svncompilerrevision',
  125. 'svntestsrevision',
  126. 'svnrtlrevision',
  127. 'svnpackagesrevision'
  128. );
  129. ConfigAddCols : Array [TConfigAddOpt] of string = (
  130. 'TU_COMPILERDATE',
  131. 'TU_COMPILERFULLVERSION',
  132. 'TU_SVNCOMPILERREVISION',
  133. 'TU_SVNTESTSREVISION',
  134. 'TU_SVNRTLREVISION',
  135. 'TU_SVNPACKAGESREVISION'
  136. );
  137. Var
  138. TestOS,
  139. TestCPU,
  140. TestVersion,
  141. TestCategory,
  142. DatabaseName,
  143. HostName,
  144. UserName,
  145. Password,
  146. Port,
  147. LongLogFileName,
  148. LogFileName,
  149. Submitter,
  150. Machine,
  151. Comment : String;
  152. TestDate : TDateTime;
  153. TestCompilerDate,
  154. TestCompilerFullVersion,
  155. TestSvnCompilerRevision,
  156. TestSvnTestsRevision,
  157. TestSvnRTLRevision,
  158. TestSvnPackagesRevision : String;
  159. Procedure SetAddOpt (O : TConfigAddOpt; Value : string);
  160. begin
  161. Case O of
  162. coCompilerDate:
  163. TestCompilerDate:=Value;
  164. coCompilerFullVersion:
  165. TestCompilerFullVersion:=Value;
  166. coSvnCompilerRevision:
  167. TestSvnCompilerRevision:=Value;
  168. coSvnTestsRevision:
  169. TestSvnTestsRevision:=Value;
  170. coSvnRTLRevision:
  171. TestSvnRTLRevision:=Value;
  172. coSvnPackagesRevision:
  173. TestSvnPackagesRevision:=Value;
  174. end;
  175. end;
  176. Procedure SetOpt (O : TConfigOpt; Value : string);
  177. var
  178. year,month,day,min,hour : word;
  179. begin
  180. Case O of
  181. coDatabaseName : DatabaseName:=Value;
  182. coHost : HostName:=Value;
  183. coUserName : UserName:=Value;
  184. coPassword : Password:=Value;
  185. coPort : Port:=Value;
  186. coLogFile : LogFileName:=Value;
  187. coLongLogFile : LongLogFileName:=Value;
  188. coOS : TestOS:=Value;
  189. coCPU : TestCPU:=Value;
  190. coCategory : TestCategory:=Value;
  191. coVersion : TestVersion:=Value;
  192. coSQL : DoSQL:=True;
  193. coDate :
  194. begin
  195. { Formated like YYYYMMDDhhmm }
  196. if Length(value)=12 then
  197. begin
  198. year:=StrToInt(Copy(value,1,4));
  199. month:=StrToInt(Copy(value,5,2));
  200. day:=StrToInt(Copy(Value,7,2));
  201. hour:=StrToInt(Copy(Value,9,2));
  202. min:=StrToInt(Copy(Value,11,2));
  203. TestDate:=EncodeDate(year,month,day)+EncodeTime(hour,min,0,0);
  204. end
  205. else
  206. Verbose(V_Error,'Error in date format, use YYYYMMDDhhmm');
  207. end;
  208. coSubmitter : Submitter:=Value;
  209. coMachine : Machine:=Value;
  210. coComment : Comment:=Value;
  211. coVerbose : DoVerbose:=true;
  212. coTestSrcDir :
  213. begin
  214. TestSrcDir:=Value;
  215. if (TestSrcDir<>'') and (TestSrcDir[length(TestSrcDir)]<>'/') then
  216. TestSrcDir:=TestSrcDir+'/';
  217. end;
  218. coRelSrcDir :
  219. begin
  220. RelSrcDir:=Value;
  221. if (RelSrcDir<>'') and (RelSrcDir[length(RelSrcDir)]<>'/') then
  222. RelSrcDir:=RelSrcDir+'/';
  223. if (RelSrcDir<>'') and (RelSrcDir[1]='/') then
  224. RelSrcDir:=copy(RelSrcDir,2,length(RelSrcDir)-1);
  225. end;
  226. end;
  227. end;
  228. Function ProcessOption(S: String) : Boolean;
  229. Var
  230. N : String;
  231. I : Integer;
  232. co : TConfigOpt;
  233. coa : TConfigAddOpt;
  234. begin
  235. Verbose(V_DEBUG,'Processing option: '+S);
  236. I:=Pos('=',S);
  237. Result:=(I<>0);
  238. If Result then
  239. begin
  240. N:=Copy(S,1,I-1);
  241. Delete(S,1,I);
  242. For co:=low(TConfigOpt) to high(TConfigOpt) do
  243. begin
  244. Result:=CompareText(ConfigStrings[co],N)=0;
  245. If Result then
  246. begin
  247. SetOpt(co,S);
  248. Exit;
  249. end;
  250. end;
  251. For coa:=low(TConfigAddOpt) to high(TConfigAddOpt) do
  252. begin
  253. Result:=CompareText(ConfigAddStrings[coa],N)=0;
  254. If Result then
  255. begin
  256. SetAddOpt(coa,S);
  257. Exit;
  258. end;
  259. end;
  260. end;
  261. Verbose(V_ERROR,'Unknown option : '+n+S);
  262. end;
  263. Procedure ProcessConfigfile(FN : String);
  264. Var
  265. F : Text;
  266. S : String;
  267. I : Integer;
  268. begin
  269. // Set the default value for old digests without RelSrcDir to the rtl/compiler
  270. // testsuite
  271. RelSrcDir:='tests/';
  272. If Not FileExists(FN) Then
  273. Exit;
  274. Verbose(V_DEBUG,'Parsing config file: '+FN);
  275. Assign(F,FN);
  276. {$i-}
  277. Reset(F);
  278. If IOResult<>0 then
  279. Exit;
  280. {$I+}
  281. While not(EOF(F)) do
  282. begin
  283. ReadLn(F,S);
  284. S:=trim(S);
  285. I:=Pos('#',S);
  286. If I<>0 then
  287. S:=Copy(S,1,I-1);
  288. If (S<>'') then
  289. ProcessOption(S);
  290. end;
  291. Close(F);
  292. end;
  293. Procedure ProcessCommandLine;
  294. Var
  295. I : Integer;
  296. O : String;
  297. c,co : TConfigOpt;
  298. ShortOptFound, Found : Boolean;
  299. begin
  300. I:=1;
  301. While I<=ParamCount do
  302. begin
  303. O:=Paramstr(I);
  304. ShortOptFound:=(Length(O)=2) and (O[1]='-');
  305. If ShortOptFound then
  306. For co:=low(TConfigOpt) to high(TConfigOpt) do
  307. begin
  308. Found:=(O[2]=ConfigOpts[co]);
  309. If Found then
  310. begin
  311. c:=co;
  312. Break;
  313. end;
  314. end;
  315. If not ShortOptFound then
  316. begin
  317. Found:=false;
  318. { accept long options }
  319. if (copy(O,1,2)='--') then
  320. begin
  321. { remove -- }
  322. O:=copy(O,3,length(O));
  323. For co:=low(TConfigOpt) to high(TConfigOpt) do
  324. begin
  325. Found:=(O=ConfigStrings[co]);
  326. If Found then
  327. begin
  328. c:=co;
  329. Break;
  330. end;
  331. end;
  332. end
  333. end;
  334. if not Found then
  335. Verbose(V_ERROR,'Illegal command-line option : '+O)
  336. else
  337. begin
  338. if c=coverbose then
  339. begin
  340. Found:=true;
  341. o:='';
  342. end
  343. else
  344. Found:=(I<ParamCount);
  345. If Not found then
  346. Verbose(V_ERROR,'Option requires argument : '+O)
  347. else
  348. begin
  349. inc(I);
  350. O:=Paramstr(I);
  351. SetOpt(c,o);
  352. end;
  353. end;
  354. Inc(I);
  355. end;
  356. end;
  357. Var
  358. TestCPUID : Integer;
  359. TestOSID : Integer;
  360. TestVersionID : Integer;
  361. TestCategoryID : Integer;
  362. TestRunID : Integer;
  363. ConfigID : Integer;
  364. Procedure GetIDs;
  365. var
  366. qry : string;
  367. begin
  368. TestCPUID := GetCPUId(TestCPU);
  369. If TestCPUID=-1 then
  370. Verbose(V_Error,'NO ID for CPU "'+TestCPU+'" found.');
  371. TestOSID := GetOSID(TestOS);
  372. If TestOSID=-1 then
  373. Verbose(V_Error,'NO ID for OS "'+TestOS+'" found.');
  374. TestCategoryID := GetCategoryID(TestCategory);
  375. If TestCategoryID=-1 then
  376. begin
  377. // Verbose(V_Error,'NO ID for Category "'+TestCategory+'" found.');
  378. TestCategoryID:=1;
  379. end;
  380. TestVersionID := GetVersionID(TestVersion);
  381. If TestVersionID=-1 then
  382. Verbose(V_Error,'NO ID for version "'+TestVersion+'" found.');
  383. If (Round(TestDate)=0) then
  384. Testdate:=Now;
  385. TestRunID:=GetRunID(TestOSID,TestCPUID,TestVersionID,TestDate);
  386. If (TestRunID=-1) then
  387. begin
  388. TestRunID:=AddRun(TestOSID,TestCPUID,TestVersionID,TestCategoryID,TestDate);
  389. If TestRunID=-1 then
  390. Verbose(V_Error,'Could not insert new testrun record!');
  391. end
  392. else
  393. CleanTestRun(TestRunID);
  394. { Add known infomration at start }
  395. qry:=format('UPDATE TESTRUN SET TU_SUBMITTER=''%s'', TU_MACHINE=''%s'', TU_COMMENT=''%s'', TU_DATE=''%s''',[Submitter,Machine,Comment,SqlDate(TestDate)]);
  396. qry:=qry+' WHERE TU_ID='+format('%d',[TestRunID]);
  397. ExecuteQuery(Qry,False);
  398. end;
  399. var
  400. LongLogFile : Text;
  401. const
  402. UseLongLog : boolean = false;
  403. LongLogOpenCount : longint = 0;
  404. FirstLongLogLine : boolean = true;
  405. const
  406. SeparationLine = '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>';
  407. Function GetContentsFromLongLog(Line : String) : String;
  408. var
  409. S : String;
  410. IsFirst, IsFound : boolean;
  411. begin
  412. Result:='';
  413. IsFirst:=true;
  414. IsFound:=false;
  415. While Not(EOF(LongLogFile)) do
  416. begin
  417. ReadLn(LongLogFile,S);
  418. if FirstLongLogLine then
  419. begin
  420. { At start of file there is a separation line }
  421. if (pos(Line,S)=0) and (pos(SeparationLine,S)>=1) then
  422. Readln(LongLogFile,S);
  423. FirstLongLogLine:=false;
  424. end;
  425. if pos(Line,S)=1 then
  426. begin
  427. IsFound:=true;
  428. while not eof(LongLogFile) do
  429. begin
  430. ReadLn(LongLogFile,S);
  431. { End of file marker }
  432. if eof(LongLogFile) or (pos(SeparationLine,S)=1) then
  433. exit;
  434. if length(Result)<MaxLogSize then
  435. Result:=Result+S+LineEnding;
  436. if pos(SeparationLine,S)>1 then
  437. exit;
  438. end;
  439. end
  440. else if IsFirst then
  441. begin
  442. Verbose(V_Warning,'Line "'+Line+'" not found as next "'+S+'"');
  443. IsFirst:=false;
  444. end;
  445. end;
  446. if not IsFound then
  447. begin
  448. Verbose(V_Warning,'Line "'+Line+'" not found');
  449. { Restart to get a chance to find others }
  450. if eof(LongLogFile) then
  451. begin
  452. Close(LongLogFile);
  453. Reset(LongLogFile);
  454. inc(LongLogOpenCount);
  455. end;
  456. end;
  457. end;
  458. Function GetLog(Line, FN : String) : String;
  459. begin
  460. if UseLongLog then
  461. begin
  462. Result:=GetContentsFromLongLog(Line);
  463. exit;
  464. end;
  465. FN:=ChangeFileExt(FN,'.log');
  466. { packages tests have ../ replaced by root/ }
  467. if not FileExists(FN) and (Copy(FN,1,3)='../') then
  468. FN:='root/'+Copy(FN,4,length(FN));
  469. If FileExists(FN) then
  470. Result:=GetFileContents(FN)
  471. else
  472. begin
  473. Verbose(V_Warning,'File "'+FN+'" not found');
  474. Result:='';
  475. end;
  476. end;
  477. Function GetExecuteLog(Line, FN : String) : String;
  478. begin
  479. if UseLongLog then
  480. begin
  481. Result:=GetContentsFromLongLog(Line);
  482. exit;
  483. end;
  484. FN:=ChangeFileExt(FN,'.elg');
  485. { packages tests have ../ replaced by root/ }
  486. if not FileExists(FN) and (Copy(FN,1,3)='../') then
  487. FN:='root/'+Copy(FN,4,length(FN));
  488. If FileExists(FN) then
  489. Result:=GetFileContents(FN)
  490. else
  491. begin
  492. Verbose(V_Warning,'File "'+FN+'" not found');
  493. Result:='';
  494. end;
  495. end;
  496. Procedure Processfile (FN: String);
  497. var
  498. logfile : text;
  499. fullline,line,prevLine : string;
  500. TS,PrevTS : TTestStatus;
  501. ID,PrevID : integer;
  502. Testlog : string;
  503. count_test : boolean;
  504. begin
  505. Assign(logfile,FN);
  506. PrevId:=-1;
  507. PrevLine:='';
  508. count_test:=false;
  509. PrevTS:=low(TTestStatus);
  510. {$i-}
  511. reset(logfile);
  512. if ioresult<>0 then
  513. Verbose(V_Error,'Unable to open log file'+FN);
  514. {$i+}
  515. while not eof(logfile) do
  516. begin
  517. readln(logfile,line);
  518. fullline:=line;
  519. ts:=stFailedToCompile;
  520. If analyse(line,TS) then
  521. begin
  522. Verbose(V_NORMAL,'Analysing result for test '+Line);
  523. If Not ExpectRun[TS] then
  524. begin
  525. ID:=RequireTestID(Line);
  526. if (PrevID<>-1) and (PrevID<>ID) then
  527. begin
  528. { This can only happen if a Successfully compiled message
  529. is not followed by any other line about the same test }
  530. TestLog:='';
  531. AddTestResult(PrevID,TestRunId,ord(PrevTS),
  532. TestOK[PrevTS],TestSkipped[PrevTS],TestLog,count_test);
  533. Verbose(V_Warning,'Orphaned test: "'+prevline+'"');
  534. end;
  535. PrevID:=-1;
  536. If (ID<>-1) then
  537. begin
  538. If Not (TestOK[TS] or TestSkipped[TS]) then
  539. begin
  540. TestLog:=GetExecuteLog(Fullline,Line);
  541. if pos(failed_to_compile,TestLog)=1 then
  542. TestLog:=GetLog(Fullline,Line);
  543. end
  544. else
  545. TestLog:='';
  546. { AddTestResult can fail for test that contain %recompile
  547. as the same }
  548. if AddTestResult(ID,TestRunID,Ord(TS),TestOK[TS],
  549. TestSkipped[TS],TestLog,count_test) <> -1 then
  550. begin
  551. if count_test then
  552. Inc(StatusCount[TS])
  553. else
  554. Verbose(V_Debug,'Test: "'+line+'" was updated');
  555. end
  556. else
  557. begin
  558. Verbose(V_Warning,'Test: "'+line+'" already registered');
  559. end;
  560. end;
  561. end
  562. else
  563. begin
  564. Inc(StatusCount[TS]);
  565. PrevTS:=TS;
  566. PrevID:=RequireTestID(line);
  567. PrevLine:=line;
  568. end;
  569. end
  570. else
  571. begin
  572. Inc(UnknownLines);
  573. Verbose(V_Warning,'Unknown line: "'+line+'"');
  574. end;
  575. end;
  576. close(logfile);
  577. end;
  578. procedure UpdateTestRun;
  579. var
  580. i : TTestStatus;
  581. qry : string;
  582. begin
  583. qry:='UPDATE TESTRUN SET ';
  584. for i:=low(TTestStatus) to high(TTestStatus) do
  585. qry:=qry+format('%s=%d, ',[SQLField[i],StatusCount[i]]);
  586. if TestCompilerDate<>'' then
  587. qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coCompilerDate],EscapeSQL(TestCompilerDate)]);
  588. if TestCompilerFullVersion<>'' then
  589. qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coCompilerFullVersion],EscapeSQL(TestCompilerFullVersion)]);
  590. if TestSvnCompilerRevision<>'' then
  591. qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coSvnCompilerRevision],EscapeSQL(TestSvnCompilerRevision)]);
  592. if TestSvnTestsRevision<>'' then
  593. qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coSvnTestsRevision],EscapeSQL(TestSvnTestsRevision)]);
  594. if TestSvnRTLRevision<>'' then
  595. qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coSvnRTLRevision],EscapeSQL(TestSvnRTLRevision)]);
  596. if TestSvnPackagesRevision<>'' then
  597. qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coSvnPackagesRevision],EscapeSQL(TestSvnPackagesRevision)]);
  598. qry:=qry+format('TU_SUBMITTER=''%s'', TU_MACHINE=''%s'', TU_COMMENT=''%s'', TU_DATE=''%s''',[Submitter,Machine,Comment,SqlDate(TestDate)]);
  599. qry:=qry+' WHERE TU_ID='+format('%d',[TestRunID]);
  600. ExecuteQuery(Qry,False);
  601. end;
  602. function GetTestConfigId : Integer;
  603. var
  604. qry : string;
  605. begin
  606. qry:='SELECT TCONF_ID FROM TESTCONFIG WHERE ' +
  607. 'TCONF_CPU_FK=%d AND ' +
  608. 'TCONF_OS_FK=%d AND ' +
  609. 'TCONF_VERSION_FK=%d AND ' +
  610. 'TCONF_CATEGORY_FK=%d AND ' +
  611. 'TCONF_SUBMITTER=''%s'' AND ' +
  612. 'TCONF_MACHINE=''%s'' AND ' +
  613. 'TCONF_COMMENT=''%s'' ';
  614. ConfigID:=IDQuery(format(qry,[TestCPUID, TestOSID, TestVersionID, TestCategoryID,
  615. Submitter, Machine, Comment]));
  616. GetTestConfigID:=ConfigID;
  617. end;
  618. function UpdateTestConfigID : boolean;
  619. var
  620. qry : string;
  621. firstRunID, lastRunID,PrevRunID : Integer;
  622. RunCount : Integer;
  623. AddCount : boolean;
  624. begin
  625. AddCount:=false;
  626. UpdateTestConfigID:=false;
  627. qry:=format('SELECT TCONF_FIRST_RUN_FK FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
  628. FirstRunID:=IDQuery(qry);
  629. if TestRunID<FirstRunID then
  630. begin
  631. Verbose(V_Warning,format('FirstRunID changed from %d to %d',[FirstRunID,TestRunID]));
  632. qry:=format('UPDATE TESTCONFIG SET TCONF_FIRST_RUN_FK=%d WHERE TCONF_ID=%d',
  633. [TestRunID,ConfigID]);
  634. if Not ExecuteQuery(qry,False) then
  635. Verbose(V_Warning,'Update of LastRunID failed');
  636. end;
  637. qry:=format('SELECT TCONF_LAST_RUN_FK FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
  638. LastRunID:=IDQuery(qry);
  639. if TestRunID>LastRunID then
  640. begin
  641. qry:=format('UPDATE TESTCONFIG SET TCONF_LAST_RUN_FK=%d WHERE TCONF_ID=%d',
  642. [TestRunID,ConfigID]);
  643. if not ExecuteQuery(qry,False) then
  644. Verbose(V_Warning,'Update of LastRunID failed');
  645. end
  646. else
  647. Verbose(V_Warning,format('LastRunID %di,new %d',[LastRunID,TestRunID]));
  648. qry:=format('SELECT TCONF_NEW_RUN_FK FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
  649. PrevRunID:=IDQuery(qry);
  650. if TestRunID<>PrevRunID then
  651. begin
  652. qry:=format('UPDATE TESTCONFIG SET TCONF_NEW_RUN_FK=%d WHERE TCONF_ID=%d',
  653. [TestRunID,ConfigID]);
  654. if not ExecuteQuery(qry,False) then
  655. Verbose(V_Warning,'Update of LastRunID failed');
  656. AddTestHistoryEntry(TestRunID,PrevRunID);
  657. AddCount:=true;
  658. end
  659. else
  660. Verbose(V_Warning,'TestRunID is equal to last!');
  661. qry:=format('SELECT TCONF_COUNT_RUNS FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
  662. RunCount:=IDQuery(qry);
  663. { Add one to run count }
  664. if AddCount then
  665. begin
  666. Inc(RunCount);
  667. qry:=format('UPDATE TESTCONFIG SET TCONF_COUNT_RUNS=%d WHERE TCONF_ID=%d',
  668. [RunCount,ConfigID]);
  669. if not ExecuteQuery(qry,False) then
  670. Verbose(V_Warning,'Update of TU_COUNT_RUNS failed');
  671. end;
  672. UpdateTestConfigID:=true;
  673. end;
  674. function InsertNewTestConfigId : longint;
  675. var
  676. qry : string;
  677. begin
  678. qry:='INSERT INTO TESTCONFIG '+
  679. '(TCONF_NEW_RUN_FK,TCONF_FIRST_RUN_FK,TCONF_LAST_RUN_FK,' +
  680. 'TCONF_CPU_FK,TCONF_OS_FK,TCONF_VERSION_FK,TCONF_CATEGORY_FK,'+
  681. 'TCONF_SUBMITTER,TCONF_MACHINE,TCONF_COMMENT,'+
  682. 'TCONF_NEW_DATE,TCONF_FIRST_DATE,TCONF_LAST_DATE) ';
  683. qry:=qry+format(' VALUES(%d,%d,%d,%d,%d,%d,%d,''%s'',''%s'',''%s'',''%s'',''%s'',''%s'') ',
  684. [TestRunID, TestRunID, TestRunID, TestCPUID,
  685. TestOSID, TestVersionID, TestCategoryID,
  686. Submitter, Machine, Comment,
  687. SqlDate(TestDate), SqlDate(TestDate), SqlDate(TestDate)]);
  688. qry:=qry+' RETURNING TCONF_ID';
  689. Result:=InsertQuery(qry);
  690. AddTestHistoryEntry(TestRunID,0);
  691. end;
  692. procedure UpdateTestConfig;
  693. begin
  694. if GetTestPreviousRunHistoryID(TestRunID) <> -1 then
  695. begin
  696. Verbose(V_DEBUG,format('TestRun %d already in TestHistory table',[TestRunID]));
  697. exit;
  698. end;
  699. if GetTestConfigID >= 0 then
  700. begin
  701. if not UpdateTestConfigID then
  702. Verbose(V_Warning, ' Update of TESTCONFIG table failed');
  703. end
  704. else
  705. begin
  706. if InsertNewTestConfigID = -1 then
  707. Verbose(V_Warning, ' Insert of new entry into TESTCONFIG table failed');
  708. end;
  709. end;
  710. begin
  711. ProcessConfigFile('dbdigest.cfg');
  712. ProcessCommandLine;
  713. If LogFileName<>'' then
  714. begin
  715. ConnectToDatabase(DatabaseName,HostName,UserName,Password,Port);
  716. if LongLogFileName<>'' then
  717. begin
  718. {$I-}
  719. Assign(LongLogFile,LongLogFileName);
  720. Reset(LongLogFile);
  721. If IOResult=0 then
  722. begin
  723. UseLongLog:=true;
  724. inc(LongLogOpenCount);
  725. end;
  726. {$I+}
  727. end;
  728. GetIDs;
  729. ProcessFile(LogFileName);
  730. UpdateTestRun;
  731. UpdateTestConfig;
  732. if UseLongLog then
  733. begin
  734. Close(LongLogFile);
  735. if LongLogOpenCount>1 then
  736. Verbose(V_Warning,format('LongLog file was read %d times.',[LongLogOpenCount]));
  737. end
  738. end
  739. else
  740. Verbose(V_ERROR,'Missing log file name');
  741. end.