fbintf/testsuite/Test7.pas

(*
 *  Firebird Interface (fbintf) Test suite. This program is used to
 *  test the Firebird Pascal Interface and provide a semi-automated
 *  pass/fail check for each test.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)

unit Test7;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$codepage utf8}
{$ENDIF}

{Test 7: Create and read back an Array}

{
  1. Create an empty database and populate with a single table including an array of integer column.

  2. Select all and show metadata including array metadata.

  3. Insert a row but leave array null

  4. Show result.

  5. Update row with a populated array and show results.

  7. Reopen cursor but before fetching array, shrink bounds

  8. Fetch and print array with reduced bounds.

}

interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type

  { TTest7 }

  TTest7 = class(TFBTestBase)
  private
    procedure UpdateDatabase(Attachment: IAttachment);
  public
    function TestTitle: AnsiString; override;
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;

implementation

const
  sqlCreateTable =
    'Create Table TestData ('+
    'RowID Integer not null,'+
    'Title VarChar(32) Character Set UTF8,'+
    'Dated TIMESTAMP, '+
    'Notes VarChar(64) Character Set ISO8859_1,'+
    'MyArray Integer [0:16],'+
    'MyArray2 Timestamp [0:16],'+
    'MyArray3 Numeric(10,2) [0:16],'+
    'Primary Key(RowID)'+
    ')';

  sqlInsert = 'Insert into TestData(RowID,Title,Dated,Notes) Values(:RowID,:Title,:Dated,:Notes)';

  sqlUpdate = 'Update TestData Set MyArray = :MyArray Where RowID = 1';
  sqlUpdate2 = 'Update TestData Set MyArray2 = :MyArray2 Where RowID = 1';
  sqlUpdate3 = 'Update TestData Set MyArray3 = :MyArray3 Where RowID = 1';

{ TTest7 }

procedure TTest7.UpdateDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    ResultSet: IResultSet;
    i,j: integer;
    ar: IArray;
    aDateTime: TDateTime;
    f: double;
begin
  Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
  Statement := Attachment.Prepare(Transaction,'Select * from TestData');
  PrintMetaData(Statement.GetMetaData);
  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
  ParamInfo(Statement.GetSQLParams);
  with Statement.GetSQLParams do
  begin
    for i := 0 to GetCount - 1 do
      writeln(OutFile,'Param Name = ',Params[i].getName);
    ByName('rowid').AsInteger := 1;
    {$IFDEF DCC}
    ByName('title').AsString := UTF8Encode('Blob Test ©€');
    {$ELSE}
    ByName('title').AsString := 'Blob Test ©€';
    {$ENDIF}
    ByName('Notes').AsString := 'Écoute moi';
    ByName('Dated').AsDateTime := EncodeDate(2016,4,1) + EncodeTime(9,30,0,100);
  end;
  Statement.Execute;
  Statement := Attachment.Prepare(Transaction,'Select * from TestData');
  ReportResults(Statement);

  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate);
  ParamInfo(Statement.GetSQLParams);
  Transaction.CommitRetaining;
  ar := Attachment.CreateArray(Transaction,'TestData','MyArray');
  j := 100;
  for i := 0 to 16 do
  begin
    ar.SetAsInteger([i],j);
    dec(j);
  end;
  Statement.SQLParams[0].AsArray := ar;
  Statement.Execute;

  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate2);
  ParamInfo(Statement.GetSQLParams);
  ar := Attachment.CreateArray(Transaction,'TestData','MyArray2');
  for i := 0 to 16 do
  begin
    aDateTime := EncodeDate(2020,5,1) + EncodeTime(12,i,0,0);
    ar.SetAsDateTime(i,aDateTime);
  end;
  Statement.SQLParams[0].AsArray := ar;
  Statement.Execute;

  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate3);
  ParamInfo(Statement.GetSQLParams);
  ar := Attachment.CreateArray(Transaction,'TestData','MyArray3');
  f := 0;
  for i := 0 to 13 do
  begin
    ar.SetAsFloat(i,f);
    f := f + 1.05
  end;
  ar.SetAsString([14],'0.424567');
  ar.SetAsString([15],'42.4567');
  ar.SetAsString([16],'4269');
  Statement.SQLParams[0].AsArray := ar;
  Statement.Execute;

  Statement := Attachment.Prepare(Transaction,'Select * from TestData');
  PrintMetaData(Statement.GetMetaData);
  ReportResults(Statement);

  ResultSet := Statement.OpenCursor;
  if Resultset.FetchNext then
  begin
    ar := ResultSet.ByName('MyArray').AsArray;
    ar.SetBounds(0,10,2);
    writeln(OutFile,'Shrink to 2:10');
    WriteArray(ar);
  end
  else
    writeln(OutFile,'Unable to reopen cursor');

  {Now update the reduced slice}
  writeln(OutFile,'Write updated reduced slice');
  ar.SetAsInteger([2],1000);
  Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate);
  Statement.SQLParams[0].AsArray := ar;
  Statement.Execute;
  writeln(OutFile,'Show update array');
  Statement := Attachment.Prepare(Transaction,'Select * from TestData');
  ReportResults(Statement);

  Transaction.Commit;
