merge r17604 from cpstrnew branch by inoussa:

tests

git-svn-id: trunk@19123 -
This commit is contained in:
paul 2011-09-17 14:13:49 +00:00
parent 05d66e31ce
commit a87bb4283d
5 changed files with 183 additions and 0 deletions

4
.gitattributes vendored
View File

@ -9946,13 +9946,17 @@ tests/test/tcpstr5.pp svneol=native#text/plain
tests/test/tcpstr6.pp svneol=native#text/plain
tests/test/tcpstr7.pp svneol=native#text/plain
tests/test/tcpstr8.pp svneol=native#text/pascal
tests/test/tcpstransistr2shortstring.pp svneol=native#text/plain
tests/test/tcpstransistrcompare.pp svneol=native#text/plain
tests/test/tcpstransistrcompareequal.pp svneol=native#text/plain
tests/test/tcpstrassignansistr.pp svneol=native#text/plain
tests/test/tcpstrchar2ansistr.pp svneol=native#text/plain
tests/test/tcpstrconcat.pp svneol=native#text/plain
tests/test/tcpstrconcat2.pp svneol=native#text/plain
tests/test/tcpstrconcat3.pp svneol=native#text/plain
tests/test/tcpstrconcatmulti.pp svneol=native#text/plain
tests/test/tcpstrconcatmulti2.pp svneol=native#text/plain
tests/test/tcpstrpchar2ansistr.pp svneol=native#text/plain
tests/test/tcpstrsetlength.pp svneol=native#text/plain
tests/test/tcpstrsetlength2.pp svneol=native#text/plain
tests/test/tcpstrshortstr2ansistr.pp svneol=native#text/plain

View File

@ -0,0 +1,44 @@
{$apptype console}
uses
{$ifdef unix}
cwstring,
{$endif unix}
sysutils;
type
ts866 = type string<866>;
procedure doerror(ANumber : Integer);
begin
WriteLn('error ',ANumber);
Halt(ANumber);
end;
var
s : ts866;
i : Integer;
sa : ansistring;
ss : ShortString;
begin
sa := '123'#196#200#250;
ss := sa;
if (Length(sa) <> Length(ss)) then
doerror(1);
for i := 1 to Length(sa) do
begin
if (Byte(ss[i]) <> Byte(sa[i])) then
doerror(2)
end;
s := '123'#196#200#250;
ss := s;
if (Length(s) <> Length(ss)) then
doerror(3);
for i := 1 to Length(s) do
begin
if (Byte(ss[i]) <> Byte(s[i])) then
doerror(4)
end;
WriteLn('Ok');
end.

View File

@ -0,0 +1,29 @@
{$CODEPAGE cp866}
program tcpstrassignansistr;
type
ts866 = type string<866>;
procedure doerror(ANumber : Integer);
begin
//WriteLn('error ',ANumber);
Halt(ANumber);
end;
var
s, x : ts866;
i : Integer;
begin
s := #128#156#196;
x := s;
if (StringCodePage(s) <> 866) then
doerror(1);
if (StringCodePage(x) <> 866) then
doerror(2);
if (Length(x) <> Length(s)) then
doerror(3);
for i := 1 to Length(x) do
begin
if (Byte(x[i]) <> Byte(s[i])) then
doerror(4)
end;
end.

View File

@ -0,0 +1,54 @@
uses
{$ifdef unix}
cwstring,
{$endif unix}
sysutils;
type
ts866 = type string<866>;
procedure doerror(ANumber : Integer);
begin
WriteLn('error ',ANumber);
Halt(ANumber);
end;
var
x : ts866;
c : ansichar;
sa : ansistring;
begin
c := 'a';
sa := c;
if (StringCodePage(sa) <> DefaultSystemCodePage) then
doerror(1);
if (Length(sa) <> 1) then
doerror(2);
if (Byte(sa[1]) <> Byte(c)) then
doerror(3);
x := c;
if (StringCodePage(x) <> 866) then
doerror(4);
if (Length(x) <> 1) then
doerror(5);
if (Byte(x[1]) <> Byte(c)) then
doerror(6);
c := #156;
sa := c;
if (StringCodePage(sa) <> DefaultSystemCodePage) then
doerror(10);
if (Length(sa) <> 1) then
doerror(20);
if (Byte(sa[1]) <> Byte(c)) then
doerror(30);
x := c;
if (StringCodePage(x) <> 866) then
doerror(40);
if (Length(x) <> 1) then
doerror(50);
if (Byte(x[1]) <> Byte(c)) then
doerror(60);
WriteLn('Ok');
end.

View File

@ -0,0 +1,52 @@
uses
{$ifdef unix}
cwstring,
{$endif unix}
sysutils;
type
ts866 = type string<866>;
ts1252 = type string<1252>;
procedure doerror(ANumber : Integer);
begin
WriteLn('error ',ANumber);
Halt(ANumber);
end;
var
x : ts866;
i : Integer;
c : Integer;
p, pp : pansichar;
sa : ansistring;
begin
p := 'abc'#190#250;
c := 5;
sa := p;
if (StringCodePage(sa) <> DefaultSystemCodePage) then
doerror(1);
if (Length(sa) <> c) then
doerror(2);
pp := p;
for i := 1 to Length(sa) do
begin
if (Byte(sa[i]) <> Byte(pp^)) then
doerror(3);
Inc(pp);
end;
x := p;
if (StringCodePage(x) <> 866) then
doerror(10);
if (Length(x) <> c) then
doerror(20);
pp := p;
for i := 1 to Length(x) do
begin
if (Byte(x[i]) <> Byte(pp^)) then
doerror(30);
Inc(pp);
end;
WriteLn('Ok');
end.