trunk/testsuite/Test26.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 Test26;

{$mode objfpc}{$H+}

{Test 26: IBXScript data out and exceptional conditions}

{ Dumps data in CSV, Insert and Table formats + error conditions
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, IB,
  IBXScript, IBDataOutput;

const
  aTestID    = '26';
  aTestTitle = 'IBXScript data out and exceptional conditions';

type

{ TTest26 }

  TTest26 = class(TIBXTestBase)
  private
    FDataOutputCSVFormater: TIBCSVDataOut;
    FDataOutputSQLFormater: TIBInsertStmtsOut;
    FDataOutputBlockFormater: TIBBlockFormatOut;
    procedure HandleOutputLog(Sender: TObject; Msg: string);
    procedure HandleErrorLog(Sender: TObject; Msg: string);
  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

const
  sQuery = 'Select * From PROJECT;';
  sTestSET = 'Set Blah;' + LINEENDING + 'Select First 2 * from JOB;';

{ TTest26 }

procedure TTest26.HandleOutputLog(Sender: TObject; Msg: string);
begin
  writeln(Outfile,Msg);
end;

procedure TTest26.HandleErrorLog(Sender: TObject; Msg: string);
begin
  writeln(Outfile,'Script Error: ',Msg);
end;

procedure TTest26.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
//  IBXScriptObj.Echo := false;
  IBXScriptObj.OnOutputLog := @HandleOutputLog;
  IBXScriptObj.OnErrorLog := @HandleErrorLog;
  FDataOutputCSVFormater := TIBCSVDataOut.Create(Application);
  FDataOutputSQLFormater := TIBInsertStmtsOut.Create(Application);
  FDataOutputBlockFormater := TIBBlockFormatOut.Create(Application);
end;

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

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

procedure TTest26.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
  ReadOnlyTransaction;
end;

procedure TTest26.RunTest(CharSet: AnsiString; SQLDialect: integer);
begin
  IBDatabase.Connected := true;
  try
    IBTransaction.Active := true;
    IBXScriptObj.DataOutputFormatter := FDataOutputCSVFormater;
    writeln(Outfile,'Dump project table to CSV');
    IBXScriptObj.ExecSQLScript(sQuery);
    IBXScriptObj.DataOutputFormatter := FDataOutputSQLFormater;
    writeln(Outfile,'Dump project table to Insert Statements');
    IBXScriptObj.ExecSQLScript(sQuery);
    IBXScriptObj.DataOutputFormatter := FDataOutputBlockFormater;
    writeln(Outfile,'Dump project table to Data Block Format');
    IBXScriptObj.ExecSQLScript(sQuery);
    writeln(Outfile,'Unknown SET statement - stop on first error');
    IBXScriptObj.StopOnFirstError := true;
    IBXScriptObj.ExecSQLScript(sTestSET);
    writeln(Outfile,'Unknown SET statement - continue after error');
    IBXScriptObj.StopOnFirstError := false;
    IBXScriptObj.ExecSQLScript(sTestSET);
  finally
    IBDatabase.Connected := false;
  end;
end;

initialization
  RegisterTest(TTest26);

end.

Revision:	323
Committed:	Thu Feb 25 12:14:35 2021 UTC (3 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	4065 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 Test26;
28
29			{$mode objfpc}{$H+}
30
31			{Test 26: IBXScript data out and exceptional conditions}
32
33			{ Dumps data in CSV, Insert and Table formats + error conditions
34			}
35
36			interface
37
38			uses
39			Classes, SysUtils, TestApplication, IBXTestBase, IB,
40			IBXScript, IBDataOutput;
41
42			const
43			aTestID = '26';
44			aTestTitle = 'IBXScript data out and exceptional conditions';
45
46			type
47
48			{ TTest26 }
49
50			TTest26 = class(TIBXTestBase)
51			private
52			FDataOutputCSVFormater: TIBCSVDataOut;
53			FDataOutputSQLFormater: TIBInsertStmtsOut;
54			FDataOutputBlockFormater: TIBBlockFormatOut;
55			procedure HandleOutputLog(Sender: TObject; Msg: string);
56			procedure HandleErrorLog(Sender: TObject; Msg: string);
57			protected
58			procedure CreateObjects(Application: TTestApplication); override;
59			function GetTestID: AnsiString; override;
60			function GetTestTitle: AnsiString; override;
61			procedure InitTest; override;
62			public
63			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
64			end;
65
66
67			implementation
68
69			const
70			sQuery = 'Select * From PROJECT;';
71			sTestSET = 'Set Blah;' + LINEENDING + 'Select First 2 * from JOB;';
72
73			{ TTest26 }
74
75			procedure TTest26.HandleOutputLog(Sender: TObject; Msg: string);
76			begin
77			writeln(Outfile,Msg);
78			end;
79
80			procedure TTest26.HandleErrorLog(Sender: TObject; Msg: string);
81			begin
82			writeln(Outfile,'Script Error: ',Msg);
83			end;
84
85			procedure TTest26.CreateObjects(Application: TTestApplication);
86			begin
87			inherited CreateObjects(Application);
88			// IBXScriptObj.Echo := false;
89			IBXScriptObj.OnOutputLog := @HandleOutputLog;
90			IBXScriptObj.OnErrorLog := @HandleErrorLog;
91			FDataOutputCSVFormater := TIBCSVDataOut.Create(Application);
92			FDataOutputSQLFormater := TIBInsertStmtsOut.Create(Application);
93			FDataOutputBlockFormater := TIBBlockFormatOut.Create(Application);
94			end;
95
96			function TTest26.GetTestID: AnsiString;
97			begin
98			Result := aTestID;
99			end;
100
101			function TTest26.GetTestTitle: AnsiString;
102			begin
103			Result := aTestTitle;
104			end;
105
106			procedure TTest26.InitTest;
107			begin
108			IBDatabase.DatabaseName := Owner.GetEmployeeDatabaseName;
109			ReadOnlyTransaction;
110			end;
111
112			procedure TTest26.RunTest(CharSet: AnsiString; SQLDialect: integer);
113			begin
114			IBDatabase.Connected := true;
115			try
116			IBTransaction.Active := true;
117			IBXScriptObj.DataOutputFormatter := FDataOutputCSVFormater;
118			writeln(Outfile,'Dump project table to CSV');
119			IBXScriptObj.ExecSQLScript(sQuery);
120			IBXScriptObj.DataOutputFormatter := FDataOutputSQLFormater;
121			writeln(Outfile,'Dump project table to Insert Statements');
122			IBXScriptObj.ExecSQLScript(sQuery);
123			IBXScriptObj.DataOutputFormatter := FDataOutputBlockFormater;
124			writeln(Outfile,'Dump project table to Data Block Format');
125			IBXScriptObj.ExecSQLScript(sQuery);
126			writeln(Outfile,'Unknown SET statement - stop on first error');
127			IBXScriptObj.StopOnFirstError := true;
128			IBXScriptObj.ExecSQLScript(sTestSET);
129			writeln(Outfile,'Unknown SET statement - continue after error');
130			IBXScriptObj.StopOnFirstError := false;
131			IBXScriptObj.ExecSQLScript(sTestSET);
132			finally
133			IBDatabase.Connected := false;
134			end;
135			end;
136
137			initialization
138			RegisterTest(TTest26);
139
140			end.
141