fbintf/testsuite/Test7.pas

unit Test7;

{$mode objfpc}{$H+}
{$codepage utf8}

{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, TestManager, IB;

type

  { TTest7 }

  TTest7 = class(TTestBase)
  private
    procedure UpdateDatabase(Attachment: IAttachment);
  public
    function TestTitle: string; override;
    procedure RunTest(CharSet: string; 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],'+
    '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';

{ TTest7 }

procedure TTest7.UpdateDatabase(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    ResultSet: IResultSet;
    i,j: 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
    for i := 0 to GetCount - 1 do
      writeln(OutFile,'Param Name = ',Params[i].getName);
    ByName('rowid').AsInteger := 1;
    ByName('title').AsString := 'Blob Test ©€';
    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.Prepare(Transaction,'Select * from TestData');
  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: string;
begin
  Result := 'Test 7: Create and read back an Array';
end;

procedure TTest7.RunTest(CharSet: string; 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:	45
Committed:	Tue Dec 6 10:33:46 2016 UTC (7 years, 4 months ago) by tony
Content type:	text/x-pascal
File size:	4164 byte(s)
Log Message:	Committing updates for Release R2-0-0
#	User	Rev	Content
1	tony	45	unit Test7;
2
3			{$mode objfpc}{$H+}
4			{$codepage utf8}
5
6			{Test 7: Create and read back an Array}
7
8			{
9			1. Create an empty database and populate with a single table including an array of integer column.
10
11			2. Select all and show metadata including array metadata.
12
13			3. Insert a row but leave array null
14
15			4. Show result.
16
17			5. Update row with a populated array and show results.
18
19			7. Reopen cursor but before fetching array, shrink bounds
20
21			8. Fetch and print array with reduced bounds.
22
23			}
24
25			interface
26
27			uses
28			Classes, SysUtils, TestManager, IB;
29
30			type
31
32			{ TTest7 }
33
34			TTest7 = class(TTestBase)
35			private
36			procedure UpdateDatabase(Attachment: IAttachment);
37			public
38			function TestTitle: string; override;
39			procedure RunTest(CharSet: string; SQLDialect: integer); override;
40			end;
41
42			implementation
43
44			const
45			sqlCreateTable =
46			'Create Table TestData ('+
47			'RowID Integer not null,'+
48			'Title VarChar(32) Character Set UTF8,'+
49			'Dated TIMESTAMP, '+
50			'Notes VarChar(64) Character Set ISO8859_1,'+
51			'MyArray Integer [0:16],'+
52			'Primary Key(RowID)'+
53			')';
54
55			sqlInsert = 'Insert into TestData(RowID,Title,Dated,Notes) Values(:RowID,:Title,:Dated,:Notes)';
56
57			sqlUpdate = 'Update TestData Set MyArray = :MyArray Where RowID = 1';
58
59			{ TTest7 }
60
61			procedure TTest7.UpdateDatabase(Attachment: IAttachment);
62			var Transaction: ITransaction;
63			Statement: IStatement;
64			ResultSet: IResultSet;
65			i,j: integer;
66			ar: IArray;
67			begin
68			Transaction := Attachment.StartTransaction([isc_tpb_write,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
69			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
70			PrintMetaData(Statement.GetMetaData);
71			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlInsert);
72			ParamInfo(Statement.GetSQLParams);
73			with Statement.GetSQLParams do
74			begin
75			for i := 0 to GetCount - 1 do
76			writeln(OutFile,'Param Name = ',Params[i].getName);
77			ByName('rowid').AsInteger := 1;
78			ByName('title').AsString := 'Blob Test ©€';
79			ByName('Notes').AsString := 'Écoute moi';
80			ByName('Dated').AsDateTime := EncodeDate(2016,4,1) + EncodeTime(9,30,0,100);
81			end;
82			Statement.Execute;
83			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
84			ReportResults(Statement);
85
86			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate);
87			ParamInfo(Statement.GetSQLParams);
88			Transaction.CommitRetaining;
89			ar := Attachment.CreateArray(Transaction,'TestData','MyArray');
90			j := 100;
91			for i := 0 to 16 do
92			begin
93			ar.SetAsInteger([i],j);
94			dec(j);
95			end;
96			Statement.SQLParams[0].AsArray := ar;
97			Statement.Execute;
98			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
99			ReportResults(Statement);
100
101			ResultSet := Statement.OpenCursor;
102			if Resultset.FetchNext then
103			begin
104			ar := ResultSet.ByName('MyArray').AsArray;
105			ar.SetBounds(0,10,2);
106			writeln(OutFile,'Shrink to 2:10');
107			WriteArray(ar);
108			end
109			else
110			writeln(OutFile,'Unable to reopen cursor');
111
112			{Now update the reduced slice}
113			writeln(OutFile,'Write updated reduced slice');
114			ar.SetAsInteger([2],1000);
115			Statement := Attachment.PrepareWithNamedParameters(Transaction,sqlUpdate);
116			Statement.SQLParams[0].AsArray := ar;
117			Statement.Execute;
118			writeln(OutFile,'Show update array');
119			Statement := Attachment.Prepare(Transaction,'Select * from TestData');
120			ReportResults(Statement);
121
122			Transaction.Commit;
123			end;
124
125			function TTest7.TestTitle: string;
126			begin
127			Result := 'Test 7: Create and read back an Array';
128			end;
129
130			procedure TTest7.RunTest(CharSet: string; SQLDialect: integer);
131			var DPB: IDPB;
132			Attachment: IAttachment;
133			begin
134			DPB := FirebirdAPI.AllocateDPB;
135			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
136			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
137			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
138			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
139			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
140			Attachment.ExecImmediate([isc_tpb_write,isc_tpb_wait,isc_tpb_consistency],sqlCreateTable);
141			UpdateDatabase(Attachment);
142
143			Attachment.DropDatabase;
144			end;
145
146			initialization
147			RegisterTest(TTest7);
148
149			end.
150