fbintf/testsuite/Test7.pas

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

type

  { TTest7 }

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