paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 11:26:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

--- Merging r32093 into '.':

Browse Source 
U    packages/fcl-db/src/sqlite/customsqliteds.pas
--- Recording mergeinfo for merge of r32093 into '.':
 U   .
--- Merging r32131 into '.':
U    packages/fcl-db/tests/testdbbasics.pas
U    packages/fcl-db/src/base/bufdataset.pas
U    packages/fcl-db/src/sdf/sdfdata.pp
U    packages/fcl-db/src/memds/memds.pp
--- Recording mergeinfo for merge of r32131 into '.':
 G   .
--- Merging r32359 into '.':
U    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r32359 into '.':
 G   .
--- Merging r32558 into '.':
U    packages/fcl-db/src/base/bufdataset_parser.pp
--- Recording mergeinfo for merge of r32558 into '.':
 G   .
--- Merging r32566 into '.':
G    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r32566 into '.':
 G   .
--- Merging r32729 into '.':
U    packages/fcl-db/src/sqldb/postgres/pqconnection.pp
--- Recording mergeinfo for merge of r32729 into '.':
 G   .
--- Merging r32753 into '.':
U    packages/fcl-db/src/sqlite/sqliteds.pas
U    packages/fcl-db/src/sqlite/sqlite3ds.pas
--- Recording mergeinfo for merge of r32753 into '.':
 G   .
--- Merging r32754 into '.':
G    packages/fcl-db/src/sqlite/sqlite3ds.pas
--- Recording mergeinfo for merge of r32754 into '.':
 G   .
--- Merging r32755 into '.':
G    packages/fcl-db/src/sqlite/sqliteds.pas
--- Recording mergeinfo for merge of r32755 into '.':
 G   .
--- Merging r32796 into '.':
U    packages/fcl-db/src/base/dataset.inc
--- Recording mergeinfo for merge of r32796 into '.':
 G   .
--- Merging r32800 into '.':
U    packages/fcl-db/src/base/sqlscript.pp
--- Recording mergeinfo for merge of r32800 into '.':
 G   .
--- Merging r32801 into '.':
U    packages/fcl-db/tests/dbtestframework.pas
U    packages/fcl-db/tests/testsqlscript.pas
--- Recording mergeinfo for merge of r32801 into '.':
 G   .
--- Merging r32807 into '.':
G    packages/fcl-db/src/base/bufdataset.pas
--- Recording mergeinfo for merge of r32807 into '.':
 G   .
--- Merging r32808 into '.':
U    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Recording mergeinfo for merge of r32808 into '.':
 G   .
--- Merging r32810 into '.':
G    packages/fcl-db/src/sqldb/sqldb.pp
--- Recording mergeinfo for merge of r32810 into '.':
 G   .

# revisions: 32093,32131,32359,32558,32566,32729,32753,32754,32755,32796,32800,32801,32807,32808,32810

