trunk/testsuite/Test25.pas

(*
 *  IBX Test suite. This program is used to test the IBX non-visual
 *  components and provides 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) 2021 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)      
unit Test25;

{$mode objfpc}{$H+}

{Test 25: TIBTable Tests}

{ Append, Update, Delete tests on TIBTable
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, DB, IB, IBTable,
  IBCustomDataSet, IBExtract, IBXScript;

const
  aTestID    = '25';
  aTestTitle = 'TIBTable Tests';

type

{ TTest25 }

  TTest25 = class(TIBXTestBase)
  private
    FIBTable: TIBTable;
    FIBExtract: TIBExtract;
  protected
    procedure CreateObjects(Application: TTestApplication); override;
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
    procedure InitTest; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;


implementation

{ TTest25 }

procedure TTest25.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FIBTable := TIBTable.Create(Application);
  with FIBTable do
  begin
    Database := IBDatabase;
    Transaction := IBTransaction;
    TableName := 'TestTable';
    with FieldDefs do
    begin
      Add('MYKEY',ftInteger,4);
      Add('TEXTFIELD',ftString,32);
    end;
    IndexDefs.Add('PrimaryIndex','MYKEY',[ixPrimary]);
  end;
  FIBExtract := TIBExtract.Create(Application);
  FIBExtract.Database := IBDatabase;
  FIBExtract.Transaction := IBTransaction;
  FIBExtract.CaseSensitiveObjectNames := true;
end;

function TTest25.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest25.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest25.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
  IBDatabase.CreateIfNotExists := true;
  ReadWriteTransaction;
end;

procedure TTest25.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  IBDatabase.Connected := true;
  IBTransaction.Active := true;
  try
    FIBTable.CreateTable;
    IBTransaction.Commit;
    IBTransaction.Active := true;
    writeln(Outfile,'IBTable after create');
    FIBExtract.ExtractObject(eoTable,'TestTable');
    writeln(Outfile,FIBExtract.Items.Text);
    FIBTable.Active := true;
    PrintDataset(FIBTable);
    writeln(Outfile,'Add 2 rows');
    FIBTable.AppendRecord([1,'Test 1']);
    FIBTable.AppendRecord([2,'Test 2']);
    PrintDataset(FIBTable);
    writeln(Outfile,'Update first row');
    with FIBTable do
    begin
      if Locate('MYKEY',1,[]) then
      begin
        Edit;
        FieldByName('TextField').Asstring := 'Updated Test 1';
        Post;
      end;
    end;
    PrintDataset(FIBTable);
    writeln(Outfile,'Delete first row');
    with FIBTable do
      if Locate('MYKEY',1,[]) then
        Delete;
    PrintDataset(FIBTable);
    writeln(Outfile,'Empty the Table');
    FIBTable.EmptyTable;
    PrintDataset(FIBTable);
    writeln(Outfile,'Now drop the table');
    FIBTable.Active := false;
    FIBTable.DeleteTable;
    IBTransaction.Commit;
    IBTransaction.Active := true;
    writeln(Outfile,'Extract table after drop - should be empty');
    FIBExtract.ExtractObject(eoTable,'TestTable');
    writeln(Outfile,FIBExtract.Items.Text);
  finally
    IBXScriptObj.ExecSQLScript('Drop Database');
  end;
end;

initialization
  RegisterTest(TTest25);

end.

Revision:	323
Committed:	Thu Feb 25 12:14:35 2021 UTC (3 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	4141 byte(s)
Log Message:	Fixed Merged
#	User	Rev	Content
1	tony	323	(*
2			* IBX Test suite. This program is used to test the IBX non-visual
3			* components and provides a semi-automated pass/fail check for each test.
4			*
5			* The contents of this file are subject to the Initial Developer's
6			* Public License Version 1.0 (the "License"); you may not use this
7			* file except in compliance with the License. You may obtain a copy
8			* of the License here:
9			*
10			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11			*
12			* Software distributed under the License is distributed on an "AS
13			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14			* implied. See the License for the specific language governing rights
15			* and limitations under the License.
16			*
17			* The Initial Developer of the Original Code is Tony Whyman.
18			*
19			* The Original Code is (C) 2021 Tony Whyman, MWA Software
20			* (http://www.mwasoftware.co.uk).
21			*
22			* All Rights Reserved.
23			*
24			* Contributor(s): ______________________________________.
25			*
26			*)
27	tony	315	unit Test25;
28
29			{$mode objfpc}{$H+}
30
31			{Test 25: TIBTable Tests}
32
33			{ Append, Update, Delete tests on TIBTable
34			}
35
36			interface
37
38			uses
39			Classes, SysUtils, TestApplication, IBXTestBase, DB, IB, IBTable,
40			IBCustomDataSet, IBExtract, IBXScript;
41
42			const
43			aTestID = '25';
44			aTestTitle = 'TIBTable Tests';
45
46			type
47
48			{ TTest25 }
49
50			TTest25 = class(TIBXTestBase)
51			private
52			FIBTable: TIBTable;
53			FIBExtract: TIBExtract;
54			protected
55			procedure CreateObjects(Application: TTestApplication); override;
56			function GetTestID: AnsiString; override;
57			function GetTestTitle: AnsiString; override;
58			procedure InitTest; override;
59			public
60			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
61			end;
62
63
64			implementation
65
66			{ TTest25 }
67
68			procedure TTest25.CreateObjects(Application: TTestApplication);
69			begin
70			inherited CreateObjects(Application);
71			FIBTable := TIBTable.Create(Application);
72			with FIBTable do
73			begin
74			Database := IBDatabase;
75			Transaction := IBTransaction;
76			TableName := 'TestTable';
77			with FieldDefs do
78			begin
79			Add('MYKEY',ftInteger,4);
80			Add('TEXTFIELD',ftString,32);
81			end;
82			IndexDefs.Add('PrimaryIndex','MYKEY',[ixPrimary]);
83			end;
84			FIBExtract := TIBExtract.Create(Application);
85			FIBExtract.Database := IBDatabase;
86			FIBExtract.Transaction := IBTransaction;
87			FIBExtract.CaseSensitiveObjectNames := true;
88			end;
89
90			function TTest25.GetTestID: AnsiString;
91			begin
92			Result := aTestID;
93			end;
94
95			function TTest25.GetTestTitle: AnsiString;
96			begin
97			Result := aTestTitle;
98			end;
99
100			procedure TTest25.InitTest;
101			begin
102			IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
103			IBDatabase.CreateIfNotExists := true;
104			ReadWriteTransaction;
105			end;
106
107			procedure TTest25.RunTest(CharSet: AnsiString; SQLDialect: integer);
108			begin
109			IBDatabase.Connected := true;
110			IBTransaction.Active := true;
111			try
112			FIBTable.CreateTable;
113			IBTransaction.Commit;
114			IBTransaction.Active := true;
115			writeln(Outfile,'IBTable after create');
116			FIBExtract.ExtractObject(eoTable,'TestTable');
117			writeln(Outfile,FIBExtract.Items.Text);
118			FIBTable.Active := true;
119			PrintDataset(FIBTable);
120			writeln(Outfile,'Add 2 rows');
121			FIBTable.AppendRecord([1,'Test 1']);
122			FIBTable.AppendRecord([2,'Test 2']);
123			PrintDataset(FIBTable);
124			writeln(Outfile,'Update first row');
125			with FIBTable do
126			begin
127			if Locate('MYKEY',1,[]) then
128			begin
129			Edit;
130			FieldByName('TextField').Asstring := 'Updated Test 1';
131			Post;
132			end;
133			end;
134			PrintDataset(FIBTable);
135			writeln(Outfile,'Delete first row');
136			with FIBTable do
137			if Locate('MYKEY',1,[]) then
138			Delete;
139			PrintDataset(FIBTable);
140			writeln(Outfile,'Empty the Table');
141			FIBTable.EmptyTable;
142			PrintDataset(FIBTable);
143			writeln(Outfile,'Now drop the table');
144			FIBTable.Active := false;
145			FIBTable.DeleteTable;
146			IBTransaction.Commit;
147			IBTransaction.Active := true;
148			writeln(Outfile,'Extract table after drop - should be empty');
149			FIBExtract.ExtractObject(eoTable,'TestTable');
150			writeln(Outfile,FIBExtract.Items.Text);
151			finally
152			IBXScriptObj.ExecSQLScript('Drop Database');
153			end;
154			end;
155
156			initialization
157			RegisterTest(TTest25);
158
159			end.
160