Skip to content

Commit 25b6c13

Browse files
MWASoftwareMWASoftware
committed
Testing updated test plan
1 parent 9c1131f commit 25b6c13

File tree

6 files changed

+88
-19
lines changed

6 files changed

+88
-19
lines changed

‎changelog‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,18 @@
11
FBINTF Change Log version (1.4-5 Build 1238) Mon, 20 Jan 2025 11:45:29 +0000
22

33
1. TSQLParam.Clear now resets the SQL Type (if it was changed when setting the param)
4-
and re-initialises the underlying data structure.
4+
and zeroes the data if not nullable - otherwise parameter value is null.
55

66
2. TSQLParam.InternalSetString now clears the param before setting the value (also see above).
77

88
3. When IStatement.Prepare is executed the underlying data structures are freed and then
99
re-created thus ensuring that there are no "left overs" from a previous use.
1010

11+
4. Test Plan updated (Test 6) to include test for Blob text string optimisation i.e. shorter
12+
strings transferred as inline text rather than as separate blobs.
13+
14+
5. Blob string optimisation for SQL_TEXT now takes into account char set width.
15+
1116
FBINTF Change Log version (1.4-4 Build 1238) Mon, 20 Jan 2025 11:45:29 +0000
1217

1318
1. FB30Blob. Removed unnecessary Firebird.IAttachment.release from close and cancel methods

‎client/2.5/FB25Statement.pas‎

Lines changed: 13 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -151,7 +151,7 @@ TIBXSQLVAR = class(TSQLVarData)
151151
procedure SetSQLData(AValue: PByte; len: cardinal); override;
152152
procedure InternalSetScale(aValue: integer); override;
153153
procedure InternalSetDataLength(len: cardinal); override;
154-
procedure InternalSetSQLType(aValue: cardinal); override;
154+
procedure InternalSetSQLType(aValue: cardinal; aSubType: integer); override;
155155
procedure SetCharSetID(aValue: cardinal); override;
156156
public
157157
constructor Create(aParent: TIBXSQLDA; aIndex: integer);
@@ -165,7 +165,7 @@ TIBXSQLVAR = class(TSQLVarData)
165165
procedure Initialize; override;
166166

167167
property Statement: TFB25Statement read FStatement;
168-
property SQLType: cardinal read GetSQLType write SetSQLType;
168+
property SQLType: cardinal read GetSQLType;
169169
end;
170170

171171
TIBXINPUTSQLDA = class;
@@ -560,12 +560,14 @@ procedure TIBXSQLVAR.InternalSetDataLength(len: cardinal);
560560
Changed;
561561
end;
562562

563-
procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal);
563+
procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal; aSubType: integer);
564564
var tmpCharSetID: cardinal;
565565
begin
566566
tmpCharSetID := GetCharSetID;
567567
FXSQLVAR^.sqltype := aValue or (FXSQLVAR^.sqltype and 1);
568-
SetCharSetID(tmpCharSetID); {Needed when changing Blob to SQL_VARYING/SQL_TEXT}
568+
if aValue = SQL_BLOB then
569+
FXSQLVAR^.sqlsubtype := aSubType;
570+
SetCharSetID(tmpCharSetID); {Needed when changing Blob to SQL_VARYING/SQL_TEXT and vice versa}
569571
Changed;
570572
end;
571573

@@ -577,7 +579,13 @@ procedure TIBXSQLVAR.SetCharSetID(aValue: cardinal);
577579
SQL_VARYING, SQL_TEXT:
578580
FXSQLVAR^.sqlsubtype := (aValue and $FF) or (FXSQLVAR^.sqlsubtype and not $FF);
579581

580-
SQL_BLOB,
582+
SQL_BLOB:
583+
if (SQLSubType = 1) then
584+
{see http://firebirdsql.org/rlsnotesh/rlsnotes210.html}
585+
FXSQLVAR^.sqlscale := (aValue and $FF) or (FXSQLVAR^.sqlscale and not $FF)
586+
else
587+
IBError(ibxeInvalidDataConversion,[nil]);
588+
581589
SQL_ARRAY:
582590
IBError(ibxeInvalidDataConversion,[nil]);
583591
end;

‎client/3.0/FB30Statement.pas‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -127,7 +127,7 @@ TIBXSQLVAR = class(TSQLVarData)
127127
procedure SetIsNullable(Value: Boolean); override;
128128
procedure InternalSetScale(aValue: integer); override;
129129
procedure InternalSetDataLength(len: cardinal); override;
130-
procedure InternalSetSQLType(aValue: cardinal); override;
130+
procedure InternalSetSQLType(aValue: cardinal; aSubType: integer); override;
131131
procedure SetCharSetID(aValue: cardinal); override;
132132
procedure SetMetaSize(aValue: cardinal); override;
133133
public
@@ -713,9 +713,11 @@ procedure TIBXSQLVAR.InternalSetDataLength(len: cardinal);
713713
Changed;
714714
end;
715715

716-
procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal);
716+
procedure TIBXSQLVAR.InternalSetSQLType(aValue: cardinal; aSubType: integer);
717717
begin
718718
FSQLType := aValue;
719+
if aValue = SQL_BLOB then
720+
FSQLSubType := aSubType;
719721
Changed;
720722
end;
721723

