trunk/testsuite/Test23.pas

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:	315
Committed:	Thu Feb 25 11:56:36 2021 UTC (3 years, 9 months ago) by tony
Content type:	text/x-pascal
File size:	3868 byte(s)
Log Message:	Updated for IBX 4 release
#	User	Rev	Content
1	tony	315	unit Test23;
2
3			{$mode objfpc}{$H+}
4
5			{Test 23: Transliteration Tests
6
7			A test database is created with a row containing text data types and then
8			initialised to text is European Character sets i.e. not just ASCII.
9
10			The text is read back both as text and as hex characters with various
11			connection character sets.
12			}
13
14			interface
15
16			uses
17			Classes, SysUtils, TestApplication, IBXTestBase, IB, IBSQL;
18
19			const
20			aTestID = '23';
21			aTestTitle = 'Transliteration Tests';
22
23			type
24
25			{ TTest23 }
26
27			TTest23 = class(TIBXTestBase)
28			private
29			FIBSQL: TIBSQL;
30			procedure AddRow;
31			procedure ShowData;
32			protected
33			procedure CreateObjects(Application: TTestApplication); override;
34			function GetTestID: AnsiString; override;
35			function GetTestTitle: AnsiString; override;
36			procedure InitTest; override;
37			public
38			procedure RunTest(CharSet: AnsiString; SQLDialect: integer); override;
39			end;
40
41
42			implementation
43
44			{ TTest23 }
45
46			procedure TTest23.AddRow;
47			var b: IBlob;
48			begin
49			with FIBSQL do
50			begin
51			SQL.Text := 'Insert into TestData(RowID,Title,Notes, BlobData,InClear) Values(:RowID,:Title,:Notes,:BlobData,:InClear)';
52			Transaction.Active := true;
53			ParamByName('rowid').AsInteger := 1;
54			ParamByName('title').AsString := 'Blob Test ©€';
55			ParamByName('Notes').AsString := 'Écoute moi';
56			b := IBDatabase.Attachment.CreateBlob(Transaction.TransactionIntf,'TestData','BlobData');
57			b. AsString :='Some German Special Characters like ÖÄÜöäüß';
58			ParamByName('BlobData').AsBlob := b;
59			ParamByName('InClear').AsString := #$01'Test'#$0D#$C3;
60			ExecQuery;
61			end;
62			end;
63
64			procedure TTest23.ShowData;
65			begin
66			writeln(Outfile,'Default Character Set = ' + IBDatabase.DefaultCharSetName);
67			writeln(Outfile);
68			with FIBSQL do
69			begin
70			SQL.Text := 'Select A.ROWID, A.TITLE, A.NOTES, A.BLOBDATA, A.INCLEAR From TESTDATA A';
71			Transaction.Active := true;
72			ExecQuery;
73			ReportResult(Current);
74			end;
75			writeln(Outfile);
76			end;
77
78			procedure TTest23.CreateObjects(Application: TTestApplication);
79			begin
80			inherited CreateObjects(Application);
81			FIBSQL := TIBSQL.Create(Application);
82			FIBSQL.Database := IBDatabase;
83			end;
84
85			function TTest23.GetTestID: AnsiString;
86			begin
87			Result := aTestID;
88			end;
89
90			function TTest23.GetTestTitle: AnsiString;
91			begin
92			Result := aTestTitle;
93			end;
94
95			procedure TTest23.InitTest;
96			begin
97			IBDatabase.DatabaseName := Owner.GetNewDatabaseName;
98			IBDatabase.CreateIfNotExists := true;
99			ReadWriteTransaction;
100			end;
101
102			procedure TTest23.RunTest(CharSet: AnsiString; SQLDialect: integer);
103			var index: integer;
104			begin
105			IBDatabase.Connected := true;
106			try
107			AddRow;
108			ShowData;
109			IBDatabase.Connected := false;
110			index := IBDatabase.Params.IndexOfName('lc_ctype');
111			IBDatabase.Params[index] := 'lc_ctype=WIN1252';
112			IBDatabase.Connected := true;
113			ShowData;
114			IBDatabase.Connected := false;
115			index := IBDatabase.Params.IndexOfName('lc_ctype');
116			IBDatabase.Params[index] := 'lc_ctype=NONE';
117			IBDatabase.Connected := true;
118			ShowData;
119			IBDatabase.Connected := false;
120			index := IBDatabase.Params.IndexOfName('lc_ctype');
121			IBDatabase.Params[index] := 'lc_ctype=UTF8';
122			IBDatabase.Connected := true;
123			ShowData;
124			FHexStrings := true;
125			IBDatabase.Connected := false;
126			index := IBDatabase.Params.IndexOfName('lc_ctype');
127			IBDatabase.Params[index] := 'lc_ctype=WIN1252';
128			IBDatabase.Connected := true;
129			ShowData;
130			IBDatabase.Connected := false;
131			index := IBDatabase.Params.IndexOfName('lc_ctype');
132			IBDatabase.Params[index] := 'lc_ctype=NONE';
133			IBDatabase.Connected := true;
134			ShowData;
135			IBDatabase.Connected := false;
136			index := IBDatabase.Params.IndexOfName('lc_ctype');
137			IBDatabase.Params[index] := 'lc_ctype=UTF8';
138			IBDatabase.Connected := true;
139			ShowData;
140			finally
141			IBDatabase.DropDatabase;
142			end;
143			end;
144
145			initialization
146			RegisterTest(TTest23);
147
148			end.
149