mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 02:06:10 +02:00
+ changed web bug #2382 into test for root cause
This commit is contained in:
parent
48f985db06
commit
b2eea6a1d8
45
tests/webtbs/tw2382.pp
Normal file
45
tests/webtbs/tw2382.pp
Normal file
@ -0,0 +1,45 @@
|
|||||||
|
var
|
||||||
|
sa : array[0..2] of char;
|
||||||
|
s: string;
|
||||||
|
begin
|
||||||
|
sa := '';
|
||||||
|
s := sa;
|
||||||
|
if length(s) <> 0 then
|
||||||
|
begin
|
||||||
|
writeln('error 0');
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
sa := 'a';
|
||||||
|
s := sa;
|
||||||
|
if length(s) <> 1 then
|
||||||
|
begin
|
||||||
|
writeln('error 1');
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
sa := 'ab';
|
||||||
|
s := sa;
|
||||||
|
if length(s) <> 2 then
|
||||||
|
begin
|
||||||
|
writeln('error 2');
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
sa := 'abc';
|
||||||
|
// check for possible overflow in assignment
|
||||||
|
s[4] := '1';
|
||||||
|
s := sa;
|
||||||
|
if length(s) <> 3 then
|
||||||
|
begin
|
||||||
|
writeln('error 3');
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if s[4] <> '1' then
|
||||||
|
begin
|
||||||
|
writeln('error 4');
|
||||||
|
halt(1);
|
||||||
|
end;
|
||||||
|
end.
|
||||||
|
|
Loading…
Reference in New Issue
Block a user