ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/public/ibx/trunk/fbintf/testsuite/Test1.pas
Revision: 45
Committed: Tue Dec 6 10:33:46 2016 UTC (8 years ago) by tony
Content type: text/x-pascal
File size: 3444 byte(s)
Log Message:
Committing updates for Release R2-0-0

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 DBInfo: IDBInformation;
69 ConType: integer;
70 DBFileName: string;
71 DBSiteName: string;
72 begin
73 writeln(OutFile,'Creating a Database with empty parameters');
74 Attachment := FirebirdAPI.CreateDatabase('',nil,false);
75 if Attachment = nil then
76 writeln(OutFile,'Create Database fails (as expected): ',FirebirdAPI.GetStatus.GetMessage)
77 else
78 Attachment.DropDatabase;
79
80 writeln(OutFile,'Creating a Database with a DPD');
81 DPB := FirebirdAPI.AllocateDPB;
82 DPB.Add(isc_dpb_user_name).setAsString(Owner.GetUserName);
83 DPB.Add(isc_dpb_password).setAsString(Owner.GetPassword);
84 DPB.Add(isc_dpb_lc_ctype).setAsString(CharSet);
85 DPB.Add(isc_dpb_set_db_SQL_dialect).setAsByte(SQLDialect);
86
87 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
88
89 writeln(OutFile,'Dropping Database');
90 if Attachment <> nil then
91 Attachment.DropDatabase;
92
93 {Open Database}
94
95 PrintDPB(DPB);
96 writeln(OutFile,'Creating a Database with a DPD');
97 Attachment := FirebirdAPI.CreateDatabase(Owner.GetNewDatabaseName,DPB);
98 if Attachment = nil then
99 begin
100 writeln(OutFile,'Create Database Failed');
101 Exit;
102 end;
103 DBInfo := Attachment.GetDBInformation([isc_info_db_id]);
104 DBInfo[0].DecodeIDCluster(ConType,DBFileName,DBSiteName);
105 writeln(OutFile,'Database ID = ', ConType,' FB = ', DBFileName, ' SN = ',DBSiteName);
106 DBInfo := Attachment.GetDBInformation([isc_info_ods_version]);
107 write(OutFile,'ODS major = ',DBInfo[0].getAsInteger);
108 DBInfo := Attachment.GetDBInformation([isc_info_ods_minor_version]);
109 writeln(OutFile,' minor = ', DBInfo[0].getAsInteger );
110
111 {Querying Database}
112 DoQuery(Attachment);
113
114 writeln(OutFile,'Dropping Database');
115 Attachment.DropDatabase;
116 end;
117
118
119 initialization
120 RegisterTest(TTest1);
121
122 end.
123