mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-02 09:19:15 +02:00
+ web bug test #1915
This commit is contained in:
parent
f84fc7c834
commit
c386112711
41
tests/webtbs/tw1915.pp
Normal file
41
tests/webtbs/tw1915.pp
Normal file
@ -0,0 +1,41 @@
|
|||||||
|
PROGRAM SetIncl;
|
||||||
|
{
|
||||||
|
This program demonstrates a set inclusion test bug.
|
||||||
|
(After two days passed to track down a very perverse program error....)
|
||||||
|
(By Louis Jean-Ruichard)
|
||||||
|
}
|
||||||
|
TYPE
|
||||||
|
eAttr = ( e0, e1, e2, e3, e4, e5, e6, e7 );
|
||||||
|
entityP = ^entity;
|
||||||
|
entity =
|
||||||
|
RECORD
|
||||||
|
attr : SET OF eAttr;
|
||||||
|
END;
|
||||||
|
VAR
|
||||||
|
ep : entityP;
|
||||||
|
e : entity;
|
||||||
|
BEGIN
|
||||||
|
e.attr:=[e2,e4,e7,e1,e0];
|
||||||
|
WITH e DO
|
||||||
|
IF ([e1,e0] <= attr)
|
||||||
|
THEN Writeln('A1: [e1,e0] is included in attr')
|
||||||
|
;
|
||||||
|
New(ep);
|
||||||
|
ep^.attr:=[e2,e4,e7,e1,e0];
|
||||||
|
WITH ep^ DO
|
||||||
|
IF ([e1,e0] <= attr)
|
||||||
|
THEN Writeln('A2: [e1,e0] is included in attr')
|
||||||
|
ELSE
|
||||||
|
begin
|
||||||
|
Writeln('A2 statement incorrectly executed');
|
||||||
|
Halt(1);
|
||||||
|
end;
|
||||||
|
;
|
||||||
|
END.
|
||||||
|
|
||||||
|
{
|
||||||
|
$Log$
|
||||||
|
Revision 1.1 2002-04-13 08:00:16 carl
|
||||||
|
+ web bug test #1915
|
||||||
|
|
||||||
|
}
|
Loading…
Reference in New Issue
Block a user