Browse Source

+ web bug test #1915

carl 23 years ago
parent
commit
c386112711
1 changed files with 41 additions and 0 deletions
  1. 41 0
      tests/webtbs/tw1915.pp

+ 41 - 0
tests/webtbs/tw1915.pp

@@ -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
+
+}