git-svn-id: branches/fixes_3_0@33368 -
This commit is contained in:
marco 2016-03-28 14:43:12 +00:00
parent 2bd69ff480
commit caf506a7a2
15 changed files with 399 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -158,7 +158,8 @@ type
procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); virtual; abstract; procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); virtual; abstract;
procedure GotoBookmark(const ABookmark : PBufBookmark); virtual; abstract; procedure GotoBookmark(const ABookmark : PBufBookmark); virtual; abstract;
function BookmarkValid(const ABookmark: PBufBookmark): boolean; virtual; function BookmarkValid(const ABookmark: PBufBookmark): boolean; virtual;
function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; virtual; function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : integer; virtual;
function SameBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; inline;
procedure InitialiseIndex; virtual; abstract; procedure InitialiseIndex; virtual; abstract;
@ -226,7 +227,7 @@ type
procedure StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark); override; procedure StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark); override;
procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); override; procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); override;
procedure GotoBookmark(const ABookmark : PBufBookmark); override; procedure GotoBookmark(const ABookmark : PBufBookmark); override;
function CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): integer; override;
procedure InitialiseIndex; override; procedure InitialiseIndex; override;
procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); override; procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); override;
@ -1248,15 +1249,17 @@ begin
if Fields.Count = 0 then if Fields.Count = 0 then
DatabaseError(SErrNoDataset); DatabaseError(SErrNoDataset);
// If there is a field with FieldNo=0 then the fields are not found to the // search for autoinc field
// FieldDefs which is a sign that there is no dataset created. (Calculated and
// lookup fields have FieldNo=-1)
FAutoIncField:=nil; FAutoIncField:=nil;
for i := 0 to Fields.Count-1 do if FAutoIncValue>-1 then
if Fields[i].FieldNo=0 then begin
DatabaseError(SErrNoDataset) for i := 0 to Fields.Count-1 do
else if (FAutoIncValue>-1) and (Fields[i] is TAutoIncField) and not assigned(FAutoIncField) then if Fields[i] is TAutoIncField then
FAutoIncField := TAutoIncField(Fields[i]); begin
FAutoIncField := TAutoIncField(Fields[i]);
Break;
end;
end;
InitDefaultIndexes; InitDefaultIndexes;
CalcRecordSize; CalcRecordSize;
@ -1367,12 +1370,14 @@ begin
Result := assigned(ABookmark) and assigned(ABookmark^.BookmarkData); Result := assigned(ABookmark) and assigned(ABookmark^.BookmarkData);
end; end;
function TBufIndex.CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean; function TBufIndex.CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): integer;
begin begin
if assigned(ABookmark1) and assigned(ABookmark2) then Result := 0;
Result := (ABookmark1^.BookmarkData=ABookmark2^.BookmarkData) end;
else
Result := False; function TBufIndex.SameBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean;
begin
Result := Assigned(ABookmark1) and Assigned(ABookmark2) and (CompareBookmarks(ABookmark1, ABookmark2) = 0);
end; end;
function TBufIndex.GetRecord(ABookmark: PBufBookmark; GetMode: TGetMode): TGetResult; function TBufIndex.GetRecord(ABookmark: PBufBookmark; GetMode: TGetMode): TGetResult;
@ -1537,6 +1542,35 @@ begin
FCurrentRecBuf := ABookmark^.BookmarkData; FCurrentRecBuf := ABookmark^.BookmarkData;
end; end;
function TDoubleLinkedBufIndex.CompareBookmarks(const ABookmark1,ABookmark2: PBufBookmark): integer;
var ARecord1, ARecord2 : PBufRecLinkItem;
begin
// valid bookmarks expected
// estimate result using memory addresses of records
Result := ABookmark1^.BookmarkData - ABookmark2^.BookmarkData;
if Result = 0 then
Exit
else if Result < 0 then
begin
Result := -1;
ARecord1 := ABookmark1^.BookmarkData;
ARecord2 := ABookmark2^.BookmarkData;
end
else
begin
Result := +1;
ARecord1 := ABookmark2^.BookmarkData;
ARecord2 := ABookmark1^.BookmarkData;
end;
// if we need relative position of records with given bookmarks we must
// traverse through index until we reach lower bookmark or 1st record
while assigned(ARecord2) and (ARecord2 <> ARecord1) and (ARecord2 <> FFirstRecBuf) do
ARecord2 := ARecord2[IndNr].prior;
// if we found lower bookmark as first, then estimated position is correct
if ARecord1 <> ARecord2 then
Result := -Result;
end;
procedure TDoubleLinkedBufIndex.InitialiseIndex; procedure TDoubleLinkedBufIndex.InitialiseIndex;
begin begin
// Do nothing // Do nothing
@ -1564,7 +1598,7 @@ begin
FFirstRecBuf:= nil; FFirstRecBuf:= nil;
end; end;
function TDoubleLinkedBufIndex.GetRecNo: integer; function TDoubleLinkedBufIndex.GetRecNo: Longint;
var ARecord : PBufRecLinkItem; var ARecord : PBufRecLinkItem;
begin begin
ARecord := FCurrentRecBuf; ARecord := FCurrentRecBuf;
@ -2050,8 +2084,8 @@ begin
StartBuf := 0; StartBuf := 0;
Result := False; Result := False;
for x := StartBuf to high(FUpdateBuffer) do for x := StartBuf to high(FUpdateBuffer) do
if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].BookmarkData,@ABookmark) or if FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].BookmarkData,@ABookmark) or
(IncludePrior and (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].NextBookmarkData,@ABookmark)) then (IncludePrior and (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].NextBookmarkData,@ABookmark)) then
begin begin
FCurrentUpdateBuffer := x; FCurrentUpdateBuffer := x;
Result := True; Result := True;
@ -2064,10 +2098,10 @@ function TCustomBufDataset.GetRecordUpdateBufferCached(const ABookmark: TBufBook
begin begin
// if the current update buffer matches, immediately return true // if the current update buffer matches, immediately return true
if (FCurrentUpdateBuffer < length(FUpdateBuffer)) and ( if (FCurrentUpdateBuffer < length(FUpdateBuffer)) and (
FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) or FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) or
(IncludePrior (IncludePrior
and (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind=ukDelete) and (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind=ukDelete)
and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData,@ABookmark))) then and FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData,@ABookmark))) then
begin begin
Result := True; Result := True;
end end
@ -2290,7 +2324,7 @@ var StoreRecBM : TBufBookmark;
{for x := length(FUpdateBuffer)-1 downto 0 do {for x := length(FUpdateBuffer)-1 downto 0 do
begin begin
if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then
CancelUpdBuffer(FUpdateBuffer[x]); CancelUpdBuffer(FUpdateBuffer[x]);
end;} end;}
FreeRecordBuffer(OldValuesBuffer); FreeRecordBuffer(OldValuesBuffer);
@ -2314,7 +2348,7 @@ var StoreRecBM : TBufBookmark;
FCurrentIndex.GotoBookmark(@Bm); FCurrentIndex.GotoBookmark(@Bm);
TmpBuf:=FCurrentIndex.CurrentRecord; TmpBuf:=FCurrentIndex.CurrentRecord;
// resync won't work if the currentbuffer is freed... // resync won't work if the currentbuffer is freed...
if FCurrentIndex.CompareBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do if FCurrentIndex.SameBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do
begin begin
GotoBookmark(@StoreRecBM); GotoBookmark(@StoreRecBM);
if ScrollForward = grEOF then if ScrollForward = grEOF then
@ -2880,7 +2914,7 @@ procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader);
if GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,False) then if GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,False) then
begin begin
repeat repeat
if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then if FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then
StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState); StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState);
until not GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,True) until not GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,True)
end; end;
@ -3051,13 +3085,16 @@ begin
Result:=assigned(FCurrentIndex) and FCurrentIndex.BookmarkValid(pointer(ABookmark)); Result:=assigned(FCurrentIndex) and FCurrentIndex.BookmarkValid(pointer(ABookmark));
end; end;
function TCustomBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark function TCustomBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
): Longint;
begin begin
if not assigned(Bookmark1) or not assigned(Bookmark2) then if Bookmark1 = Bookmark2 then
Result := 0
else if Assigned(FCurrentIndex) and FCurrentIndex.CompareBookmarks(pointer(Bookmark1),pointer(Bookmark2)) then
Result := 0 Result := 0
else if not assigned(Bookmark1) then
Result := 1
else if not assigned(Bookmark2) then
Result := -1
else if assigned(FCurrentIndex) then
Result := FCurrentIndex.CompareBookmarks(pointer(Bookmark1),pointer(Bookmark2))
else else
Result := -1; Result := -1;
end; end;
@ -3148,7 +3185,7 @@ begin
FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData); FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData);
for x := FCurrentUpdateBuffer+1 to length(FUpdateBuffer)-1 do for x := FCurrentUpdateBuffer+1 to length(FUpdateBuffer)-1 do
if Findexes[0].CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@FUpdateBuffer[x].NextBookmarkData) then if FIndexes[0].SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@FUpdateBuffer[x].NextBookmarkData) then
FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[x].NextBookmarkData); FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[x].NextBookmarkData);
AddRecordBuffer:=False; AddRecordBuffer:=False;

