Browse Source

* fix for Mantis #37806: allow undefineddefs for Include() and Exclude()
+ added tests

git-svn-id: trunk@46953 -

svenbarth 4 years ago
parent
commit
cce2dad1bf
4 changed files with 69 additions and 1 deletions
  1. 2 0
      .gitattributes
  2. 1 1
      compiler/ninl.pas
  3. 40 0
      tests/tbs/tb0677.pp
  4. 26 0
      tests/webtbs/tw37806.pp

+ 2 - 0
.gitattributes

@@ -13350,6 +13350,7 @@ tests/tbs/tb0674.pp svneol=native#text/pascal
 tests/tbs/tb0675.pp svneol=native#text/pascal
 tests/tbs/tb0675.pp svneol=native#text/pascal
 tests/tbs/tb0676.pp svneol=native#text/pascal
 tests/tbs/tb0676.pp svneol=native#text/pascal
 tests/tbs/tb0676a.pp svneol=native#text/plain
 tests/tbs/tb0676a.pp svneol=native#text/plain
+tests/tbs/tb0677.pp svneol=native#text/pascal
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain
@@ -18475,6 +18476,7 @@ tests/webtbs/tw37779.pp svneol=native#text/pascal
 tests/webtbs/tw3778.pp svneol=native#text/plain
 tests/webtbs/tw3778.pp svneol=native#text/plain
 tests/webtbs/tw37780.pp svneol=native#text/plain
 tests/webtbs/tw37780.pp svneol=native#text/plain
 tests/webtbs/tw3780.pp svneol=native#text/plain
 tests/webtbs/tw3780.pp svneol=native#text/plain
+tests/webtbs/tw37806.pp svneol=native#text/pascal
 tests/webtbs/tw3782.pp svneol=native#text/plain
 tests/webtbs/tw3782.pp svneol=native#text/plain
 tests/webtbs/tw3796.pp svneol=native#text/plain
 tests/webtbs/tw3796.pp svneol=native#text/plain
 tests/webtbs/tw3805.pp svneol=native#text/plain
 tests/webtbs/tw3805.pp svneol=native#text/plain

+ 1 - 1
compiler/ninl.pas

@@ -3477,7 +3477,7 @@ implementation
                       inserttypeconv(tcallparanode(tcallparanode(left).right).left,
                       inserttypeconv(tcallparanode(tcallparanode(left).right).left,
                         tsetdef(left.resultdef).elementdef);
                         tsetdef(left.resultdef).elementdef);
                     end
                     end
-                  else
+                  else if left.resultdef.typ<>undefineddef then
                     CGMessage(type_e_mismatch);
                     CGMessage(type_e_mismatch);
                 end;
                 end;
               in_pack_x_y_z,
               in_pack_x_y_z,

+ 40 - 0
tests/tbs/tb0677.pp

@@ -0,0 +1,40 @@
+{ %NORUN }
+
+program tb0677;
+
+{$mode objfpc}
+
+type
+  TEnum = (eOne, eTwo, eThree, eFour);
+  TSet = set of TEnum;
+
+  generic TTest<SetType, EnumType> = class
+    procedure Test;
+  end;
+
+procedure TTest.Test;
+var
+  s1: TSet;
+  s2: SetType;
+  e1: TEnum;
+  e2: EnumType;
+begin
+  Include(s1, e1);
+  Exclude(s1, e1);
+
+  Include(s2, e1);
+  Exclude(s2, e1);
+
+  Include(s2, e2);
+  Exclude(s2, e2);
+
+  Include(s2, e1);
+  Exclude(s2, e2);
+end;
+
+type
+  TTestTypes = specialize TTest<TSet, TEnum>;
+
+begin
+
+end.

+ 26 - 0
tests/webtbs/tw37806.pp

@@ -0,0 +1,26 @@
+program tw37806;
+
+{$mode delphi}
+
+procedure TurnSetElem<TSet, TElem>(var aSet: TSet; aElem: TElem; aOn: Boolean);
+begin
+  if aOn then
+    Include(aSet, aElem)
+  else
+    Exclude(aSet, aElem);
+end;
+
+type
+  TElem = (One, Two, Three, Four, Five);
+  TSet = set of TElem;
+
+var
+  s: TSet = [];
+
+begin
+  TurnSetElem<TSet, TElem>(s, Two, True);
+  TurnSetElem<TSet, TElem>(s, Five, True);
+  if not((Two in s) and (Five in s)) then
+    Halt(1);
+    //WriteLn('does not work');
+end.