paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-20 12:49:08 +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; Var i : integer;
begin 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 if assigned(FUpdateBlobBuffers[i]) and (FUpdateBlobBuffers[i]^.FieldNo>0) then
FreeBlobBuffer(FUpdateBlobBuffers[i]); FreeBlobBuffer(FUpdateBlobBuffers[i]);
end; end;
@ -2431,26 +2431,14 @@ procedure TCustomBufDataset.InternalPost;
Var ABuff : TRecordBuffer; Var ABuff : TRecordBuffer;
i : integer; i : integer;
bufblob : TBufBlobField;
NullMask : pbyte;
ABookmark : PBufBookmark; ABookmark : PBufBookmark;
begin begin
inherited InternalPost; 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 if assigned(FUpdateBlobBuffers[i]) and (FUpdateBlobBuffers[i]^.FieldNo>0) then
begin FUpdateBlobBuffers[i]^.FieldNo := -1;
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;
if State = dsInsert then if State = dsInsert then
begin begin
@ -2764,8 +2752,11 @@ begin
else else
FBlobBuffer^.OrgBufID := -1; FBlobBuffer^.OrgBufID := -1;
bufblob.BlobBuffer := FBlobBuffer; bufblob.BlobBuffer := FBlobBuffer;
// redirect pointer in current record buffer to new write blob buffer
CurrBuff := GetCurrentBuffer; 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]); inc(CurrBuff, FDataSet.FFieldBufPositions[Field.FieldNo-1]);
Move(bufblob, CurrBuff^, FDataSet.GetFieldSize(FDataSet.FieldDefs[Field.FieldNo-1])); Move(bufblob, CurrBuff^, FDataSet.GetFieldSize(FDataSet.FieldDefs[Field.FieldNo-1]));
FModified := True; FModified := True;
@ -2777,11 +2768,16 @@ begin
if FModified then if FModified then
begin begin
// if TBufBlobStream was requested, but no data was written, then Size = 0; // 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 //FField.Modified := True; // should be set to True, but TBlobField.Modified is never reset
if not (FDataSet.State in [dsFilter, dsCalcFields, dsNewValue]) then 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)); FDataSet.DataEvent(deFieldChange, PtrInt(FField));
end;
end; end;
inherited Destroy; inherited Destroy;
end; end;

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

@ -608,9 +608,7 @@ begin
end; end;
procedure TTestFieldTypes.TestChangeBlob; procedure TTestFieldTypes.TestChangeBlob;
var s : string; var s : string;
begin begin
TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID int,FT '+FieldtypeDefinitions[ftblob]+')'); TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID int,FT '+FieldtypeDefinitions[ftblob]+')');
TSQLDBConnector(DBConnector).CommitDDL; TSQLDBConnector(DBConnector).CommitDDL;
@ -633,6 +631,13 @@ begin
Cancel; Cancel;
AssertEquals('After Cancel', 'Test this blob', Fields[1].AsString); // original value 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; Edit;
With CreateBlobStream(Fields[1], bmWrite) do With CreateBlobStream(Fields[1], bmWrite) do
begin begin