‎client/FBSQLData.pas‎

Lines changed: 26 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -309,15 +309,15 @@ TSQLVarData = class
309309
function GetDataLength: cardinal; virtual; abstract; {current field length}
310310
function GetSize: cardinal; virtual; abstract; {field length as given by metadata}
311311
function GetDefaultTextSQLType: cardinal; virtual; abstract;
312-
procedure InternalSetSQLType(aValue: cardinal); virtual; abstract;
312+
procedure InternalSetSQLType(aValue: cardinal; aSubType: integer); virtual; abstract;
313313
procedure InternalSetScale(aValue: integer); virtual; abstract;
314314
procedure InternalSetDataLength(len: cardinal); virtual; abstract;
315315
procedure SetIsNull(Value: Boolean); virtual; abstract;
316316
procedure SetIsNullable(Value: Boolean); virtual; abstract;
317317
procedure SetSQLData(AValue: PByte; len: cardinal); virtual; abstract;
318318
procedure SetScale(aValue: integer);
319319
procedure SetDataLength(len: cardinal);
320-
procedure SetSQLType(aValue: cardinal);
320+
procedure SetSQLType(aValue: cardinal; aSubType: integer);
321321
procedure SetCharSetID(aValue: cardinal); virtual; abstract;
322322
procedure SetMetaSize(aValue: cardinal); virtual;
323323
public
@@ -346,7 +346,7 @@ TSQLVarData = class
346346
property Name: AnsiString read FName write SetName;
347347
property CharSetID: cardinal read GetCharSetID write SetCharSetID;
348348
property CodePage: TSystemCodePage read GetCodePage;
349-
property SQLType: cardinal read GetSQLType write SetSQLType;
349+
property SQLType: cardinal read GetSQLType;
350350
property SQLSubtype: integer read GetSubtype;
351351
property SQLData: PByte read GetSQLData;
352352
property DataLength: cardinal read GetDataLength write SetDataLength;
@@ -823,14 +823,14 @@ procedure TSQLVarData.SetDataLength(len: cardinal);
823823
InternalSetDataLength(len);
824824
end;
825825

826-
procedure TSQLVarData.SetSQLType(aValue: cardinal);
826+
procedure TSQLVarData.SetSQLType(aValue: cardinal; aSubType: integer);
827827
begin
828828
if aValue = SQLType then
829829
Exit;
830830
if not CanChangeMetaData then
831831
IBError(ibxeSQLTypeUnchangeable,[TSQLDataItem.GetSQLTypeName(SQLType),
832832
TSQLDataItem.GetSQLTypeName(aValue)]);
833-
InternalSetSQLType(aValue);
833+
InternalSetSQLType(aValue,aSubType);
834834
end;
835835

836836
procedure TSQLVarData.SetMetaSize(aValue: cardinal);
@@ -870,9 +870,14 @@ procedure TSQLVarData.SetString(aValue: AnsiString);
870870

871871
FVarString := aValue;
872872
if SQLType = SQL_BLOB then
873-
SetMetaSize(GetAttachment.GetInlineBlobLimit);
873+
begin
874+
if GetDefaultTextSQLType = SQL_TEXT then
875+
SetMetaSize(Length(aValue)*GetCharSetWidth)
876+
else
877+
SetMetaSize(Length(aValue))
878+
end;
874879
if CanChangeMetaData then
875-
SQLType := GetDefaultTextSQLType;
880+
SetSQLType(GetDefaultTextSQLType,0);
876881
Scale := 0;
877882
if (SQLType <> SQL_VARYING) and (SQLType <> SQL_TEXT) then
878883
IBError(ibxeUnableTosetaTextType,[Index,Name,TSQLDataItem.GetSQLTypeName(SQLType)]);
@@ -2482,6 +2487,10 @@ procedure DoSetString;
24822487
IBError(ibxeInvalidDataConversion,[nil]);
24832488