23
packages/fcl-db/src/base/bufdataset_parser.pp
View File

@ -143,6 +143,12 @@ type
procedure Refresh(Buffer: TRecordBuffer); override; procedure Refresh(Buffer: TRecordBuffer); override;
end; end;
TBCDFieldVar = class(TFloatFieldVar)
public
procedure Refresh(Buffer: TRecordBuffer); override;
end;
//--TFieldVar---------------------------------------------------------------- //--TFieldVar----------------------------------------------------------------
constructor TFieldVar.Create(UseField: TField); constructor TFieldVar.Create(UseField: TField);
begin begin
@ -273,6 +279,16 @@ begin
FFieldVal := False; FFieldVal := False;
end; end;
procedure TBCDFieldVar.Refresh(Buffer: TRecordBuffer);
var c: currency;
begin
if FField.DataSet.GetFieldData(FField,@c) then
FFieldVal := c
else
FFieldVal := 0;
end;
//--TBufDatasetParser--------------------------------------------------------------- //--TBufDatasetParser---------------------------------------------------------------
constructor TBufDatasetParser.Create(Adataset: TDataSet); constructor TBufDatasetParser.Create(Adataset: TDataSet);
@ -387,7 +403,7 @@ begin
TempFieldVar := TFloatFieldVar.Create(FieldInfo); TempFieldVar := TFloatFieldVar.Create(FieldInfo);
TempFieldVar.FExprWord := DefineFloatVariable(VarName, TempFieldVar.FieldVal); TempFieldVar.FExprWord := DefineFloatVariable(VarName, TempFieldVar.FieldVal);
end; end;
ftAutoInc, ftInteger, ftSmallInt: ftAutoInc, ftInteger, ftSmallInt, ftWord:
begin begin
TempFieldVar := TIntegerFieldVar.Create(FieldInfo); TempFieldVar := TIntegerFieldVar.Create(FieldInfo);
TempFieldVar.FExprWord := DefineIntegerVariable(VarName, TempFieldVar.FieldVal); TempFieldVar.FExprWord := DefineIntegerVariable(VarName, TempFieldVar.FieldVal);
@ -402,6 +418,11 @@ begin
TempFieldVar := TDateTimeFieldVar.Create(FieldInfo); TempFieldVar := TDateTimeFieldVar.Create(FieldInfo);
TempFieldVar.FExprWord := DefineDateTimeVariable(VarName, TempFieldVar.FieldVal); TempFieldVar.FExprWord := DefineDateTimeVariable(VarName, TempFieldVar.FieldVal);
end; end;
ftBCD:
begin
TempFieldVar := TBCDFieldVar.Create(FieldInfo);
TempFieldVar.FExprWord := DefineFloatVariable(VarName, TempFieldVar.FieldVal);
end;
else else
raise EDatabaseError.CreateFmt(SErrIndexBasedOnInvField, [VarName,Fieldtypenames[FieldInfo.DataType]]); raise EDatabaseError.CreateFmt(SErrIndexBasedOnInvField, [VarName,Fieldtypenames[FieldInfo.DataType]]);
end; end;

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

@ -105,7 +105,9 @@ begin
begin begin
FFieldDef := nil; FFieldDef := nil;
FieldIndex := FieldDefs.IndexOf(Fields[i].FieldName); FieldIndex := FieldDefs.IndexOf(Fields[i].FieldName);
if FieldIndex <> -1 then if FieldIndex = -1 then
DatabaseErrorFmt(SFieldNotFound,[Fields[i].FieldName],Self)
else
begin begin
FFieldDef := FieldDefs[FieldIndex]; FFieldDef := FieldDefs[FieldIndex];
FFieldNo := FFieldDef.FieldNo; FFieldNo := FFieldDef.FieldNo;

17
packages/fcl-db/src/base/sqlscript.pp
View File

