mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 11:09:42 +02:00
merge r17604 from cpstrnew branch by inoussa:
tests git-svn-id: trunk@19123 -
This commit is contained in:
parent
05d66e31ce
commit
a87bb4283d
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -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
|
||||
|
44
tests/test/tcpstransistr2shortstring.pp
Normal file
44
tests/test/tcpstransistr2shortstring.pp
Normal 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.
|
29
tests/test/tcpstrassignansistr.pp
Normal file
29
tests/test/tcpstrassignansistr.pp
Normal 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.
|
54
tests/test/tcpstrchar2ansistr.pp
Normal file
54
tests/test/tcpstrchar2ansistr.pp
Normal 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.
|
52
tests/test/tcpstrpchar2ansistr.pp
Normal file
52
tests/test/tcpstrpchar2ansistr.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user