ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test1.pas
Revision: 47
Committed: Mon Jan 9 15:31:51 2017 UTC (7 years, 11 months ago) by tony
Content type: text/x-pascal
File size: 3538 byte(s)
Log Message:
Committing updates for Release R2-0-1

File Contents

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