udr/testsuite/Test03.pas

(*  Firebird UDR Support (fbudrtestbed). The fbudr components provide a set of
*  Pascal language bindings for the Firebird API in support of server
*  side User Defined Routines (UDRs). The fbudr package is an extension
*  to the Firebird Pascal API.
*
*  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 Test03;

{$IFDEF MSWINDOWS}
{$DEFINE WINDOWS}
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$codepage utf8}
{$ENDIF}

interface

uses
  Classes, SysUtils, TestApplication, FBUDRTestApp, IB, FBUdrPlugin;

type

  { TTest03 }

  {Test 03 is used to perform client side testing (UDR engine emulation) for the
   UDR Select procedures declared in udr_test03.pas.}

  TTest03 = class(TFBUDRTestBase)
  private
    procedure DoAccSalaries(Attachment: IAttachment);
    procedure DoReadText(Attachment: IAttachment);
  protected
    function GetTestID: AnsiString; override;
    function GetTestTitle: AnsiString; override;
  public
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;

implementation

{ TTest03 }

procedure TTest03.DoAccSalaries(Attachment: IAttachment);
var MyTestProc: TExternalProcedureWrapper;
    Transaction: ITransaction;
    Results: IProcedureResults;
begin
  UDRPlugin.Attachment := Attachment;
  MyTestProc := UDRPlugin.makeProcedure('MYSELECTPROC','','fbudrtests!select_proc');
  try
    writeln(OutFile,'List Employees, salaries and accumulated salary');
    Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
    Results := MyTestProc.Execute(Transaction);
    while Results.FetchNext do
    begin
      write(OutFile,Results[0].AsString);
      write(OutFile,', Salary = ',Results[1].AsString);
      writeln(Outfile,' Acc Salary = $',Results[2].AsString);
    end;
    writeln(OutFile);
  finally
    MyTestProc.Free;
  end;
end;

procedure TTest03.DoReadText(Attachment: IAttachment);
var MyReadText: TExternalProcedureWrapper;
    Transaction: ITransaction;
    Results: IProcedureResults;
begin
  UDRPlugin.Attachment := Attachment;
  MyReadText := UDRPlugin.makeProcedure('MYREADTEXT','','fbudrtests!read_txt');
  try
    MyReadText.InputParams[0].AsString := 'testsuite.conf';
    writeln(OutFile,'Dump text file - testsuite.conf');
    Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
    Results := MyReadText.Execute(Transaction);
    while Results.FetchNext do
    begin
      writeln(OutFile,Results[0].AsString);
    end;
    writeln(OutFile,'EOF');
    writeln(OutFile);
  finally
    MyReadText.Free;
  end;
end;

function TTest03.GetTestID: AnsiString;
begin
  Result := '03';
end;

function TTest03.GetTestTitle: AnsiString;
begin
  Result := 'UDR Select Procedure Test';
end;

const
  DDL: array [0..1] of Ansistring = ('create or alter procedure MySelectProc () '+
                                     'returns (FullName VarChar(36), '+
                                     'Salary Numeric(10,2), AccSalary Numeric(10,2) ) as begin SUSPEND;  end',
                                     'create or alter procedure MyReadText ('+
                                     'path varchar(200) not null /*relative to udr directory */ '+
                                     ') returns (text varchar(3000) not null) '+
                                     'As Begin Suspend; End'
                                     );

  CleanUpDDL: array [0..1] of Ansistring = ('Drop procedure MySelectProc',
                                            'Drop procedure MyReadText');


{The test is run using the employee database. Note that dummy versions of the
 UDR Select Procedure must be declared in the database in order to generate the input
 and output parameter metadata. These are always (re-)defined when the test is
 started and removed at the end.
 }

procedure TTest03.RunTest(CharSet: AnsiString; SQLDialect: integer);
var Attachment: IAttachment;
    DPB: IDPB;
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.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
  try
    ApplyDDL(Attachment,DDL);
    DoAccSalaries(Attachment);
    DoReadText(Attachment);
  finally
    ApplyDDL(Attachment,CleanUpDDL);
    Attachment.Disconnect;
  end;
end;

initialization
  RegisterTest(TTest03);
end.

