trunk/testsuite/Test26.pas

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