paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 21:19:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

--- Merging r34244 into '.':

Browse Source 
U    packages/fcl-db/src/base/dsparams.inc
--- Recording mergeinfo for merge of r34244 into '.':
 U   .
--- Merging r34556 into '.':
U    packages/dblib/src/dblib.pp
--- Recording mergeinfo for merge of r34556 into '.':
 G   .
--- Merging r34745 into '.':
U    packages/fcl-db/tests/testspecifictbufdataset.pas
U    packages/fcl-db/src/base/dataset.inc
--- Recording mergeinfo for merge of r34745 into '.':
 G   .
--- Merging r35465 into '.':
U    packages/fcl-db/fpmake.pp
--- Recording mergeinfo for merge of r35465 into '.':
 G   .
--- Merging r35618 into '.':
U    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r35618 into '.':
 G   .
--- Merging r35628 into '.':
G    packages/fcl-db/src/base/dataset.inc
--- Recording mergeinfo for merge of r35628 into '.':
 G   .
--- Merging r35629 into '.':
U    packages/fcl-db/tests/testdbbasics.pas
--- Recording mergeinfo for merge of r35629 into '.':
 G   .
--- Merging r35630 into '.':
U    packages/fcl-db/src/Dataset.txt
--- Recording mergeinfo for merge of r35630 into '.':
 G   .
--- Merging r35690 into '.':
U    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r35690 into '.':
 G   .

# revisions: 34244,34556,34745,35465,35618,35628,35629,35630,35690

git-svn-id: branches/fixes_3_0@35994 -
This commit is contained in:
marco 2017-04-28 12:46:04 +00:00
parent c6ad797d22
commit 0822a672bd
9 changed files with 73 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
packages/dblib/src/dblib.pp
View File