Revision:	381
Committed:	Sat Jan 15 00:06:22 2022 UTC (2 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	5244 byte(s)
Log Message:	Release Candidate 1
#	User	Rev	Content
1	tony	371	(* Firebird UDR Support (fbudrtestbed). The fbudr components provide a set of
2			* Pascal language bindings for the Firebird API in support of server
3			* side User Defined Routines (UDRs). The fbudr package is an extension
4			* to the Firebird Pascal API.
5			*
6			* The contents of this file are subject to the Initial Developer's
7			* Public License Version 1.0 (the "License"); you may not use this
8			* file except in compliance with the License. You may obtain a copy
9			* of the License here:
10			*
11			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
12			*
13			* Software distributed under the License is distributed on an "AS
14			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
15			* implied. See the License for the specific language governing rights
16			* and limitations under the License.
17			*
18			* The Initial Developer of the Original Code is Tony Whyman.
19			*
20			* The Original Code is (C) 2021 Tony Whyman, MWA Software
21			* (http://www.mwasoftware.co.uk).
22			*
23			* All Rights Reserved.
24			*
25			* Contributor(s): ______________________________________.
26			*
27			*)
28			unit Test03;
29
30			{$IFDEF MSWINDOWS}
31			{$DEFINE WINDOWS}
32			{$ENDIF}
33
34			{$IFDEF FPC}
35			{$mode delphi}
36			{$codepage utf8}
37			{$ENDIF}
38
39			interface
40
41			uses
42			Classes, SysUtils, TestApplication, FBUDRTestApp, IB, FBUdrPlugin;
43
44			type
45
46			{ TTest03 }
47
48			{Test 03 is used to perform client side testing (UDR engine emulation) for the
49	tony	373	UDR Select procedures declared in udr_test03.pas.}
50	tony	371
51			TTest03 = class(TFBUDRTestBase)
52			private
53	tony	373	procedure DoAccSalaries(Attachment: IAttachment);
54			procedure DoReadText(Attachment: IAttachment);
55	tony	371	protected
56			function GetTestID: AnsiString; override;
57			function GetTestTitle: AnsiString; override;
58			public
59			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
60			end;
61
62			implementation
63
64			{ TTest03 }
65
66	tony	373	procedure TTest03.DoAccSalaries(Attachment: IAttachment);
67	tony	371	var MyTestProc: TExternalProcedureWrapper;
68			Transaction: ITransaction;
69			Results: IProcedureResults;
70			begin
71			UDRPlugin.Attachment := Attachment;
72	tony	381	MyTestProc := UDRPlugin.makeProcedure('MYSELECTPROC','','fbudrtests!select_proc');
73	tony	371	try
74			writeln(OutFile,'List Employees, salaries and accumulated salary');
75			Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
76			Results := MyTestProc.Execute(Transaction);
77			while Results.FetchNext do
78			begin
79			write(OutFile,Results[0].AsString);
80			write(OutFile,', Salary = ',Results[1].AsString);
81			writeln(Outfile,' Acc Salary = $',Results[2].AsString);
82			end;
83			writeln(OutFile);
84			finally
85			MyTestProc.Free;
86			end;
87			end;
88
89	tony	373	procedure TTest03.DoReadText(Attachment: IAttachment);
90			var MyReadText: TExternalProcedureWrapper;
91			Transaction: ITransaction;
92			Results: IProcedureResults;
93			begin
94			UDRPlugin.Attachment := Attachment;
95	tony	381	MyReadText := UDRPlugin.makeProcedure('MYREADTEXT','','fbudrtests!read_txt');
96	tony	373	try
97			MyReadText.InputParams[0].AsString := 'testsuite.conf';
98			writeln(OutFile,'Dump text file - testsuite.conf');
99			Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
100			Results := MyReadText.Execute(Transaction);
101			while Results.FetchNext do
102			begin
103			writeln(OutFile,Results[0].AsString);
104			end;
105			writeln(OutFile,'EOF');
106			writeln(OutFile);
107			finally
108			MyReadText.Free;
109			end;
110			end;
111
112	tony	371	function TTest03.GetTestID: AnsiString;
113			begin
114			Result := '03';
115			end;
116
117			function TTest03.GetTestTitle: AnsiString;
118			begin
119			Result := 'UDR Select Procedure Test';
120			end;
121
122			const
123	tony	373	DDL: array [0..1] of Ansistring = ('create or alter procedure MySelectProc () '+
124	tony	371	'returns (FullName VarChar(36), '+
125	tony	373	'Salary Numeric(10,2), AccSalary Numeric(10,2) ) as begin SUSPEND; end',
126			'create or alter procedure MyReadText ('+
127			'path varchar(200) not null /relative to udr directory / '+
128			') returns (text varchar(3000) not null) '+
129			'As Begin Suspend; End'
130	tony	371	);
131
132	tony	373	CleanUpDDL: array [0..1] of Ansistring = ('Drop procedure MySelectProc',
133			'Drop procedure MyReadText');
134	tony	371
135
136			{The test is run using the employee database. Note that dummy versions of the
137			UDR Select Procedure must be declared in the database in order to generate the input
138			and output parameter metadata. These are always (re-)defined when the test is
139			started and removed at the end.
140			}
141
142			procedure TTest03.RunTest(CharSet: AnsiString; SQLDialect: integer);
143			var Attachment: IAttachment;
144			DPB: IDPB;
145			begin
146			DPB := FirebirdAPI.AllocateDPB;
147			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
148			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
149			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
150			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
151			Attachment := FirebirdAPI.OpenDatabase(Owner.GetEmployeeDatabaseName,DPB);
152			try
153			ApplyDDL(Attachment,DDL);
154	tony	373	DoAccSalaries(Attachment);
155			DoReadText(Attachment);
156	tony	371	finally
157			ApplyDDL(Attachment,CleanUpDDL);
158			Attachment.Disconnect;
159			end;
160			end;
161
162			initialization
163			RegisterTest(TTest03);
164			end.
165