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

fcl-db: bufdataset: when data are written to BLOB field (using TBufBlobStream) then unset field null flag when blob stream is created. When writting finishes (on destroy of blob stream) set null flag if blob is empty. + updated test TestChangeBlob. Bug #15376

Browse Source 
git-svn-id: trunk@27089 -
This commit is contained in:
lacak 2014-03-11 09:46:46 +00:00
parent e163a2c813
commit 742c590a3a
2 changed files with 20 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2422,7 +2422,7 @@ procedure TCustomBufDataset.InternalCancel;
Var i : integer;
begin
if assigned(FUpdateBlobBuffers) then for i:=0 to length(FUpdateBlobBuffers)-1 do
if assigned(FUpdateBlobBuffers) then for i:=0 to high(FUpdateBlobBuffers) do
if assigned(FUpdateBlobBuffers[i]) and (FUpdateBlobBuffers[i]^.FieldNo>0) then
FreeBlobBuffer(FUpdateBlobBuffers[i]);
end;
@ -2431,26 +2431,14 @@ procedure TCustomBufDataset.InternalPost;
Var ABuff : TRecordBuffer;
i : integer;
bufblob : TBufBlobField;
NullMask : pbyte;
ABookmark : PBufBookmark;
begin
inherited InternalPost;
if assigned(FUpdateBlobBuffers) then for i:=0 to length(FUpdateBlobBuffers)-1 do
if assigned(FUpdateBlobBuffers) then for i:=0 to high(FUpdateBlobBuffers) do
if assigned(FUpdateBlobBuffers[i]) and (FUpdateBlobBuffers[i]^.FieldNo>0) then
begin
bufblob.BlobBuffer := FUpdateBlobBuffers[i];
NullMask := PByte(ActiveBuffer);
if bufblob.BlobBuffer^.Size = 0 then
SetFieldIsNull(NullMask, bufblob.BlobBuffer^.FieldNo-1)
else
unSetFieldIsNull(NullMask, bufblob.BlobBuffer^.FieldNo-1);
bufblob.BlobBuffer^.FieldNo := -1;
end;
FUpdateBlobBuffers[i]^.FieldNo := -1;
if State = dsInsert then
begin
@ -2764,8 +2752,11 @@ begin
else
FBlobBuffer^.OrgBufID := -1;
bufblob.BlobBuffer := FBlobBuffer;
// redirect pointer in current record buffer to new write blob buffer
CurrBuff := GetCurrentBuffer;
// unset null flag for blob field
unSetFieldIsNull(PByte(CurrBuff), Field.FieldNo-1);
// redirect pointer in current record buffer to new write blob buffer
inc(CurrBuff, FDataSet.FFieldBufPositions[Field.FieldNo-1]);
Move(bufblob, CurrBuff^, FDataSet.GetFieldSize(FDataSet.FieldDefs[Field.FieldNo-1]));
FModified := True;
@ -2777,11 +2768,16 @@ begin
if FModified then
begin
// if TBufBlobStream was requested, but no data was written, then Size = 0;
// used by TBlobField.Clear, so in this case set Field to null in InternalPost
// used by TBlobField.Clear, so in this case set Field to null
//FField.Modified := True; // should be set to True, but TBlobField.Modified is never reset
if not (FDataSet.State in [dsFilter, dsCalcFields, dsNewValue]) then
begin
if FBlobBuffer^.Size = 0 then // empty blob = IsNull
// blob stream should be destroyed while DataSet is in write state
SetFieldIsNull(PByte(FDataSet.GetCurrentBuffer), FField.FieldNo-1);
FDataSet.DataEvent(deFieldChange, PtrInt(FField));
end;
end;
inherited Destroy;
end;

9
packages/fcl-db/tests/testfieldtypes.pas
View File

@ -608,9 +608,7 @@ begin
end;
procedure TTestFieldTypes.TestChangeBlob;
var s : string;
begin
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID int,FT '+FieldtypeDefinitions[ftblob]+')');
TSQLDBConnector(DBConnector).CommitDDL;
@ -633,6 +631,13 @@ begin
Cancel;
AssertEquals('After Cancel', 'Test this blob', Fields[1].AsString); // original value
Append; // Blob is null
Fields[1].AsString := s; // Null flag must be unset
AssertEquals(s, Fields[1].AsString);
Fields[1].Clear;
AssertTrue('Clear', Fields[1].IsNull);
Cancel;
Edit;
With CreateBlobStream(Fields[1], bmWrite) do
begin