paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 21:09:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

rtl: fpwidestring:

Browse Source 
- retry to load currentMap if it is not assigned
  - add more tests for fpwidestring manager

git-svn-id: trunk@25317 -
This commit is contained in:
paul 2013-08-21 06:56:26 +00:00
parent 2cb8125bfc
commit 4c23d2281a
5 changed files with 91 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitattributes vendored
View File

@ -11987,9 +11987,12 @@ tests/test/units/fpwidestring/CollationTest_SHIFTED_SHORT.txt svneol=native#text
tests/test/units/fpwidestring/tcpstr13fpwidestring.pp svneol=native#text/pascal
tests/test/units/fpwidestring/tcpstr17fpwidestring.pp svneol=native#text/pascal
tests/test/units/fpwidestring/tcpstr18fpwidestring.pp svneol=native#text/pascal
tests/test/units/fpwidestring/tcpstr1fpwidestring.pp svneol=native#text/pascal
tests/test/units/fpwidestring/tcpstr9fpwidestring.pp svneol=native#text/pascal
tests/test/units/fpwidestring/tcpstransistr2shortstringfpwidestring.pp svneol=native#text/pascal
tests/test/units/fpwidestring/tcpstransistr2widechararrayfpwidestring.pp svneol=native#text/pascal
tests/test/units/fpwidestring/tcpstransistrcompareequalfpws.pp svneol=native#text/pascal
tests/test/units/fpwidestring/tcpstransistrcomparefpwidestring.pp svneol=native#text/pascal
tests/test/units/fpwidestring/tcpstrpchar2ansistrfpws.pp svneol=native#text/pascal
tests/test/units/fpwidestring/tcpstrshortstr2ansistrfpws.pp svneol=native#text/pascal
tests/test/units/fpwidestring/tuca1.pp svneol=native#text/pascal

10
rtl/objpas/fpwidestring.pp
View File

@ -248,7 +248,7 @@ begin
if (cp=DefaultSystemCodePage) then
begin
{ update current_Map in case the DefaultSystemCodePage has been changed }
if current_DefaultSystemCodePage<>DefaultSystemCodePage then
if (current_DefaultSystemCodePage<>DefaultSystemCodePage) or not Assigned(current_Map) then
begin
FiniThread;
InitThread;
@ -321,7 +321,7 @@ begin
if (cp=DefaultSystemCodePage) then
begin
{ update current_Map in case the DefaultSystemCodePage has been changed }
if current_DefaultSystemCodePage<>DefaultSystemCodePage then
if (current_DefaultSystemCodePage<>DefaultSystemCodePage) or not Assigned(current_Map) then
begin
FiniThread;
InitThread;
@ -356,7 +356,7 @@ begin
if (cp=DefaultSystemCodePage) then
begin
{ update current_Map in case the DefaultSystemCodePage has been changed }
if current_DefaultSystemCodePage<>DefaultSystemCodePage then
if (current_DefaultSystemCodePage<>DefaultSystemCodePage) or not Assigned(current_Map) then
begin
FiniThread;
InitThread;
@ -500,7 +500,7 @@ begin
exit;
end;
if current_DefaultSystemCodePage<>DefaultSystemCodePage then
if (current_DefaultSystemCodePage<>DefaultSystemCodePage) or not Assigned(current_Map) then
begin
FiniThread;
InitThread;
@ -571,7 +571,7 @@ begin
UnicodeToUtf8(@Result[1],slen,@us[1],ulen);
exit;
end;
if current_DefaultSystemCodePage<>DefaultSystemCodePage then
if (current_DefaultSystemCodePage<>DefaultSystemCodePage) or not Assigned(current_Map) then
begin
FiniThread;
InitThread;

34
tests/test/units/fpwidestring/tcpstr1fpwidestring.pp Normal file
View File

@ -0,0 +1,34 @@
uses
unicodeducet, fpwidestring, cp1251, cp1253;
type
tcpstr1 = type AnsiString(1253);
tcpstr2 = type AnsiString(1251);
var
a1 : tcpstr1;
a2 : utf8string;
a3 : tcpstr2;
u1 : unicodestring;
begin
a1:=' ';
a1[1]:=char($80); // Euro symbol in cp1253
a2:=a1;
if ord(a2[1])<>$E2 then
halt(1);
if ord(a2[2])<>$82 then
halt(2);
writeln('---');
a3:=a1;
if ord(a3[1])<>$88 then
halt(3);
writeln('---');
u1:=a1;
if ord(u1[1])<>$20AC then
halt(4);
writeln('ok');
end.

19
tests/test/units/fpwidestring/tcpstransistrcompareequalfpws.pp Normal file
View File

@ -0,0 +1,19 @@
uses
unicodeducet, fpwidestring, cp1253, cp1251,
SysUtils;
type
ts1253 = type AnsiString(1253);
ts1251 = type AnsiString(1251);
var
s1 : ts1253;
s2 : ts1251;
au : unicodestring;
begin
au := #$20AC; // Euro symbol
s1 := au;
s2 := au;
if (s1<>s2) then
halt(1);
writeln('ok');
end.

30
tests/test/units/fpwidestring/tcpstransistrcomparefpwidestring.pp Normal file
View File

@ -0,0 +1,30 @@
uses
unicodeducet, fpwidestring, cp1253, cp1251,
SysUtils;
type
ts1253 = type AnsiString(1253);
ts1251 = type AnsiString(1251);
var
s1 : ts1253;
s2 : ts1251;
au : unicodestring;
begin
au := #$20AC; // Euro symbol
s1 := au;
s2 := au;
if Ord(s1[1]) = Ord(s2[1]) then
halt(5);
if (s1>s2) then
halt(1);
if (s1<s2) then
halt(2);
s1 := s1 + 'a';
if (s1<=s2) then
halt(3);
if (s2>=s1) then
halt(4);
writeln('ok');
end.