fbintf/testsuite/Test8.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 Test8;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

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

{Test 8: Create and read back an Array with 2 dimensions}

{
1. Create an empty database and populate with a single table including a two
   dimensional array of varchar(16) 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.
}

interface

uses
  Classes, SysUtils, TestApplication, FBTestApp, IB;

type

  { TTest8 }

  TTest8 = 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,'+
    'MyArray VarChar(16) [0:16, -1:7] Character Set ISO8859_2,'+
    'Primary Key(RowID)'+
    ')';

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

  sqlUpdate = 'Update TestData Set MyArray = ? Where RowID = 1';

{ TTest8 }

procedure TTest8.UpdateDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    i,j,k : integer;
    ar: IArray;
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
    ByName('rowid').AsInteger := 1;
    ByName('title').AsString := '2D Array';
  end;
  Statement.Execute;
  Statement := Attachment.Prepare(Transaction,'Select * from TestData');
  ReportResults(Statement);

  Statement := Attachment.Prepare(Transaction,sqlUpdate);
  ar := Attachment.CreateArray(Transaction,'TestData','MyArray');
  if ar <> nil then
  begin
    k := 50;
    for i := 0 to 16 do
      for j := -1 to 7 do
      begin
        ar.SetAsString([i,j],'A' + IntToStr(k));
        Inc(k);
      end;
    Statement.SQLParams[0].AsArray := ar;
    Statement.Execute;
  end;
  Statement := Attachment.Prepare(Transaction,'Select * from TestData');
  ReportResults(Statement);
end;

function TTest8.TestTitle: AnsiString;
begin
  Result := 'Test 8: Create and read back an Array with 2 dimensions';
end;

procedure TTest8.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(TTest8);

end.

Revision:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 1 month ago) by tony
Content type:	text/x-pascal
File size:	4183 byte(s)
Log Message:	Updated for IBX 4 release
#	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	tony	45	unit Test8;
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 8: Create and read back an Array with 2 dimensions}
40
41			{
42			1. Create an empty database and populate with a single table including a two
43			dimensional array of varchar(16) column.
44
45			2. Select all and show metadata including array metadata.
46
47			3. Insert a row but leave array null
48
49			4. Show result.
50
51			5. Update row with a populated array and show results.
52			}
53
54			interface
55
56			uses
57	tony	315	Classes, SysUtils, TestApplication, FBTestApp, IB;
58	tony	45
59			type
60
61			{ TTest8 }
62
63	tony	315	TTest8 = class(TFBTestBase)
64	tony	45	private
65			procedure UpdateDatabase(Attachment: IAttachment);
66			public
67	tony	56	function TestTitle: AnsiString; override;
68			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
69	tony	45	end;
70
71			implementation
72
73			const
74			sqlCreateTable =
75			'Create Table TestData ('+
76			'RowID Integer not null,'+
77			'Title VarChar(32) Character Set UTF8,'+
78			'MyArray VarChar(16) [0:16, -1:7] Character Set ISO8859_2,'+
79			'Primary Key(RowID)'+
80			')';
81
82			sqlInsert = 'Insert into TestData(RowID,Title) Values(:RowID,:Title)';
83
84			sqlUpdate = 'Update TestData Set MyArray = ? Where RowID = 1';
85
86			{ TTest8 }
87
88			procedure TTest8.UpdateDatabase(Attachment: IAttachment);
89			var Transaction: ITransaction;
90			Statement: IStatement;
91			i,j,k : integer;
92			ar: IArray;
93			begin
94			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
95			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
96			PrintMetaData(Statement.GetMetaData);
97			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
98			ParamInfo(Statement.GetSQLParams);
99			with Statement.GetSQLParams do
100			begin
101			ByName('rowid').AsInteger := 1;
102			ByName('title').AsString := '2D Array';
103			end;
104			Statement.Execute;
105			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
106			ReportResults(Statement);
107
108			Statement := Attachment.Prepare(Transaction,sqlUpdate);
109			ar := Attachment.CreateArray(Transaction,'TestData','MyArray');
110			if ar <> nil then
111			begin
112			k := 50;
113			for i := 0 to 16 do
114			for j := -1 to 7 do
115			begin
116			ar.SetAsString([i,j],'A' + IntToStr(k));
117			Inc(k);
118			end;
119			Statement.SQLParams[0].AsArray := ar;
120			Statement.Execute;
121			end;
122			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
123			ReportResults(Statement);
124			end;
125
126	tony	56	function TTest8.TestTitle: AnsiString;
127	tony	45	begin
128			Result := 'Test 8: Create and read back an Array with 2 dimensions';
129			end;
130
131	tony	56	procedure TTest8.RunTest(CharSet: AnsiString; SQLDialect: integer);
132	tony	45	var DPB: IDPB;
133			Attachment: IAttachment;
134			begin
135			DPB := FirebirdAPI.AllocateDPB;
136			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
137			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
138			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
139			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
140			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
141			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
142			UpdateDatabase(Attachment);
143
144			Attachment.DropDatabase;
145			end;
146
147			initialization
148			RegisterTest(TTest8);
149
150			end.
151