@ -278,7 +278,11 @@ function TCustomSQLScript.Available: Boolean;
begin begin
With FSQL do With FSQL do
Result:=(FLine<Count) or (FCol<Length(Strings[Count-1])) Result:=(FLine<Count) or
(
( FLine = Count ) and
( FCol < Length(Strings[Count-1] ) )
);
end; end;
procedure TCustomSQLScript.InternalStatement(Statement: TStrings; var StopExecution: Boolean); procedure TCustomSQLScript.InternalStatement(Statement: TStrings; var StopExecution: Boolean);
@ -442,12 +446,11 @@ function TCustomSQLScript.NextStatement: AnsiString;
var var
pnt: AnsiString; pnt: AnsiString;
addnewline,terminator_found: Boolean; terminator_found: Boolean;
begin begin
terminator_found:=False; terminator_found:=False;
ClearStatement; ClearStatement;
addnewline:=false;
while FLine <= FSQL.Count do while FLine <= FSQL.Count do
begin begin
pnt:=FindNextSeparator([FTerminator, '/*', '"', '''', '--']); pnt:=FindNextSeparator([FTerminator, '/*', '"', '''', '--']);
@ -477,12 +480,9 @@ begin
begin begin
FComment:=True; FComment:=True;
if FCommentsInSQL then if FCommentsInSQL then
begin
AddToStatement(Copy(FSQL[FLine-1],FCol,Length(FSQL[FLine-1])-FCol+1),False); AddToStatement(Copy(FSQL[FLine-1],FCol,Length(FSQL[FLine-1])-FCol+1),False);
AddNewLine:=true;
end;
Inc(Fline); Inc(Fline);
FCol:=0; FCol:=1;
FComment:=False; FComment:=False;
end end
else if pnt = '"' then else if pnt = '"' then
@ -498,8 +498,7 @@ begin
AddToStatement(pnt,False); AddToStatement(pnt,False);
FCol:=FCol + length(pnt); FCol:=FCol + length(pnt);
pnt:=FindNextSeparator(['''']); pnt:=FindNextSeparator(['''']);
AddToStatement(pnt,addnewline); AddToStatement(pnt,false);
addnewline:=False;
FCol:=FCol + length(pnt); FCol:=FCol + length(pnt);
end; end;
end; end;

9
packages/fcl-db/src/memds/memds.pp
View File

@ -132,6 +132,7 @@ type
constructor Create(AOwner:TComponent); override; constructor Create(AOwner:TComponent); override;
destructor Destroy; override; destructor Destroy; override;
function BookmarkValid(ABookmark: TBookmark): Boolean; override; function BookmarkValid(ABookmark: TBookmark): Boolean; override;
function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override; function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): boolean; override; function Locate(const KeyFields: string; const KeyValues: Variant; Options: TLocateOptions): boolean; override;
function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override; function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
@ -418,6 +419,14 @@ begin
Result := (ReqBookmark>=0) and (ReqBookmark<FRecCount); Result := (ReqBookmark>=0) and (ReqBookmark<FRecCount);
end; end;
function TMemDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
const r: array[Boolean, Boolean] of ShortInt = ((2,-1),(1,0));
begin
Result := r[Bookmark1=nil, Bookmark2=nil];
if Result = 2 then
Result := PInteger(Bookmark1)^ - PInteger(Bookmark2)^;
end;
function TMemDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode function TMemDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode
): TStream; ): TStream;
begin begin

13
packages/fcl-db/src/sdf/sdfdata.pp
View File

@ -209,8 +209,8 @@ type
procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override; procedure SetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
procedure SetFieldData(Field: TField; Buffer: Pointer); override; procedure SetFieldData(Field: TField; Buffer: Pointer); override;
procedure ClearCalcFields(Buffer: TRecordBuffer); override; procedure ClearCalcFields(Buffer: TRecordBuffer); override;
function GetRecordCount: Integer; override; function GetRecordCount: Longint; override;
function GetRecNo: Integer; override; function GetRecNo: Longint; override;
procedure SetRecNo(Value: Integer); override; procedure SetRecNo(Value: Integer); override;
function GetCanModify: boolean; override; function GetCanModify: boolean; override;
function RecordFilter(RecBuf: TRecordBuffer): Boolean; function RecordFilter(RecBuf: TRecordBuffer): Boolean;
@ -222,6 +222,7 @@ type
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
function BookmarkValid(ABookmark: TBookmark): Boolean; override; function BookmarkValid(ABookmark: TBookmark): Boolean; override;
function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; override;
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override; function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
procedure RemoveBlankRecords; dynamic; procedure RemoveBlankRecords; dynamic;
procedure RemoveExtraColumns; dynamic; procedure RemoveExtraColumns; dynamic;
@ -780,6 +781,14 @@ begin
Result := Assigned(ABookmark) and (FData.IndexOfObject(TObject(PPtrInt(ABookmark)^)) <> -1); Result := Assigned(ABookmark) and (FData.IndexOfObject(TObject(PPtrInt(ABookmark)^)) <> -1);
end; end;
function TFixedFormatDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
const r: array[Boolean, Boolean] of ShortInt = ((2,-1),(1,0));
begin
Result := r[Bookmark1=nil, Bookmark2=nil];
if Result = 2 then
Result := PPtrInt(Bookmark1)^ - PPtrInt(Bookmark2)^;
end;
procedure TFixedFormatDataSet.InternalGotoBookmark(ABookmark: Pointer); procedure TFixedFormatDataSet.InternalGotoBookmark(ABookmark: Pointer);
var var
Index: Integer; Index: Integer;

19
packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
View File

@ -106,6 +106,7 @@ Type
TConnectionName = class (TSQLConnection) TConnectionName = class (TSQLConnection)
private private
FSkipLibrarVersionCheck : Boolean;
FHostInfo: String; FHostInfo: String;
FServerInfo: String; FServerInfo: String;
FMySQL : PMySQL; FMySQL : PMySQL;
@ -164,6 +165,7 @@ Type
property ClientInfo: string read GetClientInfo; property ClientInfo: string read GetClientInfo;
property ServerStatus : String read GetServerStatus; property ServerStatus : String read GetServerStatus;
published published
Property SkipLibrarVersionCheck : Boolean Read FSkipLibrarVersionCheck Write FSkipLibrarVersionCheck;
property DatabaseName; property DatabaseName;
property HostName; property HostName;
property KeepConnection; property KeepConnection;
@ -495,13 +497,16 @@ var
FullVersion: string; FullVersion: string;
begin begin
InitialiseMysql; InitialiseMysql;
FullVersion:=strpas(mysql_get_client_info()); if not SkipLibrarVersionCheck then
// Version string should start with version number: begin
// Note: in case of MariaDB version mismatch: tough luck, we report MySQL FullVersion:=strpas(mysql_get_client_info());
// version only. // Version string should start with version number:
if (pos(MySQLVersion, FullVersion) <> 1) and // Note: in case of MariaDB version mismatch: tough luck, we report MySQL
(pos(MariaDBVersion, FullVersion) <> 1) then // version only.
Raise EInOutError.CreateFmt(SErrVersionMisMatch,[ClassName,MySQLVersion,FullVersion]); if (pos(MySQLVersion, FullVersion) <> 1) and
(pos(MariaDBVersion, FullVersion) <> 1) then
Raise EInOutError.CreateFmt(SErrVersionMisMatch,[ClassName,MySQLVersion,FullVersion]);
end;
inherited DoInternalConnect; inherited DoInternalConnect;
ConnectToServer; ConnectToServer;
SelectDatabase; SelectDatabase;

4
packages/fcl-db/src/sqldb/postgres/pqconnection.pp
View File

@ -1006,9 +1006,9 @@ begin
begin begin
case AParams[i].DataType of case AParams[i].DataType of
ftDateTime: ftDateTime:
s := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', AParams[i].AsDateTime); s := FormatDateTime('yyyy"-"mm"-"dd hh":"nn":"ss.zzz', AParams[i].AsDateTime);
ftDate: ftDate:
s := FormatDateTime('yyyy-mm-dd', AParams[i].AsDateTime); s := FormatDateTime('yyyy"-"mm"-"dd', AParams[i].AsDateTime);
ftTime: ftTime:
s := FormatTimeInterval(AParams[i].AsDateTime); s := FormatTimeInterval(AParams[i].AsDateTime);
ftFloat, ftBCD: ftFloat, ftBCD:

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

@ -25,6 +25,13 @@ uses SysUtils, Classes, DB, bufdataset, sqlscript;
type type
TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata, stSequences); TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata, stSequences);
const
TSchemaObjectNames: array[TSchemaType] of String = ('???', 'table_name',
'???', 'procedure_name', 'column_name', 'param_name',
'index_name', 'package_name', 'schema_name','sequence');
type
TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete, TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete,
stDDL, stGetSegment, stPutSegment, stExecProcedure, stDDL, stGetSegment, stPutSegment, stExecProcedure,
stStartTrans, stCommit, stRollback, stSelectForUpd); stStartTrans, stCommit, stRollback, stSelectForUpd);
@ -135,6 +142,33 @@ type
procedure Update; override; procedure Update; override;
end; end;
TSqlObjectIdentifierList = class;
{ TSqlObjectIdenfier }
TSqlObjectIdenfier = class(TCollectionItem)
private
FObjectName: String;
FSchemaName: String;
public
constructor Create(ACollection: TSqlObjectIdentifierList; Const AObjectName: String; Const ASchemaName: String = '');
property SchemaName: String read FSchemaName write FSchemaName;
property ObjectName: String read FObjectName write FObjectName;
end;
{ TSqlObjectIdentifierList }
TSqlObjectIdentifierList = class(TCollection)
private
function GetIdentifier(Index: integer): TSqlObjectIdenfier;
procedure SetIdentifier(Index: integer; AValue: TSqlObjectIdenfier);
public
function AddIdentifier: TSqlObjectIdenfier; overload;
function AddIdentifier(Const AObjectName: String; Const ASchemaName: String = ''): TSqlObjectIdenfier; overload;
property Identifiers[Index: integer]: TSqlObjectIdenfier read GetIdentifier write SetIdentifier; default;
end;
type type
{ TSQLConnection } { TSQLConnection }
@ -221,6 +255,7 @@ type
function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual; function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual;
function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; virtual; function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; virtual;
function GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; virtual;
Procedure MaybeConnect; Procedure MaybeConnect;
Property Statements : TFPList Read FStatements; Property Statements : TFPList Read FStatements;
@ -784,6 +819,31 @@ begin
end; end;
{ TSqlObjectIdentifierList }
function TSqlObjectIdentifierList.GetIdentifier(Index: integer): TSqlObjectIdenfier;
begin
Result := Items[Index] as TSqlObjectIdenfier;
end;
procedure TSqlObjectIdentifierList.SetIdentifier(Index: integer; AValue: TSqlObjectIdenfier);
begin
Items[Index] := AValue;
end;
function TSqlObjectIdentifierList.AddIdentifier: TSqlObjectIdenfier;
begin
Result:=Add as TSqlObjectIdenfier;
end;
function TSqlObjectIdentifierList.AddIdentifier(Const AObjectName: String;
Const ASchemaName: String = ''): TSqlObjectIdenfier;
begin
Result:=AddIdentifier();
Result.SchemaName:=ASchemaName;
Result.ObjectName:=AObjectName;
end;
{ TSQLDBFieldDefs } { TSQLDBFieldDefs }
class function TSQLDBFieldDefs.FieldDefClass: TFieldDefClass; class function TSQLDBFieldDefs.FieldDefClass: TFieldDefClass;
@ -1228,11 +1288,11 @@ begin
if not ATransaction.Active then if not ATransaction.Active then
ATransaction.MaybeStartTransaction; ATransaction.MaybeStartTransaction;
try SQL := TrimRight(SQL);
SQL := TrimRight(SQL); if SQL = '' then
if SQL = '' then DatabaseError(SErrNoStatement);
DatabaseError(SErrNoStatement);
try
Cursor := AllocateCursorHandle; Cursor := AllocateCursorHandle;
Cursor.FStatementType := stUnknown; Cursor.FStatementType := stUnknown;
If LogEvent(detPrepare) then If LogEvent(detPrepare) then
@ -1354,6 +1414,43 @@ begin
GetDBInfo(stSequences,'','SEQUENCE_NAME',List); GetDBInfo(stSequences,'','SEQUENCE_NAME',List);
end; end;
Function TSQLConnection.GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList) : Integer;
var
qry : TCustomSQLQuery;
vSchemaName, vObjectName: String;
f: TField;
begin
Result:=0;
if not assigned(Transaction) then
DatabaseError(SErrConnTransactionnSet);
qry := TCustomSQLQuery.Create(nil);
try
qry.transaction := Transaction;
qry.database := Self;
with qry do
begin
ParseSQL := False;
SetSchemaInfo(ASchemaType,TSchemaObjectNames[ASchemaType],'');
open;
f:=FindField(TSchemaObjectNames[stSchemata]);
while not eof do
begin
vSchemaName:='';
if Assigned(f) then
vSchemaName:=f.AsString;
vObjectName:=FieldByName(FSchemaObjectName).AsString;
AList.AddIdentifier(vObjectName, vSchemaName);
Next;
Inc(Result);
end;
end;
finally
qry.free;
end;
end;
function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string; function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string;
var i: TConnInfoType; var i: TConnInfoType;
begin begin
@ -3270,6 +3367,7 @@ begin
If Assigned(FProxy) then If Assigned(FProxy) then
FreeProxy; FreeProxy;
FConnectorType:=AValue; FConnectorType:=AValue;
CreateProxy;
end; end;
end; end;
@ -3287,7 +3385,7 @@ Var
begin begin
inherited DoInternalConnect; inherited DoInternalConnect;
CreateProxy; CheckProxy;
FProxy.CharSet:=Self.CharSet; FProxy.CharSet:=Self.CharSet;
FProxy.DatabaseName:=Self.DatabaseName; FProxy.DatabaseName:=Self.DatabaseName;
FProxy.HostName:=Self.HostName; FProxy.HostName:=Self.HostName;
@ -3327,6 +3425,7 @@ begin
DatabaseErrorFmt(SErrUnknownConnectorType,[ConnectorType],Self); DatabaseErrorFmt(SErrUnknownConnectorType,[ConnectorType],Self);
FProxy:=D.ConnectionClass.Create(Self); FProxy:=D.ConnectionClass.Create(Self);
FFieldNameQuoteChars := FProxy.FieldNameQuoteChars; FFieldNameQuoteChars := FProxy.FieldNameQuoteChars;
FConnOptions := FProxy.ConnOptions;
end; end;
procedure TSQLConnector.FreeProxy; procedure TSQLConnector.FreeProxy;
@ -3548,6 +3647,16 @@ begin
end; end;
end; end;
{ TSqlObjectIdenfier }
constructor TSqlObjectIdenfier.Create(ACollection: TSqlObjectIdentifierList;
const AObjectName: String; Const ASchemaName: String = '');
begin
inherited Create(ACollection);
FSchemaName:=ASchemaName;
FObjectName:=AObjectName;
end;
Initialization Initialization
Finalization Finalization