24842489
SQL_BLOB:
2490+
if (FIBXSQLVar.GetDefaultTextSQLType = SQL_TEXT) and
2491+
(Length(Value) * GetCharSetWidth < GetAttachment.GetInlineBlobLimit) then
2492+
DoSetString
2493+
else
24852494
if Length(Value) < GetAttachment.GetInlineBlobLimit then
24862495
DoSetString
24872496
else
@@ -2585,7 +2594,7 @@ procedure TSQLParam.SetDataLength(len: cardinal);
25852594
procedure TSQLParam.SetSQLType(aValue: cardinal);
25862595
begin
25872596
CheckActive;
2588-
FIBXSQLVAR.SQLType := aValue;
2597+
FIBXSQLVAR.SetSQLType(aValue,0);
25892598
end;
25902599

25912600
procedure TSQLParam.Clear;
@@ -2594,7 +2603,15 @@ procedure TSQLParam.Clear;
25942603
begin
25952604
{Restores the original SQL Type - if it was changed}
25962605
if CanChangeMetaData then
2597-
FIBXSQLVar.SetSQLType(getColMetadata.GetSQLType);
2606+
begin
2607+
FIBXSQLVar.SetSQLType(getColMetadata.GetSQLType,getColMetadata.getSubtype);
2608+
case SQLType of
2609+
SQL_BLOB,
2610+
SQL_ARRAY,
2611+
SQL_QUAD:
2612+
FIBXSQLVar.SetMetaSize(sizeof(TISC_QUAD));
2613+
end;
2614+
end;
25982615
if IsNullable then
25992616
IsNull := true
26002617
else

‎testsuite/Test6.pas‎

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -121,6 +121,7 @@ procedure TTest6.UpdateDatabase(Attachment: IAttachment);
121121
Statement,
122122
Statement2: IStatement;
123123
ResultSet: IResultSet;
124+
CharSetWidth: integer;
124125
begin
125126
Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
126127

@@ -173,6 +174,42 @@ procedure TTest6.UpdateDatabase(Attachment: IAttachment);
173174
Statement := Attachment.Prepare(Transaction,'Select * from TestData');
174175
ReportResults(Statement);
175176
end;
177+
178+
writeln(OutFile,'Test text blob optimisation - short text followed by long');
179+
Statement := Attachment.Prepare(Transaction,'Insert into TestData(RowID,BlobData) Values(?,?)');
180+
writeln(OutFile,'Params after prepare');
181+
ParamInfo(Statement.SQLParams);
182+
if not Attachment.CharSetWidth(Statement.SQLParams[1].GetCharSetID,CharSetWidth) then
183+
CharSetWidth := 4; {assume UTF8}
184+
Attachment.SetInlineBlobLimit(80*CharSetWidth); {reduce limit to 80 chars}
185+
Statement.SQLParams[0].AsInteger := 3;
186+
Statement.SQLParams[1].AsString := 'The Quick Brown Fox Jumps over the Lazy Dog';
187+
writeln(OutFile,'Params after setting values');
188+
ParamInfo(Statement.SQLParams);
189+
Statement.Execute;
190+
Statement.SQLParams[0].AsInteger := 4;
191+
Statement.SQLParams[1].AsString :=
192+
'O Romeo, Romeo, wherefore art thou Romeo? '+
193+
'Deny thy father and refuse thy name. '+
194+
'Or if thou wilt not, be but sworn my love '+
195+
'And I’ll no longer be a Capulet.'+
196+
'‘Tis but thy name that is my enemy: '+
197+
'Thou art thyself, though not a Montague. '+
198+
'What’s Montague? It is nor hand nor foot '+
199+
'Nor arm nor face nor any other part '+
200+
'Belonging to a man. O be some other name. '+
201+
'What’s in a name? That which we call a rose '+
202+
'By any other name would smell as sweet; '+
203+
'So Romeo would, were he not Romeo call’d, '+
204+
'Retain that dear perfection which he owes '+
205+
'Without that title. Romeo, doff thy name ,'+
206+
'And for that name, which is no part of thee, '+
207+
'Take all myself.';
208+
ParamInfo(Statement.SQLParams);
209+
Statement.Execute;
210+
writeln(OutFile,'Text Blob Optimisation Results');
211+
Statement := Attachment.Prepare(Transaction,'Select * from TestData Where RowID >= 3');
212+
ReportResults(Statement);
176213
end;
177214

178215
procedure TTest6.ExecProc(Attachment: IAttachment);

‎testsuite/testsuite.lpi‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,7 @@
2828
</PublishOptions>
2929
<RunParams>
3030
<local>
31-
<CommandLineParams Value="-t 21"/>
31+
<CommandLineParams Value="-t 19"/>
3232
</local>
3333
<environment>
3434
<UserOverrides Count="3">
@@ -41,7 +41,7 @@
4141
<Modes Count="1">
4242
<Mode0 Name="default">
4343
<local>
44-
<CommandLineParams Value="-t 21"/>
44+
<CommandLineParams Value="-t 19"/>
4545
</local>
4646
<environment>
4747
<UserOverrides Count="3">

0 commit comments

Comments
 (0)