mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 20:49:19 +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/tcpstr6.pp svneol=native#text/plain
|
||||||
tests/test/tcpstr7.pp svneol=native#text/plain
|
tests/test/tcpstr7.pp svneol=native#text/plain
|
||||||
tests/test/tcpstr8.pp svneol=native#text/pascal
|
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/tcpstransistrcompare.pp svneol=native#text/plain
|
||||||
tests/test/tcpstransistrcompareequal.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/tcpstrconcat.pp svneol=native#text/plain
|
||||||
tests/test/tcpstrconcat2.pp svneol=native#text/plain
|
tests/test/tcpstrconcat2.pp svneol=native#text/plain
|
||||||
tests/test/tcpstrconcat3.pp svneol=native#text/plain
|
tests/test/tcpstrconcat3.pp svneol=native#text/plain
|
||||||
tests/test/tcpstrconcatmulti.pp svneol=native#text/plain
|
tests/test/tcpstrconcatmulti.pp svneol=native#text/plain
|
||||||
tests/test/tcpstrconcatmulti2.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/tcpstrsetlength.pp svneol=native#text/plain
|
||||||
tests/test/tcpstrsetlength2.pp svneol=native#text/plain
|
tests/test/tcpstrsetlength2.pp svneol=native#text/plain
|
||||||
tests/test/tcpstrshortstr2ansistr.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