end;

function TTest7.TestTitle: AnsiString;
begin
  Result := 'Test 7: Create and read back an Array';
end;

procedure TTest7.RunTest(CharSet: AnsiString; SQLDialect: integer);
var DPB: IDPB;
    Attachment: IAttachment;
begin
  DPB := FirebirdAPI.AllocateDPB;
  DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
  DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
  DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
  DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
  Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
  Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
  UpdateDatabase(Attachment);

  Attachment.DropDatabase;
end;

initialization
  RegisterTest(TTest7);

end.

Revision:	380
Committed:	Mon Jan 10 10:13:17 2022 UTC (2 years, 11 months ago) by tony
Content type:	text/x-pascal
File size:	6464 byte(s)
Log Message:	propset for eol-style
#	User	Rev	Content
1	tony	315	(*
2			* Firebird Interface (fbintf) Test suite. This program is used to
3			* test the Firebird Pascal Interface and provide a semi-automated
4			* pass/fail check for each test.
5			*
6			* The contents of this file are subject to the Initial Developer's
7			* Public License Version 1.0 (the "License"); you may not use this
8			* file except in compliance with the License. You may obtain a copy
9			* of the License here:
10			*
11			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
12			*
13			* Software distributed under the License is distributed on an "AS
14			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
15			* implied. See the License for the specific language governing rights
16			* and limitations under the License.
17			*
18			* The Initial Developer of the Original Code is Tony Whyman.
19			*
20			* The Original Code is (C) 2016 Tony Whyman, MWA Software
21			* (http://www.mwasoftware.co.uk).
22			*
23			* All Rights Reserved.
24			*
25			* Contributor(s): ______________________________________.
26			*
27			*)
28
29			unit Test7;
30	tony	56	{$IFDEF MSWINDOWS}
31			{$DEFINE WINDOWS}
32			{$ENDIF}
33	tony	45
34	tony	56	{$IFDEF FPC}
35			{$mode delphi}
36	tony	45	{$codepage utf8}
37	tony	56	{$ENDIF}
38	tony	45
39			{Test 7: Create and read back an Array}
40
41			{
42			1. Create an empty database and populate with a single table including an array of integer column.
43
44			2. Select all and show metadata including array metadata.
45
46			3. Insert a row but leave array null
47
48			4. Show result.
49
50			5. Update row with a populated array and show results.
51
52			7. Reopen cursor but before fetching array, shrink bounds
53
54			8. Fetch and print array with reduced bounds.
55
56			}
57
58			interface
59
60			uses
61	tony	315	Classes, SysUtils, TestApplication, FBTestApp, IB;
62	tony	45
63			type
64
65			{ TTest7 }
66
67	tony	315	TTest7 = class(TFBTestBase)
68	tony	45	private
69			procedure UpdateDatabase(Attachment: IAttachment);
70			public
71	tony	56	function TestTitle: AnsiString; override;
72			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
73	tony	45	end;
74
75			implementation
76
77			const
78			sqlCreateTable =
79			'Create Table TestData ('+
80			'RowID Integer not null,'+
81			'Title VarChar(32) Character Set UTF8,'+
82			'Dated TIMESTAMP, '+
83			'Notes VarChar(64) Character Set ISO8859_1,'+
84			'MyArray Integer [0:16],'+
85	tony	315	'MyArray2 Timestamp [0:16],'+
86			'MyArray3 Numeric(10,2) [0:16],'+
87	tony	45	'Primary Key(RowID)'+
88			')';
89
90			sqlInsert = 'Insert into TestData(RowID,Title,Dated,Notes) Values(:RowID,:Title,:Dated,:Notes)';
91
92			sqlUpdate = 'Update TestData Set MyArray = :MyArray Where RowID = 1';
93	tony	315	sqlUpdate2 = 'Update TestData Set MyArray2 = :MyArray2 Where RowID = 1';
94			sqlUpdate3 = 'Update TestData Set MyArray3 = :MyArray3 Where RowID = 1';
95	tony	45
96			{ TTest7 }
97
98			procedure TTest7.UpdateDatabase(Attachment: IAttachment);
99			var Transaction: ITransaction;
100			Statement: IStatement;
101			ResultSet: IResultSet;
102			i,j: integer;
103			ar: IArray;
104	tony	315	aDateTime: TDateTime;
105			f: double;
106	tony	45	begin
107			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
108			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
109			PrintMetaData(Statement.GetMetaData);
110			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
111			ParamInfo(Statement.GetSQLParams);
112			with Statement.GetSQLParams do
113			begin
114			for i := 0 to GetCount - 1 do
115			writeln(OutFile,'Param Name = ',Params[i].getName);
116			ByName('rowid').AsInteger := 1;
117	tony	56	{$IFDEF DCC}
118			ByName('title').AsString := UTF8Encode('Blob Test ©€');
119			{$ELSE}
120	tony	45	ByName('title').AsString := 'Blob Test ©€';
121	tony	315	{$ENDIF}
122	tony	45	ByName('Notes').AsString := 'Écoute moi';
123			ByName('Dated').AsDateTime := EncodeDate(2016,4,1) + EncodeTime(9,30,0,100);
124			end;
125			Statement.Execute;
126			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
127			ReportResults(Statement);
128
129			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate);
130			ParamInfo(Statement.GetSQLParams);
131			Transaction.CommitRetaining;
132			ar := Attachment.CreateArray(Transaction,'TestData','MyArray');
133			j := 100;
134			for i := 0 to 16 do
135			begin
136			ar.SetAsInteger([i],j);
137			dec(j);
138			end;
139			Statement.SQLParams[0].AsArray := ar;
140			Statement.Execute;
141	tony	315
142			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate2);
143			ParamInfo(Statement.GetSQLParams);
144			ar := Attachment.CreateArray(Transaction,'TestData','MyArray2');
145			for i := 0 to 16 do
146			begin
147			aDateTime := EncodeDate(2020,5,1) + EncodeTime(12,i,0,0);
148			ar.SetAsDateTime(i,aDateTime);
149			end;
150			Statement.SQLParams[0].AsArray := ar;
151			Statement.Execute;
152
153			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate3);
154			ParamInfo(Statement.GetSQLParams);
155			ar := Attachment.CreateArray(Transaction,'TestData','MyArray3');
156			f := 0;
157	tony	353	for i := 0 to 13 do
158	tony	315	begin
159			ar.SetAsFloat(i,f);
160			f := f + 1.05
161			end;
162	tony	353	ar.SetAsString([14],'0.424567');
163			ar.SetAsString([15],'42.4567');
164			ar.SetAsString([16],'4269');
165	tony	315	Statement.SQLParams[0].AsArray := ar;
166			Statement.Execute;
167
168	tony	45	Statement := Attachment.Prepare(Transaction,'Select * from TestData');
169	tony	315	PrintMetaData(Statement.GetMetaData);
170	tony	45	ReportResults(Statement);
171
172			ResultSet := Statement.OpenCursor;
173			if Resultset.FetchNext then
174			begin
175			ar := ResultSet.ByName('MyArray').AsArray;
176			ar.SetBounds(0,10,2);
177			writeln(OutFile,'Shrink to 2:10');
178			WriteArray(ar);
179			end
180			else
181			writeln(OutFile,'Unable to reopen cursor');
182
183			{Now update the reduced slice}
184			writeln(OutFile,'Write updated reduced slice');
185			ar.SetAsInteger([2],1000);
186			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate);
187			Statement.SQLParams[0].AsArray := ar;
188			Statement.Execute;
189			writeln(OutFile,'Show update array');
190			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
191			ReportResults(Statement);
192
193			Transaction.Commit;
194			end;
195
196	tony	56	function TTest7.TestTitle: AnsiString;
197	tony	45	begin
198			Result := 'Test 7: Create and read back an Array';
199			end;
200
201	tony	56	procedure TTest7.RunTest(CharSet: AnsiString; SQLDialect: integer);
202	tony	45	var DPB: IDPB;
203			Attachment: IAttachment;
204			begin
205			DPB := FirebirdAPI.AllocateDPB;
206			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
207			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
208			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
209			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
210			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
211			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
212			UpdateDatabase(Attachment);
213
214			Attachment.DropDatabase;
215			end;
216
217			initialization
218			RegisterTest(TTest7);
219
220			end.
221