trunk/testsuite/Test23.pas

(*
 *  IBX Test suite. This program is used to test the IBX non-visual
 *  components and provides a semi-automated pass/fail check for each test.
 *
 *  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 Test23;

{$mode objfpc}{$H+}

{Test 23: Transliteration Tests

 A test database is created with a row containing text data types and then
 initialised to text is European Character sets i.e. not just ASCII.

 The text is read back both as text and as hex characters with various
 connection character sets.
}

interface

uses
  Classes, SysUtils,   TestApplication, IBXTestBase, IB, IBSQL;

const
  aTestID    = '23';
  aTestTitle = 'Transliteration Tests';

type

{ TTest23 }

  TTest23 = class(TIBXTestBase)
  private
    FIBSQL: TIBSQL;
    procedure AddRow;
    procedure ShowData;
  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

{ TTest23 }

procedure TTest23.AddRow;
var b: IBlob;
begin
  with FIBSQL do
  begin
    SQL.Text := 'Insert into TestData(RowID,Title,Notes, BlobData,InClear) Values(:RowID,:Title,:Notes,:BlobData,:InClear)';
    Transaction.Active := true;
    ParamByName('rowid').AsInteger := 1;
    ParamByName('title').AsString := 'Blob Test ©€';
    ParamByName('Notes').AsString := 'Écoute moi';
    b := IBDatabase.Attachment.CreateBlob(Transaction.TransactionIntf,'TestData','BlobData');
    b. AsString :='Some German Special Characters like ÖÄÜöäüß';
    ParamByName('BlobData').AsBlob := b;
    ParamByName('InClear').AsString := #$01'Test'#$0D#$C3;
    ExecQuery;
  end;
end;

procedure TTest23.ShowData;
begin
  writeln(Outfile,'Default Character Set = ' + IBDatabase.DefaultCharSetName);
  writeln(Outfile);
  with FIBSQL do
  begin
    SQL.Text := 'Select A.ROWID, A.TITLE, A.NOTES, A.BLOBDATA, A.INCLEAR From TESTDATA A';
    Transaction.Active := true;
    ExecQuery;
    ReportResult(Current);
  end;
  writeln(Outfile);
end;

procedure TTest23.CreateObjects(Application: TTestApplication);
begin
  inherited CreateObjects(Application);
  FIBSQL := TIBSQL.Create(Application);
  FIBSQL.Database := IBDatabase;
end;

function TTest23.GetTestID: AnsiString;
begin
  Result := aTestID;
end;

function TTest23.GetTestTitle: AnsiString;
begin
  Result := aTestTitle;
end;

procedure TTest23.InitTest;
begin
  IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
  IBDatabase.CreateIfNotExists := true;
  ReadWriteTransaction;
end;

procedure TTest23.RunTest(CharSet: AnsiString; SQLDialect: integer);
var index: integer;
begin
  IBDatabase.Connected := true;
  try
    AddRow;
    ShowData;
    IBDatabase.Connected := false;
    index := IBDatabase.Params.IndexOfName('lc_ctype');
    IBDatabase.Params[index] := 'lc_ctype=WIN1252';
    IBDatabase.Connected := true;
    ShowData;
    IBDatabase.Connected := false;
    index := IBDatabase.Params.IndexOfName('lc_ctype');
    IBDatabase.Params[index] := 'lc_ctype=NONE';
    IBDatabase.Connected := true;
    ShowData;
    IBDatabase.Connected := false;
    index := IBDatabase.Params.IndexOfName('lc_ctype');
    IBDatabase.Params[index] := 'lc_ctype=UTF8';
    IBDatabase.Connected := true;
    ShowData;
    FHexStrings := true;
    IBDatabase.Connected := false;
    index := IBDatabase.Params.IndexOfName('lc_ctype');
    IBDatabase.Params[index] := 'lc_ctype=WIN1252';
    IBDatabase.Connected := true;
    ShowData;
    IBDatabase.Connected := false;
    index := IBDatabase.Params.IndexOfName('lc_ctype');
    IBDatabase.Params[index] := 'lc_ctype=NONE';
    IBDatabase.Connected := true;
    ShowData;
    IBDatabase.Connected := false;
    index := IBDatabase.Params.IndexOfName('lc_ctype');
    IBDatabase.Params[index] := 'lc_ctype=UTF8';
    IBDatabase.Connected := true;
    ShowData;
  finally
    IBDatabase.DropDatabase;
  end;
end;

initialization
  RegisterTest(TTest23);

end.

Revision:	323
Committed:	Thu Feb 25 12:14:35 2021 UTC (3 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	4825 byte(s)
Log Message:	Fixed Merged
#	User	Rev	Content
1	tony	323	(*
2			* IBX Test suite. This program is used to test the IBX non-visual
3			* components and provides a semi-automated pass/fail check for each test.
4			*
5			* The contents of this file are subject to the Initial Developer's
6			* Public License Version 1.0 (the "License"); you may not use this
7			* file except in compliance with the License. You may obtain a copy
8			* of the License here:
9			*
10			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11			*
12			* Software distributed under the License is distributed on an "AS
13			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14			* implied. See the License for the specific language governing rights
15			* and limitations under the License.
16			*
17			* The Initial Developer of the Original Code is Tony Whyman.
18			*
19			* The Original Code is (C) 2021 Tony Whyman, MWA Software
20			* (http://www.mwasoftware.co.uk).
21			*
22			* All Rights Reserved.
23			*
24			* Contributor(s): ______________________________________.
25			*
26			*)
27	tony	315	unit Test23;
28
29			{$mode objfpc}{$H+}
30
31			{Test 23: Transliteration Tests
32
33			A test database is created with a row containing text data types and then
34			initialised to text is European Character sets i.e. not just ASCII.
35
36			The text is read back both as text and as hex characters with various
37			connection character sets.
38			}
39
40			interface
41
42			uses
43			Classes, SysUtils, TestApplication, IBXTestBase, IB, IBSQL;
44
45			const
46			aTestID = '23';
47			aTestTitle = 'Transliteration Tests';
48
49			type
50
51			{ TTest23 }
52
53			TTest23 = class(TIBXTestBase)
54			private
55			FIBSQL: TIBSQL;
56			procedure AddRow;
57			procedure ShowData;
58			protected
59			procedure CreateObjects(Application: TTestApplication); override;
60			function GetTestID: AnsiString; override;
61			function GetTestTitle: AnsiString; override;
62			procedure InitTest; override;
63			public
64			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
65			end;
66
67
68			implementation
69
70			{ TTest23 }
71
72			procedure TTest23.AddRow;
73			var b: IBlob;
74			begin
75			with FIBSQL do
76			begin
77			SQL.Text := 'Insert into TestData(RowID,Title,Notes, BlobData,InClear) Values(:RowID,:Title,:Notes,:BlobData,:InClear)';
78			Transaction.Active := true;
79			ParamByName('rowid').AsInteger := 1;
80			ParamByName('title').AsString := 'Blob Test ©€';
81			ParamByName('Notes').AsString := 'Écoute moi';
82			b := IBDatabase.Attachment.CreateBlob(Transaction.TransactionIntf,'TestData','BlobData');
83			b. AsString :='Some German Special Characters like ÖÄÜöäüß';
84			ParamByName('BlobData').AsBlob := b;
85			ParamByName('InClear').AsString := #$01'Test'#$0D#$C3;
86			ExecQuery;
87			end;
88			end;
89
90			procedure TTest23.ShowData;
91			begin
92			writeln(Outfile,'Default Character Set = ' + IBDatabase.DefaultCharSetName);
93			writeln(Outfile);
94			with FIBSQL do
95			begin
96			SQL.Text := 'Select A.ROWID, A.TITLE, A.NOTES, A.BLOBDATA, A.INCLEAR From TESTDATA A';
97			Transaction.Active := true;
98			ExecQuery;
99			ReportResult(Current);
100			end;
101			writeln(Outfile);
102			end;
103
104			procedure TTest23.CreateObjects(Application: TTestApplication);
105			begin
106			inherited CreateObjects(Application);
107			FIBSQL := TIBSQL.Create(Application);
108			FIBSQL.Database := IBDatabase;
109			end;
110
111			function TTest23.GetTestID: AnsiString;
112			begin
113			Result := aTestID;
114			end;
115
116			function TTest23.GetTestTitle: AnsiString;
117			begin
118			Result := aTestTitle;
119			end;
120
121			procedure TTest23.InitTest;
122			begin
123			IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
124			IBDatabase.CreateIfNotExists := true;
125			ReadWriteTransaction;
126			end;
127
128			procedure TTest23.RunTest(CharSet: AnsiString; SQLDialect: integer);
129			var index: integer;
130			begin
131			IBDatabase.Connected := true;
132			try
133			AddRow;
134			ShowData;
135			IBDatabase.Connected := false;
136			index := IBDatabase.Params.IndexOfName('lc_ctype');
137			IBDatabase.Params[index] := 'lc_ctype=WIN1252';
138			IBDatabase.Connected := true;
139			ShowData;
140			IBDatabase.Connected := false;
141			index := IBDatabase.Params.IndexOfName('lc_ctype');
142			IBDatabase.Params[index] := 'lc_ctype=NONE';
143			IBDatabase.Connected := true;
144			ShowData;
145			IBDatabase.Connected := false;
146			index := IBDatabase.Params.IndexOfName('lc_ctype');
147			IBDatabase.Params[index] := 'lc_ctype=UTF8';
148			IBDatabase.Connected := true;
149			ShowData;
150			FHexStrings := true;
151			IBDatabase.Connected := false;
152			index := IBDatabase.Params.IndexOfName('lc_ctype');
153			IBDatabase.Params[index] := 'lc_ctype=WIN1252';
154			IBDatabase.Connected := true;
155			ShowData;
156			IBDatabase.Connected := false;
157			index := IBDatabase.Params.IndexOfName('lc_ctype');
158			IBDatabase.Params[index] := 'lc_ctype=NONE';
159			IBDatabase.Connected := true;
160			ShowData;
161			IBDatabase.Connected := false;
162			index := IBDatabase.Params.IndexOfName('lc_ctype');
163			IBDatabase.Params[index] := 'lc_ctype=UTF8';
164			IBDatabase.Connected := true;
165			ShowData;
166			finally
167			IBDatabase.DropDatabase;
168			end;
169			end;
170
171			initialization
172			RegisterTest(TTest23);
173
174			end.
175