@ -179,7 +179,9 @@ const
// Error codes:
SYBEFCON = 20002; // SQL Server connection failed
SYBEWRIT = 20006; // Write to SQL Server failed.
SYBESMSG = 20018; // General SQL Server error: Check messages from the SQL Server.
SYBEDDNE = 20047; // DBPROCESS is dead or not enabled.
type
PLOGINREC=Pointer;
@ -361,6 +363,7 @@ var
function dbiscount(dbproc:PDBPROCESS):BOOL; cdecl; external DBLIBDLL;
function dbcancel(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
function dbcanquery(dbproc:PDBPROCESS):RETCODE; cdecl; external DBLIBDLL;
function dbdead(dbproc:PDBPROCESS):DBBOOL; cdecl; external DBLIBDLL;
function dbhasretstat(dbproc:PDBPROCESS):DBBOOL; cdecl; external DBLIBDLL;
function dbretstatus(dbproc:PDBPROCESS):DBINT; cdecl; external DBLIBDLL;
procedure dbfreelogin(login:PLOGINREC); cdecl; external DBLIBDLL {$IFDEF freetds}name 'dbloginfree'{$ENDIF};
@ -410,6 +413,7 @@ var
dbiscount: function(dbproc:PDBPROCESS):BOOL; cdecl;
dbcancel: function(dbproc:PDBPROCESS):RETCODE; cdecl;
dbcanquery: function(dbproc:PDBPROCESS):RETCODE; cdecl;
dbdead: function(dbproc:PDBPROCESS):DBBOOL; cdecl;
dbhasretstat: function(dbproc:PDBPROCESS):DBBOOL; cdecl;
dbretstatus: function(dbproc:PDBPROCESS):DBINT; cdecl;
dbexit: procedure(); cdecl;
@ -510,6 +514,7 @@ begin
pointer(dbiscount) := GetProcedureAddress(DBLibLibraryHandle,'dbiscount');
pointer(dbcancel) := GetProcedureAddress(DBLibLibraryHandle,'dbcancel');
pointer(dbcanquery) := GetProcedureAddress(DBLibLibraryHandle,'dbcanquery');
pointer(dbdead) := GetProcedureAddress(DBLibLibraryHandle,'dbdead');
pointer(dbhasretstat) := GetProcedureAddress(DBLibLibraryHandle,'dbhasretstat');
pointer(dbretstatus) := GetProcedureAddress(DBLibLibraryHandle,'dbretstatus');
pointer(dbexit) := GetProcedureAddress(DBLibLibraryHandle,'dbexit');

15
packages/fcl-db/fpmake.pp
View File

@ -14,7 +14,6 @@ const
SqliteOSes = [aix,beos,haiku,linux,freebsd,darwin,iphonesim,netbsd,openbsd,solaris,win32,win64,wince,android,dragonfly];
DBaseOSes = [aix,beos,haiku,linux,freebsd,darwin,iphonesim,netbsd,openbsd,solaris,win32,win64,wince,android,os2,dragonfly];
MSSQLOSes = [beos,haiku,linux,freebsd,netbsd,openbsd,solaris,win32,win64,android,dragonfly];
SqldbWithoutOracleOSes = [win64];
Var
@ -47,7 +46,7 @@ begin
P.SourcePath.Add('src/sqldb/mysql', SqldbConnectionOSes);
P.SourcePath.Add('src/sqldb/odbc', SqldbConnectionOSes);
P.SourcePath.Add('src/sqldb/examples', SqldbConnectionOSes);
P.SourcePath.Add('src/sqldb/oracle', SqldbConnectionOSes-SqldbWithoutOracleOSes);
P.SourcePath.Add('src/sqldb/oracle', SqldbConnectionOSes);
P.SourcePath.Add('src/sqldb/mssql', MSSQLOSes);
P.SourcePath.Add('src/sdf');
P.SourcePath.Add('src/json');
@ -74,7 +73,7 @@ begin
P.Dependencies.Add('ibase', SqldbConnectionOSes);
P.Dependencies.Add('mysql', SqldbConnectionOSes);
P.Dependencies.Add('odbc', SqldbConnectionOSes);
P.Dependencies.Add('oracle', SqldbConnectionOSes-SqldbWithoutOracleOSes);
P.Dependencies.Add('oracle', SqldbConnectionOSes);
P.Dependencies.Add('postgres', SqldbConnectionOSes);
P.Dependencies.Add('sqlite', SqldbConnectionOSes+SqliteOSes);
P.Dependencies.Add('dblib', MSSQLOSes);
@ -450,7 +449,7 @@ begin
AddUnit('fpddsqldb');
AddUnit('odbcconn');
end;
T:=P.Targets.AddUnit('fpddoracle.pp', DatadictOSes-SqldbWithoutOracleOSes);
T:=P.Targets.AddUnit('fpddoracle.pp', DatadictOSes);
with T.Dependencies do
begin
AddUnit('sqldb');
@ -474,7 +473,7 @@ begin
AddUnit('fpddsqldb');
AddUnit('mssqlconn');
end;
T:=P.Targets.AddUnit('fpddregstd.pp', (DatadictOSes*MSSQLOses)-SqldbWithoutOracleOSes);
T:=P.Targets.AddUnit('fpddregstd.pp', (DatadictOSes*MSSQLOses));
with T.Dependencies do
begin
AddUnit('fpdatadict');
@ -693,7 +692,7 @@ begin
AddUnit('bufdataset');
AddUnit('dbconst');
end;
T:=P.Targets.AddUnit('oracleconnection.pp', SqldbConnectionOSes-SqldbWithoutOracleOSes);
T:=P.Targets.AddUnit('oracleconnection.pp', SqldbConnectionOSes);
T.ResourceStrings:=true;
with T.Dependencies do
begin
@ -817,7 +816,3 @@ begin
Installer.Run;
end.
{$endif ALLPACKAGES}

4
packages/fcl-db/src/Dataset.txt
View File

@ -43,7 +43,7 @@ The following constants are userd when handling this array:
FBufferCount : The number of buffers allocated, minus one.
FRecordCount : The number of buffers that is actually filled in.
FActiveBuffer : The index of the active record in TDataset.
FActiveRecord : The index of the active record in TDataset.
FCurrentRecord : The index of the supposedly active record in the underlying
dataset (ie. the index in the last call to SetToInternalRecord)
Call CursorPosChanged to reset FCurrentRecord if the active
@ -60,7 +60,7 @@ So the following picture follows from this:
...
| |
+---------------+
| FActivebuffer |
| FActiveRecord |
+---------------+
| |
...

2
packages/fcl-db/src/base/bufdataset.pas
View File

@ -2832,7 +2832,7 @@ begin
Result := 0
else
begin
InternalSetToRecord(ActiveBuffer);
UpdateCursorPos;
Result := FCurrentIndex.RecNo;
end;
end;

40
packages/fcl-db/src/base/dataset.inc
View File

@ -763,20 +763,20 @@ begin
If FRecordCount>0 Then SetCurrentRecord(FRecordCount-1);
Result:=GetRecord(FBuffers[FBufferCount],gmNext,True)=grOK;
if result then
if Result then
begin
If FRecordCount=0 then ActivateBuffers;
if FRecordCount=FBufferCount then
ShiftBuffersBackward
else
begin
inc(FRecordCount);
Inc(FRecordCount);
FCurrentRecord:=FRecordCount - 1;
ExchangeBuffers(FBuffers[FCurrentRecord],FBuffers[FBufferCount]);
end;
end
else
cursorposchanged;
CursorPosChanged;
{$ifdef dsdebug}
Writeln ('Result getting next record : ',Result);
{$endif}
@ -805,16 +805,16 @@ begin
CheckBiDirectional;
If FRecordCount>0 Then SetCurrentRecord(0);
Result:=GetRecord(FBuffers[FBufferCount],gmPrior,True)=grOK;
if result then
if Result then
begin
If FRecordCount=0 then ActivateBuffers;
ShiftBuffersForward;
if FRecordCount<FBufferCount then
inc(FRecordCount);
Inc(FRecordCount);
end
else
cursorposchanged;
CursorPosChanged;
{$ifdef dsdebug}
Writeln ('Result getting prior record : ',Result);
{$endif}
@ -894,30 +894,30 @@ begin
else
Insert;
for i := 0 to ValuesSize-1 do with values[i] do
fields[i].AssignValue(values[i]);
for i := 0 to ValuesSize-1 do
Fields[i].AssignValue(Values[i]);
Post;
end;
procedure TDataSet.InitFieldDefsFromfields;
procedure TDataSet.InitFieldDefsFromFields;
var i : integer;
begin
if FieldDefs.count = 0 then
if FieldDefs.Count = 0 then
begin
FieldDefs.BeginUpdate;
try
for i := 0 to Fields.Count-1 do with fields[i] do
for i := 0 to Fields.Count-1 do with Fields[i] do
if not (FieldKind in [fkCalculated,fkLookup]) then // Do not add fielddefs for calculated/lookup fields.
begin
FFieldDef:=FieldDefs.FieldDefClass.Create(FieldDefs,FieldName,DataType,Size,Required,FieldDefs.Count+1);
with FFieldDef do
begin
if Required then Attributes := attributes + [faRequired];
if ReadOnly then Attributes := attributes + [faReadOnly];
if DataType = ftBCD then precision := (fields[i] as TBCDField).Precision
else if DataType = ftFMTBcd then precision := (fields[i] as TFMTBCDField).Precision;
if Required then Attributes := Attributes + [faRequired];
if ReadOnly then Attributes := Attributes + [faReadOnly];
if DataType = ftBCD then Precision := (Fields[i] as TBCDField).Precision
else if DataType = ftFMTBcd then Precision := (Fields[i] as TFMTBCDField).Precision;
end;
end;
finally
@ -1148,7 +1148,7 @@ begin
for j := 0 to TDataSource(FDataSources[i]).DataLinks.Count - 1 do
begin
DataLink:=TDataLink(TDataSource(FDataSources[i]).DataLinks[j]);
if DataLink.BufferCount>ABufferCount then
if ABufferCount<DataLink.BufferCount then
ABufferCount:=DataLink.BufferCount;
end;
@ -1200,11 +1200,11 @@ begin
{$ifdef dsdebug}
Writeln (' Reallocating memory :',(Value+1)*SizeOf(TRecordBuffer));
{$endif}
ReAllocMem(FBuffers,(Value+1)*SizeOf(PChar));
ReAllocMem(FBuffers,(Value+1)*SizeOf(TRecordBuffer));
{$ifdef dsdebug}
Writeln (' Filling memory :',(Value+1-FBufferCount)*SizeOf(TRecordBuffer));
{$endif}
inc(FBufferCount); // Cause FBuffers[FBufferCount] is already allocated
Inc(FBufferCount); // Cause FBuffers[FBufferCount] is already allocated
FillChar(FBuffers[FBufferCount],(Value+1-FBufferCount)*SizeOf(TRecordBuffer),#0);
{$ifdef dsdebug}
Writeln (' Filled memory');
@ -1286,7 +1286,7 @@ begin
bfBOF : InternalFirst;
bfEOF : InternalLast;
end;
FCurrentRecord:=index;
FCurrentRecord:=Index;
end;
end;
@ -2165,7 +2165,7 @@ begin
inc(i);
FActiveRecord := i;
// Fill the rest of the buffer
getnextrecords;
GetNextRecords;
// If the buffer is not full yet, try to fetch some more prior records
if FRecordCount < FBufferCount then inc(FActiveRecord,getpriorrecords);
// That's all folks!

2
packages/fcl-db/src/base/dsparams.inc
View File

@ -1076,7 +1076,7 @@ Var
S : TFileStream;
begin
S:=TFileStream.Create(FileName,fmOpenRead);
S:=TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
Try
LoadFromStream(S,BlobType);
Finally

6
packages/fcl-db/src/sqldb/sqldb.pp
View File

@ -290,7 +290,7 @@ type
property HostName : string Read FHostName Write FHostName;
Property OnLog : TDBLogNotifyEvent Read FOnLog Write FOnLog;
Property LogEvents : TDBEventTypes Read FLogEvents Write FLogEvents Default LogAllEvents;
Property Options : TSQLConnectionOptions Read FOptions Write SetOptions;
Property Options : TSQLConnectionOptions Read FOptions Write SetOptions default [];
Property Role : String read FRole write FRole;
property Connected;
property DatabaseName;
@ -340,7 +340,7 @@ type
property Action : TCommitRollbackAction read FAction write FAction Default caRollBack;
property Database;
property Params : TStringList read FParams write SetParams;
Property Options : TSQLTransactionOptions Read FOptions Write SetOptions;
Property Options : TSQLTransactionOptions Read FOptions Write SetOptions default [];
end;
@ -598,7 +598,7 @@ type
property UpdateSQL : TStringList read FUpdateSQL write SetUpdateSQL;
property DeleteSQL : TStringList read FDeleteSQL write SetDeleteSQL;
property RefreshSQL : TStringList read FRefreshSQL write SetRefreshSQL;
Property Options : TSQLQueryOptions Read FOptions Write SetOptions;
Property Options : TSQLQueryOptions Read FOptions Write SetOptions default [];
property Params : TParams read GetParams Write SetParams;
Property ParamCheck : Boolean Read GetParamCheck Write SetParamCheck default true;
property ParseSQL : Boolean read GetParseSQL write SetParseSQL default true;

32
packages/fcl-db/tests/testdbbasics.pas
View File

@ -168,6 +168,7 @@ type
procedure TestBug6893;
procedure TestRequired;
procedure TestModified;
procedure TestUpdateCursorPos; // bug 31532
// fields
procedure TestFieldOldValueObsolete;
procedure TestFieldOldValue;
@ -684,6 +685,37 @@ begin
end;
end;
procedure TTestCursorDBBasics.TestUpdateCursorPos;
var
datasource1: TDataSource;
datalink1: TDataLink;
dataset1: TDataSet;
i,r: integer;
begin
// TBufDataset should notify TDataset (TDataset.CurrentRecord) when changes internaly current record
// TBufDataset.GetRecNo was synchronizing its internal position with TDataset.ActiveRecord, but TDataset.CurrentRecord remains unchaged
// Bug #31532
dataset1 := DBConnector.GetNDataset(16);
datasource1 := TDataSource.Create(nil);
datasource1.DataSet := dataset1;
datalink1 := TDataLink.Create;
datalink1:= TDataLink.create;
datalink1.DataSource:= datasource1;
datalink1.BufferCount:= 12;
dataset1.Open;
dataset1.MoveBy(4);
CheckEquals(5, dataset1.RecNo);
for i:=13 to 15 do begin
datalink1.BufferCount := datalink1.BufferCount+1;
r := dataset1.RecNo; // syncronizes source dataset to ActiveRecord
datalink1.ActiveRecord := datalink1.BufferCount-1;
CheckEquals(i, dataset1.FieldByName('ID').AsInteger);
end;
datasource1.free;
datalink1.free;
end;
procedure TTestDBBasics.TestDetectionNonMatchingDataset;
var
F: TField;

4
packages/fcl-db/tests/testspecifictbufdataset.pas
View File

@ -195,9 +195,11 @@ begin
try
F := TIntegerField.Create(ds);
F.FieldName:='ID';
F.Required:=True;
F.DataSet:=ds;
F := TStringField.Create(ds);
F.FieldName:='NAME';
F.Required:=False;
F.DataSet:=ds;
F.Size:=50;
@ -221,6 +223,8 @@ begin
TestDataset(ds);
CheckTrue(ds.FieldDefs[0].Required, 'Required');
CheckFalse(ds.FieldDefs[1].Required, 'not Required');
for i := 0 to ds.FieldDefs.Count-1 do
begin
CheckNotEquals(ds.FieldDefs[i].Name,'NAME_CALC');