paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 13:09:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

* More PG fixes

Browse Source 
git-svn-id: trunk@28453 -
This commit is contained in:
michael 2014-08-18 22:14:09 +00:00
parent 5fa452d42f
commit 292ab82fc5
1 changed files with 14 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
tests/utils/dbconfig.pp
View File

@ -2,7 +2,7 @@
This file is part of the Free Pascal test suite. This file is part of the Free Pascal test suite.
Copyright (c) 2002 by the Free Pascal development team. Copyright (c) 2002 by the Free Pascal development team.
This program iupdates TESTCONFIG anf TESTRUNHISTORY tables This program updates TESTCONFIG anf TESTRUNHISTORY tables
with the last tests run. with the last tests run.
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
@ -24,7 +24,7 @@ program dbconfig;
uses uses
sysutils,teststr,testu,tresults, sysutils,teststr,testu,tresults,
mysql55dyn,dbtests; sqldb,dbtests;
Var Var
@ -451,7 +451,7 @@ var
qry : string; qry : string;
firstRunID, lastRunID,PrevRunID : Integer; firstRunID, lastRunID,PrevRunID : Integer;
RunCount : Integer; RunCount : Integer;
res : TQueryResult; res : TSQLQuery;
AddCount : boolean; AddCount : boolean;
begin begin
AddCount:=false; AddCount:=false;
@ -463,7 +463,7 @@ begin
Verbose(V_Warning,format('FirstRunID changed from %d to %d',[FirstRunID,TestRunID])); Verbose(V_Warning,format('FirstRunID changed from %d to %d',[FirstRunID,TestRunID]));
qry:=format('UPDATE TESTCONFIG SET TCONF_FIRST_RUN_FK=%d WHERE TCONF_ID=%d', qry:=format('UPDATE TESTCONFIG SET TCONF_FIRST_RUN_FK=%d WHERE TCONF_ID=%d',
[TestRunID,ConfigID]); [TestRunID,ConfigID]);
if RunQuery(qry,res) then if OpenQuery(qry,res,false) then
FreeQueryResult(res) FreeQueryResult(res)
else else
Verbose(V_Warning,'Update of LastRunID failed'); Verbose(V_Warning,'Update of LastRunID failed');
@ -474,7 +474,7 @@ begin
begin begin
qry:=format('UPDATE TESTCONFIG SET TCONF_LAST_RUN_FK=%d WHERE TCONF_ID=%d', qry:=format('UPDATE TESTCONFIG SET TCONF_LAST_RUN_FK=%d WHERE TCONF_ID=%d',
[TestRunID,ConfigID]); [TestRunID,ConfigID]);
if RunQuery(qry,res) then if OpenQuery(qry,res,false) then
FreeQueryResult(res) FreeQueryResult(res)
else else
Verbose(V_Warning,'Update of LastRunID failed'); Verbose(V_Warning,'Update of LastRunID failed');
@ -487,7 +487,7 @@ begin
begin begin
qry:=format('UPDATE TESTCONFIG SET TCONF_NEW_RUN_FK=%d WHERE TCONF_ID=%d', qry:=format('UPDATE TESTCONFIG SET TCONF_NEW_RUN_FK=%d WHERE TCONF_ID=%d',
[TestRunID,ConfigID]); [TestRunID,ConfigID]);
if RunQuery(qry,res) then if OpenQuery(qry,res,false) then
FreeQueryResult(res) FreeQueryResult(res)
else else
Verbose(V_Warning,'Update of LastRunID failed'); Verbose(V_Warning,'Update of LastRunID failed');
@ -504,7 +504,7 @@ begin
Inc(RunCount); Inc(RunCount);
qry:=format('UPDATE TESTCONFIG SET TCONF_COUNT_RUNS=%d WHERE TCONF_ID=%d', qry:=format('UPDATE TESTCONFIG SET TCONF_COUNT_RUNS=%d WHERE TCONF_ID=%d',
[RunCount,ConfigID]); [RunCount,ConfigID]);
if RunQuery(qry,res) then if OpenQuery(qry,res,false) then
FreeQueryResult(res) FreeQueryResult(res)
else else
Verbose(V_Warning,'Update of TU_COUNT_RUNS failed'); Verbose(V_Warning,'Update of TU_COUNT_RUNS failed');
@ -536,7 +536,7 @@ begin
AddTestHistoryEntry(TestRunID,0); AddTestHistoryEntry(TestRunID,0);
end; end;
Procedure InsertRunsIntoConfigAndHistory(var GlobalRes : TQueryResult); Procedure InsertRunsIntoConfigAndHistory(var GlobalRes : TSQLQuery);
var var
i,fid, num_fields : Integer; i,fid, num_fields : Integer;
@ -544,9 +544,10 @@ var
s : string; s : string;
runid,previd : Integer; runid,previd : Integer;
begin begin
with GlobalRes^ do with GlobalRes do
begin begin
num_fields:=mysql_num_fields(GlobalRes); num_fields:=FieldCount;
First;
Writeln('Row count=',row_count); Writeln('Row count=',row_count);
for i:=0 to row_count-1 do for i:=0 to row_count-1 do
begin begin
@ -571,20 +572,20 @@ begin
end; end;
end; end;
Procedure GetAllTestRuns(var GlobalRes : TQueryResult); Procedure GetAllTestRuns(var GlobalRes : TSQLQuery);
var var
qry : string; qry : string;
begin begin
qry:='SELECT * FROM TESTRUN ORDER BY TU_ID'; qry:='SELECT * FROM TESTRUN ORDER BY TU_ID';
if OffsetString<>'' then if OffsetString<>'' then
qry:=qry+' LIMIT 1000 OFFSET '+OffsetString; qry:=qry+' LIMIT 1000 OFFSET '+OffsetString;
if not RunQuery(qry,GlobalRes) then if not OpenQuery(qry,GlobalRes,false) then
Verbose(V_Warning,'Failed to fetch testrun content'); Verbose(V_Warning,'Failed to fetch testrun content');
end; end;
var var
GlobalRes : TQueryResult; GlobalRes : TSQLQuery;
begin begin
ProcessConfigFile('dbdigest.cfg'); ProcessConfigFile('dbdigest.cfg');