92
packages/fcl-db/src/sqlite/customsqliteds.pas
View File

@ -109,6 +109,7 @@ type
{$endif} {$endif}
FInternalActiveBuffer: PDataRecord; FInternalActiveBuffer: PDataRecord;
FInsertBookmark: PDataRecord; FInsertBookmark: PDataRecord;
FFilterBuffer: TRecordBuffer;
FOnCallback: TSqliteCallback; FOnCallback: TSqliteCallback;
FMasterLink: TMasterDataLink; FMasterLink: TMasterDataLink;
FIndexFieldNames: String; FIndexFieldNames: String;
@ -176,6 +177,7 @@ type
procedure DoBeforeClose; override; procedure DoBeforeClose; override;
procedure DoAfterInsert; override; procedure DoAfterInsert; override;
procedure DoBeforeInsert; override; procedure DoBeforeInsert; override;
procedure DoFilterRecord(var Acceptable: Boolean); virtual;
procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override; procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override;
procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override; procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override;
function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override; function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override;
@ -578,6 +580,13 @@ begin
inherited DoBeforeInsert; inherited DoBeforeInsert;
end; end;
procedure TCustomSqliteDataset.DoFilterRecord(var Acceptable: Boolean);
begin
Acceptable := True;
if Assigned(OnFilterRecord) then
OnFilterRecord(Self, Acceptable);
end;
destructor TCustomSqliteDataset.Destroy; destructor TCustomSqliteDataset.Destroy;
begin begin
inherited Destroy; inherited Destroy;
@ -746,10 +755,14 @@ begin
else else
FieldOffset := FieldDefs.Count + FCalcFieldList.IndexOf(Field); FieldOffset := FieldDefs.Count + FCalcFieldList.IndexOf(Field);
if not (State in [dsCalcFields, dsInternalCalc]) then case State of
FieldRow := PPDataRecord(ActiveBuffer)^^.Row[FieldOffset] dsCalcFields, dsInternalCalc:
else FieldRow := PPDataRecord(CalcBuffer)^^.Row[FieldOffset];
FieldRow := PPDataRecord(CalcBuffer)^^.Row[FieldOffset]; dsFilter:
FieldRow := PPDataRecord(FFilterBuffer)^^.Row[FieldOffset];
else
FieldRow := PPDataRecord(ActiveBuffer)^^.Row[FieldOffset];
end;
Result := FieldRow <> nil; Result := FieldRow <> nil;
if Result and (Buffer <> nil) then //supports GetIsNull if Result and (Buffer <> nil) then //supports GetIsNull
@ -789,31 +802,46 @@ begin
end; end;
function TCustomSqliteDataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; function TCustomSqliteDataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
var
Acceptable: Boolean;
SaveState: TDataSetState;
begin begin
Result := grOk; Result := grOk;
case GetMode of repeat
gmPrior: Acceptable := True;
if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then case GetMode of
Result := grBOF gmPrior:
else if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then
FCurrentItem:=FCurrentItem^.Previous; Result := grBOF
gmCurrent: else
if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then FCurrentItem:=FCurrentItem^.Previous;
Result := grError; gmCurrent:
gmNext: if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then
if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then Result := grError;
Result := grEOF gmNext:
else if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then
FCurrentItem := FCurrentItem^.Next; Result := grEOF
end; //case else
if Result = grOk then FCurrentItem := FCurrentItem^.Next;
begin end; //case
PDataRecord(Pointer(Buffer)^) := FCurrentItem; if Result = grOk then
FCurrentItem^.BookmarkFlag := bfCurrent; begin
GetCalcFields(Buffer); PDataRecord(Pointer(Buffer)^) := FCurrentItem;
end FCurrentItem^.BookmarkFlag := bfCurrent;
else if (Result = grError) and DoCheck then GetCalcFields(Buffer);
DatabaseError('No records found', Self); if Filtered then
begin
FFilterBuffer := Buffer;
SaveState := SetTempState(dsFilter);
DoFilterRecord(Acceptable);
if (GetMode = gmCurrent) and not Acceptable then
Result := grError;
RestoreState(SaveState);
end;
end
else if (Result = grError) and DoCheck then
DatabaseError('No records found', Self);
until (Result <> grOK) or Acceptable;
end; end;
function TCustomSqliteDataset.GetRecordCount: Integer; function TCustomSqliteDataset.GetRecordCount: Integer;
@ -1573,7 +1601,7 @@ begin
FMasterLink.DataSource := Value; FMasterLink.DataSource := Value;
end; end;
procedure TCustomSqliteDataset.ExecSQL(const ASQL: String); procedure TCustomSqliteDataset.ExecSQL(const ASql: String);
begin begin
if FSqliteHandle = nil then if FSqliteHandle = nil then
GetSqliteHandle; GetSqliteHandle;
@ -1831,7 +1859,8 @@ begin
Result := False; Result := False;
end; end;
procedure TCustomSqliteDataset.ExecCallback(const ASQL: String; UserData: Pointer = nil); procedure TCustomSqliteDataset.ExecCallback(const ASql: String;
UserData: Pointer);
var var
CallbackInfo: TCallbackInfo; CallbackInfo: TCallbackInfo;
begin begin
@ -1913,12 +1942,13 @@ begin
(FAddedItems.Count > 0) or (FDeletedItems.Count > 0); (FAddedItems.Count > 0) or (FDeletedItems.Count > 0);
end; end;
function TCustomSqliteDataset.QuickQuery(const ASQL: String): String; function TCustomSqliteDataset.QuickQuery(const ASql: String): String;
begin begin
Result := QuickQuery(ASQL, nil, False); Result := QuickQuery(ASQL, nil, False);
end; end;
function TCustomSqliteDataset.QuickQuery(const ASQL: String; const AStrList: TStrings): String; function TCustomSqliteDataset.QuickQuery(const ASql: String;
const AStrList: TStrings): String;
begin begin
Result := QuickQuery(ASQL, AStrList, False) Result := QuickQuery(ASQL, AStrList, False)
end; end;

