dbdigest.pp 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801
  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. Function GetContentsFromLongLog(Line : String) : String;
  406. var
  407. S : String;
  408. IsFirst, IsFound : boolean;
  409. begin
  410. Result:='';
  411. IsFirst:=true;
  412. IsFound:=false;
  413. While Not(EOF(LongLogFile)) do
  414. begin
  415. ReadLn(LongLogFile,S);
  416. if FirstLongLogLine then
  417. begin
  418. { At start of file there is a separation line }
  419. if (pos('>>>>>>>>>>>',S)=1) then
  420. Readln(LongLogFile,S);
  421. FirstLongLogLine:=false;
  422. end;
  423. if pos(Line,S)=1 then
  424. begin
  425. IsFound:=true;
  426. while not eof(LongLogFile) do
  427. begin
  428. ReadLn(LongLogFile,S);
  429. { End of file marker }
  430. if eof(LongLogFile) or (pos('>>>>>>>>>>>',S)=1) then
  431. exit;
  432. if length(Result)<MaxLogSize then
  433. Result:=Result+S+LineEnding;
  434. end;
  435. end
  436. else if IsFirst then
  437. begin
  438. Verbose(V_Warning,'Line "'+Line+'" not found as next "'+S+'"');
  439. IsFirst:=false;
  440. end;
  441. end;
  442. if not IsFound then
  443. begin
  444. Verbose(V_Warning,'Line "'+Line+'" not found');
  445. { Restart to get a chance to find others }
  446. if eof(LongLogFile) then
  447. begin
  448. Close(LongLogFile);
  449. Reset(LongLogFile);
  450. inc(LongLogOpenCount);
  451. end;
  452. end;
  453. end;
  454. Function GetLog(Line, FN : String) : String;
  455. begin
  456. if UseLongLog then
  457. begin
  458. Result:=GetContentsFromLongLog(Line);
  459. exit;
  460. end;
  461. FN:=ChangeFileExt(FN,'.log');
  462. { packages tests have ../ replaced by root/ }
  463. if not FileExists(FN) and (Copy(FN,1,3)='../') then
  464. FN:='root/'+Copy(FN,4,length(FN));
  465. If FileExists(FN) then
  466. Result:=GetFileContents(FN)
  467. else
  468. begin
  469. Verbose(V_Warning,'File "'+FN+'" not found');
  470. Result:='';
  471. end;
  472. end;
  473. Function GetExecuteLog(Line, FN : String) : String;
  474. begin
  475. if UseLongLog then
  476. begin
  477. Result:=GetContentsFromLongLog(Line);
  478. exit;
  479. end;
  480. FN:=ChangeFileExt(FN,'.elg');
  481. { packages tests have ../ replaced by root/ }
  482. if not FileExists(FN) and (Copy(FN,1,3)='../') then
  483. FN:='root/'+Copy(FN,4,length(FN));
  484. If FileExists(FN) then
  485. Result:=GetFileContents(FN)
  486. else
  487. begin
  488. Verbose(V_Warning,'File "'+FN+'" not found');
  489. Result:='';
  490. end;
  491. end;
  492. Procedure Processfile (FN: String);
  493. var
  494. logfile : text;
  495. fullline,line,prevLine : string;
  496. TS,PrevTS : TTestStatus;
  497. ID,PrevID : integer;
  498. Testlog : string;
  499. count_test : boolean;
  500. begin
  501. Assign(logfile,FN);
  502. PrevId:=-1;
  503. PrevLine:='';
  504. count_test:=false;
  505. PrevTS:=low(TTestStatus);
  506. {$i-}
  507. reset(logfile);
  508. if ioresult<>0 then
  509. Verbose(V_Error,'Unable to open log file'+FN);
  510. {$i+}
  511. while not eof(logfile) do
  512. begin
  513. readln(logfile,line);
  514. fullline:=line;
  515. ts:=stFailedToCompile;
  516. If analyse(line,TS) then
  517. begin
  518. Verbose(V_NORMAL,'Analysing result for test '+Line);
  519. If Not ExpectRun[TS] then
  520. begin
  521. ID:=RequireTestID(Line);
  522. if (PrevID<>-1) and (PrevID<>ID) then
  523. begin
  524. { This can only happen if a Successfully compiled message
  525. is not followed by any other line about the same test }
  526. TestLog:='';
  527. AddTestResult(PrevID,TestRunId,ord(PrevTS),
  528. TestOK[PrevTS],TestSkipped[PrevTS],TestLog,count_test);
  529. Verbose(V_Warning,'Orphaned test: "'+prevline+'"');
  530. end;
  531. PrevID:=-1;
  532. If (ID<>-1) then
  533. begin
  534. If Not (TestOK[TS] or TestSkipped[TS]) then
  535. begin
  536. TestLog:=GetExecuteLog(Fullline,Line);
  537. if pos(failed_to_compile,TestLog)=1 then
  538. TestLog:=GetLog(Fullline,Line);
  539. end
  540. else
  541. TestLog:='';
  542. { AddTestResult can fail for test that contain %recompile
  543. as the same }
  544. if AddTestResult(ID,TestRunID,Ord(TS),TestOK[TS],
  545. TestSkipped[TS],TestLog,count_test) <> -1 then
  546. begin
  547. if count_test then
  548. Inc(StatusCount[TS])
  549. else
  550. Verbose(V_Debug,'Test: "'+line+'" was updated');
  551. end
  552. else
  553. begin
  554. Verbose(V_Warning,'Test: "'+line+'" already registered');
  555. end;
  556. end;
  557. end
  558. else
  559. begin
  560. Inc(StatusCount[TS]);
  561. PrevTS:=TS;
  562. PrevID:=RequireTestID(line);
  563. PrevLine:=line;
  564. end;
  565. end
  566. else
  567. begin
  568. Inc(UnknownLines);
  569. Verbose(V_Warning,'Unknown line: "'+line+'"');
  570. end;
  571. end;
  572. close(logfile);
  573. end;
  574. procedure UpdateTestRun;
  575. var
  576. i : TTestStatus;
  577. qry : string;
  578. begin
  579. qry:='UPDATE TESTRUN SET ';
  580. for i:=low(TTestStatus) to high(TTestStatus) do
  581. qry:=qry+format('%s=%d, ',[SQLField[i],StatusCount[i]]);
  582. if TestCompilerDate<>'' then
  583. qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coCompilerDate],EscapeSQL(TestCompilerDate)]);
  584. if TestCompilerFullVersion<>'' then
  585. qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coCompilerFullVersion],EscapeSQL(TestCompilerFullVersion)]);
  586. if TestSvnCompilerRevision<>'' then
  587. qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coSvnCompilerRevision],EscapeSQL(TestSvnCompilerRevision)]);
  588. if TestSvnTestsRevision<>'' then
  589. qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coSvnTestsRevision],EscapeSQL(TestSvnTestsRevision)]);
  590. if TestSvnRTLRevision<>'' then
  591. qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coSvnRTLRevision],EscapeSQL(TestSvnRTLRevision)]);
  592. if TestSvnPackagesRevision<>'' then
  593. qry:=qry+format('%s=''%s'', ',[ConfigAddCols[coSvnPackagesRevision],EscapeSQL(TestSvnPackagesRevision)]);
  594. qry:=qry+format('TU_SUBMITTER=''%s'', TU_MACHINE=''%s'', TU_COMMENT=''%s'', TU_DATE=''%s''',[Submitter,Machine,Comment,SqlDate(TestDate)]);
  595. qry:=qry+' WHERE TU_ID='+format('%d',[TestRunID]);
  596. ExecuteQuery(Qry,False);
  597. end;
  598. function GetTestConfigId : Integer;
  599. var
  600. qry : string;
  601. begin
  602. qry:='SELECT TCONF_ID FROM TESTCONFIG WHERE ' +
  603. 'TCONF_CPU_FK=%d AND ' +
  604. 'TCONF_OS_FK=%d AND ' +
  605. 'TCONF_VERSION_FK=%d AND ' +
  606. 'TCONF_CATEGORY_FK=%d AND ' +
  607. 'TCONF_SUBMITTER=''%s'' AND ' +
  608. 'TCONF_MACHINE=''%s'' AND ' +
  609. 'TCONF_COMMENT=''%s'' ';
  610. ConfigID:=IDQuery(format(qry,[TestCPUID, TestOSID, TestVersionID, TestCategoryID,
  611. Submitter, Machine, Comment]));
  612. GetTestConfigID:=ConfigID;
  613. end;
  614. function UpdateTestConfigID : boolean;
  615. var
  616. qry : string;
  617. firstRunID, lastRunID,PrevRunID : Integer;
  618. RunCount : Integer;
  619. AddCount : boolean;
  620. begin
  621. AddCount:=false;
  622. UpdateTestConfigID:=false;
  623. qry:=format('SELECT TCONF_FIRST_RUN_FK FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
  624. FirstRunID:=IDQuery(qry);
  625. if TestRunID<FirstRunID then
  626. begin
  627. Verbose(V_Warning,format('FirstRunID changed from %d to %d',[FirstRunID,TestRunID]));
  628. qry:=format('UPDATE TESTCONFIG SET TCONF_FIRST_RUN_FK=%d WHERE TCONF_ID=%d',
  629. [TestRunID,ConfigID]);
  630. if Not ExecuteQuery(qry,False) then
  631. Verbose(V_Warning,'Update of LastRunID failed');
  632. end;
  633. qry:=format('SELECT TCONF_LAST_RUN_FK FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
  634. LastRunID:=IDQuery(qry);
  635. if TestRunID>LastRunID then
  636. begin
  637. qry:=format('UPDATE TESTCONFIG SET TCONF_LAST_RUN_FK=%d WHERE TCONF_ID=%d',
  638. [TestRunID,ConfigID]);
  639. if not ExecuteQuery(qry,False) then
  640. Verbose(V_Warning,'Update of LastRunID failed');
  641. end
  642. else
  643. Verbose(V_Warning,format('LastRunID %di,new %d',[LastRunID,TestRunID]));
  644. qry:=format('SELECT TCONF_NEW_RUN_FK FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
  645. PrevRunID:=IDQuery(qry);
  646. if TestRunID<>PrevRunID then
  647. begin
  648. qry:=format('UPDATE TESTCONFIG SET TCONF_NEW_RUN_FK=%d WHERE TCONF_ID=%d',
  649. [TestRunID,ConfigID]);
  650. if not ExecuteQuery(qry,False) then
  651. Verbose(V_Warning,'Update of LastRunID failed');
  652. AddTestHistoryEntry(TestRunID,PrevRunID);
  653. AddCount:=true;
  654. end
  655. else
  656. Verbose(V_Warning,'TestRunID is equal to last!');
  657. qry:=format('SELECT TCONF_COUNT_RUNS FROM TESTCONFIG WHERE TCONF_ID=%d',[ConfigID]);
  658. RunCount:=IDQuery(qry);
  659. { Add one to run count }
  660. if AddCount then
  661. begin
  662. Inc(RunCount);
  663. qry:=format('UPDATE TESTCONFIG SET TCONF_COUNT_RUNS=%d WHERE TCONF_ID=%d',
  664. [RunCount,ConfigID]);
  665. if not ExecuteQuery(qry,False) then
  666. Verbose(V_Warning,'Update of TU_COUNT_RUNS failed');
  667. end;
  668. UpdateTestConfigID:=true;
  669. end;
  670. function InsertNewTestConfigId : longint;
  671. var
  672. qry : string;
  673. begin
  674. qry:='INSERT INTO TESTCONFIG '+
  675. '(TCONF_NEW_RUN_FK,TCONF_FIRST_RUN_FK,TCONF_LAST_RUN_FK,' +
  676. 'TCONF_CPU_FK,TCONF_OS_FK,TCONF_VERSION_FK,TCONF_CATEGORY_FK,'+
  677. 'TCONF_SUBMITTER,TCONF_MACHINE,TCONF_COMMENT,'+
  678. 'TCONF_NEW_DATE,TCONF_FIRST_DATE,TCONF_LAST_DATE) ';
  679. qry:=qry+format(' VALUES(%d,%d,%d,%d,%d,%d,%d,''%s'',''%s'',''%s'',''%s'',''%s'',''%s'') ',
  680. [TestRunID, TestRunID, TestRunID, TestCPUID,
  681. TestOSID, TestVersionID, TestCategoryID,
  682. Submitter, Machine, Comment,
  683. SqlDate(TestDate), SqlDate(TestDate), SqlDate(TestDate)]);
  684. qry:=qry+' RETURNING TCONF_ID';
  685. Result:=InsertQuery(qry);
  686. AddTestHistoryEntry(TestRunID,0);
  687. end;
  688. procedure UpdateTestConfig;
  689. begin
  690. if GetTestPreviousRunHistoryID(TestRunID) <> -1 then
  691. begin
  692. Verbose(V_DEBUG,format('TestRun %d already in TestHistory table',[TestRunID]));
  693. exit;
  694. end;
  695. if GetTestConfigID >= 0 then
  696. begin
  697. if not UpdateTestConfigID then
  698. Verbose(V_Warning, ' Update of TESTCONFIG table failed');
  699. end
  700. else
  701. begin
  702. if InsertNewTestConfigID = -1 then
  703. Verbose(V_Warning, ' Insert of new entry into TESTCONFIG table failed');
  704. end;
  705. end;
  706. begin
  707. ProcessConfigFile('dbdigest.cfg');
  708. ProcessCommandLine;
  709. If LogFileName<>'' then
  710. begin
  711. ConnectToDatabase(DatabaseName,HostName,UserName,Password,Port);
  712. if LongLogFileName<>'' then
  713. begin
  714. {$I-}
  715. Assign(LongLogFile,LongLogFileName);
  716. Reset(LongLogFile);
  717. If IOResult=0 then
  718. begin
  719. UseLongLog:=true;
  720. inc(LongLogOpenCount);
  721. end;
  722. {$I+}
  723. end;
  724. GetIDs;
  725. ProcessFile(LogFileName);
  726. UpdateTestRun;
  727. UpdateTestConfig;
  728. if UseLongLog then
  729. begin
  730. Close(LongLogFile);
  731. if LongLogOpenCount>1 then
  732. Verbose(V_Warning,format('LongLog file was read %d times.',[LongLogOpenCount]));
  733. end
  734. end
  735. else
  736. Verbose(V_ERROR,'Missing log file name');
  737. end.