fbintf/testsuite/Test1.pas

unit Test1;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{Create and Drop a Database}
{
 This test first attempts to create a database without specifying any parameters
 (should fail). It then goes on to create and drop a database, print out the
 parameters and then creates it again (will fail if the dropdatabase failed silently.

 Some basic database info is then accessed and printed.

 A basic query is performed and finally the database dropped.
}

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

interface

uses
  Classes, SysUtils, TestManager, IB;

type

  { TTest1 }

  TTest1 = class(TTestBase)
  private
    procedure DoQuery(Attachment: IAttachment);
  public
    function TestTitle: AnsiString; override;
    procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
  end;

implementation

{ TTest1 }

procedure TTest1.DoQuery(Attachment: IAttachment);
var Transaction: ITransaction;
    Statement: IStatement;
    ResultSet: IResultSet;
    i: integer;
begin
    Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
    Statement := Attachment.Prepare(Transaction,'Select * from RDB$Database',3);
    ResultSet := Statement.OpenCursor;
    ResultSet.SetRetainInterfaces(true);
    try
      while ResultSet.FetchNext do
      begin
        for i := 0 to ResultSet.getCount - 1 do
          writeln(OutFile,ResultSet[i].Name,' = ',ResultSet[i].AsString);
      end;
    finally
      ResultSet.Close;
      ResultSet.SetRetainInterfaces(false);
    end;
end;

function TTest1.TestTitle: AnsiString;
begin
  Result := 'Test 1: Create and Drop a Database';
end;

procedure TTest1.RunTest(CharSet: AnsiString; SQLDialect: integer);
var DPB: IDPB;
    Attachment: IAttachment;
    createSQL: AnsiString;
begin
  writeln(OutFile,'Creating a Database with empty parameters');
  Attachment := FirebirdAPI.CreateDatabase('',nil,false);
  if Attachment = nil then
    writeln(OutFile,'Create Database fails (as expected): ',FirebirdAPI.GetStatus.GetMessage)
  else
    Attachment.DropDatabase;

  writeln(OutFile,'Creating a Database using an SQL Statement');
  createSQL := Format('CREATE DATABASE ''%s'' USER ''%s'' PASSWORD ''%s'' DEFAULT CHARACTER SET %s',
                      [Owner.GetNewDatabaseName, Owner.GetUserName, Owner.GetPassword, CharSet]);
  Attachment := FirebirdAPI.CreateDatabase(createSQL,SQLDialect);
  WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_db_SQL_Dialect]));

  writeln(OutFile,'Dropping Database');
  if Attachment <> nil then
    Attachment.DropDatabase;

  writeln(OutFile,'Creating a Database with a DPD');
  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);

  writeln(OutFile,'Dropping Database');
  if Attachment <> nil then
    Attachment.DropDatabase;

  {Open Database}

  PrintDPB(DPB);
  writeln(OutFile,'Creating a Database with a DPD');
  Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
  if Attachment = nil then
  begin
    writeln(OutFile,'Create Database Failed');
    Exit;
  end;
  WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));

  {Querying Database}
  DoQuery(Attachment);

  writeln(OutFile,'Dropping Database');
  Attachment.DropDatabase;
end;


initialization
  RegisterTest(TTest1);

end.