10
packages/fcl-db/src/sqlite/sqlite3ds.pas
View File

@ -227,17 +227,17 @@ begin
SQLITE_FLOAT: SQLITE_FLOAT:
AType := ftFloat; AType := ftFloat;
else else
begin begin
AType := ftString; AType := ftString;
DataSize := DefaultStringSize; DataSize := DefaultStringSize;
end; end;
end; end;
end else end else
begin begin
AType := ftString; AType := ftString;
DataSize := DefaultStringSize; DataSize := DefaultStringSize;
end; end;
FieldDefs.Add(String(sqlite3_column_name(vm, i)), AType, DataSize); FieldDefs.Add(FieldDefs.MakeNameUnique(String(sqlite3_column_name(vm, i))), AType, DataSize);
//Set the pchar2sql function //Set the pchar2sql function
case AType of case AType of
ftString: ftString:

10
packages/fcl-db/src/sqlite/sqliteds.pas
View File

@ -184,12 +184,16 @@ begin
begin begin
AType := ftString; AType := ftString;
end; end;
FieldDefs.Add(String(ColumnNames[i]), AType, DataSize); FieldDefs.Add(FieldDefs.MakeNameUnique(String(ColumnNames[i])), AType, DataSize);
//Set the pchar2sql function //Set the pchar2sql function
if AType in [ftString, ftMemo] then case AType of
FGetSqlStr[i] := @Char2SQLStr ftString:
FGetSqlStr[i] := @Char2SQLStr;
ftMemo:
FGetSqlStr[i] := @Memo2SQLStr;
else else
FGetSqlStr[i] := @Num2SQLStr; FGetSqlStr[i] := @Num2SQLStr;
end;
end; end;
sqlite_finalize(vm, nil); sqlite_finalize(vm, nil);
{ {

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

@ -28,7 +28,9 @@ uses
TestSpecificTBufDataset, TestSpecificTBufDataset,
TestSpecificTDBF, TestSpecificTDBF,
TestSpecificTMemDataset, TestSpecificTMemDataset,
TestDBExport, tccsvdataset, TestDBExport,
tccsvdataset,
testsqlscript,
consoletestrunner; consoletestrunner;
Procedure LegacyOutput; Procedure LegacyOutput;

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

@ -8,7 +8,7 @@ interface
uses uses
{$IFDEF FPC} {$IFDEF FPC}
fpcunit, testregistry, testregistry,
{$ELSE FPC} {$ELSE FPC}
TestFramework, TestFramework,
{$ENDIF FPC} {$ENDIF FPC}
@ -58,6 +58,7 @@ type
procedure TestAssignFieldftFixedChar; procedure TestAssignFieldftFixedChar;
procedure TestSelectQueryBasics; procedure TestSelectQueryBasics;
procedure TestPostOnlyInEditState; procedure TestPostOnlyInEditState;
procedure TestCancel;
procedure TestMove; // bug 5048 procedure TestMove; // bug 5048
procedure TestActiveBufferWhenClosed; procedure TestActiveBufferWhenClosed;
procedure TestEOFBOFClosedDataset; procedure TestEOFBOFClosedDataset;
@ -138,6 +139,7 @@ type
procedure TestBookmarks; procedure TestBookmarks;
procedure TestBookmarkValid; procedure TestBookmarkValid;
procedure TestCompareBookmarks;
procedure TestDelete1; procedure TestDelete1;
procedure TestDelete2; procedure TestDelete2;
@ -274,6 +276,18 @@ begin
end; end;
end; end;
procedure TTestDBBasics.TestCancel;
begin
with DBConnector.GetNDataset(1) do
begin
Open;
Edit;
FieldByName('name').AsString := 'EditName1';
Cancel;
CheckEquals('TestName1', FieldByName('name').AsString, 'Cancel did not restored previous value');
end;
end;
procedure TTestDBBasics.TestMove; procedure TTestDBBasics.TestMove;
var i,count : integer; var i,count : integer;
aDatasource : TDataSource; aDatasource : TDataSource;
@ -802,7 +816,7 @@ begin
end; end;
procedure TTestCursorDBBasics.TestBookmarkValid; procedure TTestCursorDBBasics.TestBookmarkValid;
var BM1,BM2,BM3,BM4,BM5 : TBookmark; var BM1,BM2,BM3,BM4,BM5,BM6 : TBookmark;
begin begin
with DBConnector.GetNDataset(true,14) do with DBConnector.GetNDataset(true,14) do
begin begin
@ -834,9 +848,39 @@ begin
CheckTrue(BookmarkValid(BM3)); CheckTrue(BookmarkValid(BM3));
CheckTrue(BookmarkValid(BM2)); CheckTrue(BookmarkValid(BM2));
CheckTrue(BookmarkValid(BM1)); CheckTrue(BookmarkValid(BM1));
Append;
BM6 := GetBookmark;
CheckFalse(BookmarkValid(BM6));
end; end;
end; end;
procedure TTestCursorDBBasics.TestCompareBookmarks;
var
FirstBookmark, LastBookmark, EditBookmark, PostEditBookmark: TBookmark;
begin
with DBConnector.GetNDataset(true,14) do
begin
Open;
FirstBookmark := GetBookmark;
Edit;
EditBookmark := GetBookmark;
Post;
PostEditBookmark := GetBookmark;
Last;
LastBookmark := GetBookmark;
CheckEquals(0, CompareBookmarks(FirstBookmark, EditBookmark));
CheckEquals(0, CompareBookmarks(EditBookmark, PostEditBookmark));
CheckTrue(CompareBookmarks(FirstBookmark, LastBookmark) < 0, 'b1<b2');
CheckTrue(CompareBookmarks(LastBookmark, FirstBookmark) > 0, 'b1>b2');
CheckEquals(0, CompareBookmarks(nil, nil), '(nil,nil)');
CheckEquals(-1, CompareBookmarks(FirstBookmark, nil), '(b1,nil)');
CheckEquals(+1, CompareBookmarks(nil, FirstBookmark), '(nil,b2)');
end;
end;
procedure TTestCursorDBBasics.TestLocate; procedure TTestCursorDBBasics.TestLocate;
begin begin
with DBConnector.GetNDataset(true,13) do with DBConnector.GetNDataset(true,13) do

34
packages/fcl-db/tests/testsqlscript.pas
View File

@ -12,7 +12,7 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************} **********************************************************************}
unit testcsqlscript; unit testsqlscript;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
@ -34,7 +34,7 @@ type
protected protected
procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override; procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override;
procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override; procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override;
procedure ExecuteCommit; override; procedure ExecuteCommit(CommitRetaining: boolean=true); override;
procedure DefaultDirectives; override; procedure DefaultDirectives; override;
public public
constructor create (AnOwner: TComponent); override; constructor create (AnOwner: TComponent); override;
@ -98,6 +98,7 @@ type
procedure TestCommentInComment; procedure TestCommentInComment;
procedure TestCommentInQuotes1; procedure TestCommentInQuotes1;
procedure TestCommentInQuotes2; procedure TestCommentInQuotes2;
Procedure TestDashDashComment;
procedure TestQuote1InComment; procedure TestQuote1InComment;
procedure TestQuote2InComment; procedure TestQuote2InComment;
procedure TestQuoteInQuotes1; procedure TestQuoteInQuotes1;
@ -174,7 +175,7 @@ begin
raise exception.create(DoException); raise exception.create(DoException);
end; end;
procedure TMyScript.ExecuteCommit; procedure TMyScript.ExecuteCommit(CommitRetaining: boolean=true);
begin begin
inc (FCommits); inc (FCommits);
if DoException <> '' then if DoException <> '' then
@ -270,7 +271,20 @@ begin
AssertFalse ('Aborted', Aborted); AssertFalse ('Aborted', Aborted);
AssertEquals ('Line', 0, Line); AssertEquals ('Line', 0, Line);
AssertEquals ('Defines', 0, Defines.count); AssertEquals ('Defines', 0, Defines.count);
AssertEquals ('Directives', 10, Directives.count); AssertEquals ('Directives', 12, Directives.count);
AssertTrue('Have SET TERM',Directives.IndexOf('SET TERM')<>-1);
AssertTrue('Have COMMIT WORK',Directives.IndexOf('COMMIT WORK')<>-1);
AssertTrue('Have COMMIT RETAIN',Directives.IndexOf('COMMIT RETAIN')<>-1);
AssertTrue('Have COMMIT',Directives.IndexOf('COMMIT')<>-1);
AssertTrue('Have #IFDEF',Directives.IndexOf('#IFDEF')<>-1);
AssertTrue('Have #IFNDEF',Directives.IndexOf('#IFNDEF')<>-1);
AssertTrue('Have #ELSE',Directives.IndexOf('#ELSE')<>-1);
AssertTrue('Have #ENDIF',Directives.IndexOf('#ENDIF')<>-1);
AssertTrue('Have #DEFINE',Directives.IndexOf('#DEFINE')<>-1);
AssertTrue('Have #UNDEF',Directives.IndexOf('#UNDEF')<>-1);
AssertTrue('Have #UNDEFINE',Directives.IndexOf('#UNDEFINE')<>-1);
// This is defined in our test class.
AssertTrue('Have STOP',Directives.IndexOf('STOP')<>-1);
end; end;
end; end;
@ -513,6 +527,18 @@ begin
AssertStatDir('"iets ""/* meer */"""', ''); AssertStatDir('"iets ""/* meer */"""', '');
end; end;
procedure TTestSQLScript.TestDashDashComment;
begin
script.CommentsInSQL := false;
Add('-- my comment');
Add('CREATE TABLE "tPatients" (');
Add(' "BloodGroup" character(2),');
Add(' CONSTRAINT "ck_tPatients_BloodGroup" CHECK (("BloodGroup" = ANY (ARRAY[''A''::bpchar, ''B''::bpchar, ''AB''::bpchar, ''0''::bpchar]))),');
Add(');');
script.execute;
AssertStatDir('"CREATE TABLE ""tPatients"" ( ""BloodGroup"" character(2), CONSTRAINT ""ck_tPatients_BloodGroup"" CHECK ((""BloodGroup"" = ANY (ARRAY[''A''::bpchar, ''B''::bpchar, ''AB''::bpchar, ''0''::bpchar]))), )"', '');
end;
procedure TTestSQLScript.TestQuote1InComment; procedure TTestSQLScript.TestQuote1InComment;
begin begin
script.CommentsInSQL := false; script.CommentsInSQL := false;