浏览代码

* fix for Mantis #34021: if one of the two operators is an array constructor try to use an operator overload for that first before converting it to a set
+ added tests

git-svn-id: trunk@39554 -

svenbarth 7 年之前
父节点
当前提交
32c307e9ce
共有 4 个文件被更改,包括 102 次插入13 次删除
  1. 2 0
      .gitattributes
  2. 25 13
      compiler/nadd.pas
  3. 50 0
      tests/tbs/tb0649.pp
  4. 25 0
      tests/webtbs/tw34021.pp

+ 2 - 0
.gitattributes

@@ -11583,6 +11583,7 @@ tests/tbs/tb0645c.pp svneol=native#text/pascal
 tests/tbs/tb0646a.pp svneol=native#text/pascal
 tests/tbs/tb0646b.pp svneol=native#text/pascal
 tests/tbs/tb0648.pp svneol=native#text/pascal
+tests/tbs/tb0649.pp -text svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain
@@ -16223,6 +16224,7 @@ tests/webtbs/tw33839b.pp -text svneol=native#text/pascal
 tests/webtbs/tw33840.pp -text svneol=native#text/pascal
 tests/webtbs/tw33898.pp -text svneol=native#text/pascal
 tests/webtbs/tw3402.pp svneol=native#text/plain
+tests/webtbs/tw34021.pp -text svneol=native#text/pascal
 tests/webtbs/tw3411.pp svneol=native#text/plain
 tests/webtbs/tw3418.pp svneol=native#text/plain
 tests/webtbs/tw3423.pp svneol=native#text/plain

+ 25 - 13
compiler/nadd.pas

@@ -1303,22 +1303,34 @@ implementation
            if not (nodetype in [equaln,unequaln]) then
              InternalError(2013091601);
 
-         { convert array constructors to sets, because there is no other operator
-           possible for array constructors }
-         if not(is_dynamic_array(right.resultdef)) and is_array_constructor(left.resultdef) then
-          begin
-            arrayconstructor_to_set(left);
-            typecheckpass(left);
-          end;
-         if not(is_dynamic_array(left.resultdef)) and is_array_constructor(right.resultdef) then
-          begin
-            arrayconstructor_to_set(right);
-            typecheckpass(right);
-          end;
-
          { allow operator overloading }
          hp:=self;
 
+         if is_array_constructor(left.resultdef) or is_array_constructor(right.resultdef) then
+           begin
+             { check whether there is a suitable operator for the array constructor
+               (but only if the "+" array operator isn't used), if not fall back to sets }
+             if (
+                   (nodetype<>addn) or
+                   not (m_array_operators in current_settings.modeswitches) or
+                   (is_array_constructor(left.resultdef) and not is_dynamic_array(right.resultdef)) or
+                   (not is_dynamic_array(left.resultdef) and is_array_constructor(right.resultdef))
+                 ) and
+                 not isbinaryoverloaded(hp,[ocf_check_only]) then
+               begin
+                 if is_array_constructor(left.resultdef) then
+                   begin
+                     arrayconstructor_to_set(left);
+                     typecheckpass(left);
+                   end;
+                 if is_array_constructor(right.resultdef) then
+                   begin
+                     arrayconstructor_to_set(right);
+                     typecheckpass(right);
+                   end;
+               end;
+           end;
+
          if is_dynamic_array(left.resultdef) and is_dynamic_array(right.resultdef) and
              (nodetype=addn) and
              (m_array_operators in current_settings.modeswitches) and

+ 50 - 0
tests/tbs/tb0649.pp

@@ -0,0 +1,50 @@
+{ %NORUN }
+
+program tb0649;
+
+{$mode objfpc}
+
+type
+  TEnum = (
+    eOne,
+    eTwo,
+    eThree
+  );
+
+  TEnumSet = set of TEnum;
+
+  TByteSet = set of Byte;
+
+  TTest = class
+  end;
+
+operator + (aLeft: TTest; aRight: array of Byte): TTest;
+begin
+  Writeln('Array of Byte');
+  Result := aLeft;
+end;
+
+operator + (aLeft: TTest; aRight: TByteSet): TTest;
+begin
+  Writeln('Set of Byte');
+  Result := aLeft;
+end;
+
+operator + (aLeft: TTest; aRight: array of TEnum): TTest;
+begin
+  Writeln('Array of TEnum');
+  Result := aLeft;
+end;
+
+operator + (aLeft: TTest; aRight: TEnumSet): TTest;
+begin
+  Writeln('Set of TEnum');
+  Result := aLeft;
+end;
+
+var
+  t: TTest;
+begin
+  t := t + [1, 2, 3];
+  t := t + [eOne, eTwo];
+end.

+ 25 - 0
tests/webtbs/tw34021.pp

@@ -0,0 +1,25 @@
+{ %NORUN }
+
+program thelloworld;
+
+{$mode objfpc}{$H+}
+{$COperators On}
+
+type
+  TMyClass = class
+  end;
+
+operator + (left: TMyClass; right: array of integer): TMyClass; overload;
+var
+    i: integer;
+begin
+    for i in right do
+        writeln('add ', i);
+    result := left;
+end;
+
+var
+  c: TMyClass;
+begin
+  c += [1, 2, 3]; // ERROR: Operator is not overloaded: "TMyClass" + "Set Of Byte"
+end.