Revision:	56
Committed:	Mon Mar 6 10:20:02 2017 UTC (7 years, 1 month ago) by tony
Content type:	text/x-pascal
Original Path:	*ibx/trunk/fbintf/testsuite/Test1.pas*
File size:	3623 byte(s)
Log Message:	Committing updates for Trunk
#	User	Rev	Content
1	tony	45	unit Test1;
2	tony	56	{$IFDEF MSWINDOWS}
3			{$DEFINE WINDOWS}
4			{$ENDIF}
5	tony	45
6			{Create and Drop a Database}
7			{
8			This test first attempts to create a database without specifying any parameters
9			(should fail). It then goes on to create and drop a database, print out the
10			parameters and then creates it again (will fail if the dropdatabase failed silently.
11
12			Some basic database info is then accessed and printed.
13
14			A basic query is performed and finally the database dropped.
15			}
16
17	tony	56	{$IFDEF FPC}
18			{$mode delphi}
19	tony	45	{$codepage utf8}
20	tony	56	{$ENDIF}
21	tony	45
22			interface
23
24			uses
25			Classes, SysUtils, TestManager, IB;
26
27			type
28
29			{ TTest1 }
30
31			TTest1 = class(TTestBase)
32			private
33			procedure DoQuery(Attachment: IAttachment);
34			public
35	tony	56	function TestTitle: AnsiString; override;
36			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
37	tony	45	end;
38
39			implementation
40
41			{ TTest1 }
42
43			procedure TTest1.DoQuery(Attachment: IAttachment);
44			var Transaction: ITransaction;
45			Statement: IStatement;
46			ResultSet: IResultSet;
47			i: integer;
48			begin
49			Transaction := Attachment.StartTransaction([isc_tpb_read,isc_tpb_nowait,isc_tpb_concurrency],taCommit);
50			Statement := Attachment.Prepare(Transaction,'Select * from RDB$Database',3);
51			ResultSet := Statement.OpenCursor;
52			ResultSet.SetRetainInterfaces(true);
53			try
54			while ResultSet.FetchNext do
55			begin
56			for i := 0 to ResultSet.getCount - 1 do
57			writeln(OutFile,ResultSet[i].Name,' = ',ResultSet[i].AsString);
58			end;
59			finally
60			ResultSet.Close;
61			ResultSet.SetRetainInterfaces(false);
62			end;
63			end;
64
65	tony	56	function TTest1.TestTitle: AnsiString;
66	tony	45	begin
67			Result := 'Test 1: Create and Drop a Database';
68			end;
69
70	tony	56	procedure TTest1.RunTest(CharSet: AnsiString; SQLDialect: integer);
71	tony	45	var DPB: IDPB;
72			Attachment: IAttachment;
73	tony	56	createSQL: AnsiString;
74	tony	45	begin
75			writeln(OutFile,'Creating a Database with empty parameters');
76			Attachment := FirebirdAPI.CreateDatabase('',nil,false);
77			if Attachment = nil then
78			writeln(OutFile,'Create Database fails (as expected): ',FirebirdAPI.GetStatus.GetMessage)
79			else
80			Attachment.DropDatabase;
81
82	tony	47	writeln(OutFile,'Creating a Database using an SQL Statement');
83			createSQL := Format('CREATE DATABASE ''%s'' USER ''%s'' PASSWORD ''%s'' DEFAULT CHARACTER SET %s',
84			[Owner.GetNewDatabaseName, Owner.GetUserName, Owner.GetPassword, CharSet]);
85			Attachment := FirebirdAPI.CreateDatabase(createSQL,SQLDialect);
86			WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_db_SQL_Dialect]));
87
88			writeln(OutFile,'Dropping Database');
89			if Attachment <> nil then
90			Attachment.DropDatabase;
91
92	tony	45	writeln(OutFile,'Creating a Database with a DPD');
93			DPB := FirebirdAPI.AllocateDPB;
94			DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
95			DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
96			DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
97			DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
98
99			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
100
101			writeln(OutFile,'Dropping Database');
102			if Attachment <> nil then
103			Attachment.DropDatabase;
104
105			{Open Database}
106
107			PrintDPB(DPB);
108			writeln(OutFile,'Creating a Database with a DPD');
109			Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
110			if Attachment = nil then
111			begin
112			writeln(OutFile,'Create Database Failed');
113			Exit;
114			end;
115	tony	47	WriteDBInfo(Attachment.GetDBInformation([isc_info_db_id,isc_info_ods_version,isc_info_ods_minor_version]));
116	tony	45
117			{Querying Database}
118			DoQuery(Attachment);
119
120			writeln(OutFile,'Dropping Database');
121			Attachment.DropDatabase;
122			end;
123
124
125			initialization
126			RegisterTest(TTest1);
127
128			end.
129