瀏覽代碼

* do not search variant operators when looking for an overloaded
operator for a non-variant type (was already intended that way,
but checks didn't work) (mantis #7070) + tests
* some tab->spaces in defcmp.pas

git-svn-id: trunk@7359 -

Jonas Maebe 18 年之前
父節點
當前提交
6555f37cff
共有 5 個文件被更改,包括 91 次插入20 次删除
  1. 3 0
      .gitattributes
  2. 28 20
      compiler/defcmp.pas
  3. 18 0
      tests/webtbf/tw7070.pp
  4. 21 0
      tests/webtbs/tw7070a.pp
  5. 21 0
      tests/webtbs/tw7070b.pp

+ 3 - 0
.gitattributes

@@ -7285,6 +7285,7 @@ tests/webtbf/tw6686.pp svneol=native#text/plain
 tests/webtbf/tw6796.pp svneol=native#text/plain
 tests/webtbf/tw6922.pp svneol=native#text/plain
 tests/webtbf/tw6970.pp svneol=native#text/plain
+tests/webtbf/tw7070.pp svneol=native#text/plain
 tests/webtbf/tw7322.pp svneol=native#text/plain
 tests/webtbf/tw7438.pp svneol=native#text/plain
 tests/webtbf/tw7438a.pp svneol=native#text/plain
@@ -8115,6 +8116,8 @@ tests/webtbs/tw6977.pp svneol=native#text/plain
 tests/webtbs/tw6980.pp svneol=native#text/plain
 tests/webtbs/tw6989.pp svneol=native#text/plain
 tests/webtbs/tw7006.pp svneol=native#text/plain
+tests/webtbs/tw7070a.pp svneol=native#text/plain
+tests/webtbs/tw7070b.pp svneol=native#text/plain
 tests/webtbs/tw7071.pp svneol=native#text/plain
 tests/webtbs/tw7100.pp svneol=native#text/plain
 tests/webtbs/tw7104.pp svneol=native#text/plain

+ 28 - 20
compiler/defcmp.pas

@@ -657,7 +657,8 @@ implementation
                                 begin
                                   subeq:=compare_defs_ext(tarraydef(def_from).elementdef,
                                                        tarraydef(def_to).elementdef,
-                                                       arrayconstructorn,hct,hpd,[cdo_check_operator]);
+                                                       { reason for cdo_allow_variant: see webtbs/tw7070a and webtbs/tw7070b }
+                                                       arrayconstructorn,hct,hpd,[cdo_check_operator,cdo_allow_variant]);
                                   if (subeq>=te_equal) then
                                     begin
                                       doconv:=tc_equal;
@@ -892,23 +893,23 @@ implementation
                           end;
                       end;
                      { allow explicit typecasts from ordinals to pointer.
-		       Support for delphi compatibility
-		       Support constructs like pointer(cardinal-cardinal) or pointer(longint+cardinal) where
-		        the result of the ordinal operation is int64 also on 32 bit platforms.
+                       Support for delphi compatibility
+                       Support constructs like pointer(cardinal-cardinal) or pointer(longint+cardinal) where
+                        the result of the ordinal operation is int64 also on 32 bit platforms.
                        It is also used by the compiler internally for inc(pointer,ordinal) }
                      if (eq=te_incompatible) and
                         not is_void(def_from) and
-			(
+                        (
                          (
-			  (cdo_explicit in cdoptions) and
-			  (
-			   (m_delphi in current_settings.modeswitches) or
-			   { Don't allow pchar(char) in fpc modes }
-			   is_integer(def_from)
-			  )
-			 ) or
-			 (cdo_internal in cdoptions)
-			) then
+                          (cdo_explicit in cdoptions) and
+                          (
+                           (m_delphi in current_settings.modeswitches) or
+                           { Don't allow pchar(char) in fpc modes }
+                           is_integer(def_from)
+                          )
+                         ) or
+                         (cdo_internal in cdoptions)
+                        ) then
                        begin
                          doconv:=tc_int_2_int;
                          eq:=te_convert_l1;
@@ -918,14 +919,14 @@ implementation
                  enumdef :
                    begin
                      { allow explicit typecasts from enums to pointer.
-		       Support for delphi compatibility
+                       Support for delphi compatibility
                      }
                      if (eq=te_incompatible) and
                         (((cdo_explicit in cdoptions) and
                           (m_delphi in current_settings.modeswitches)
- 		         ) or
-			 (cdo_internal in cdoptions)
-			) then
+                          ) or
+                         (cdo_internal in cdoptions)
+                        ) then
                        begin
                          doconv:=tc_int_2_int;
                          eq:=te_convert_l1;
@@ -1332,6 +1333,13 @@ implementation
         { if we didn't find an appropriate type conversion yet
           then we search also the := operator }
         if (eq=te_incompatible) and
+           { make sure there is not a single variant if variants   }
+           { are not allowed (otherwise if only cdo_check_operator }
+           { and e.g. fromdef=stringdef and todef=variantdef, then }
+           { the test will still succeed                           }
+           ((cdo_allow_variant in cdoptions) or
+            ((def_from.typ<>variantdef) and (def_to.typ<>variantdef))
+           ) and
            (
             { Check for variants? }
             (
@@ -1341,8 +1349,8 @@ implementation
             { Check for operators? }
             (
              (cdo_check_operator in cdoptions) and
-             ((def_from.typ in [objectdef,recorddef,arraydef,stringdef,variantdef]) or
-              (def_to.typ in [objectdef,recorddef,arraydef,stringdef,variantdef]))
+             ((def_from.typ in [objectdef,recorddef,arraydef,stringdef]) or
+              (def_to.typ in [objectdef,recorddef,arraydef,stringdef]))
             )
            ) then
           begin

+ 18 - 0
tests/webtbf/tw7070.pp

@@ -0,0 +1,18 @@
+{ %fail }
+
+program varistr;
+
+{$ifdef fpc}
+{$mode delphi}
+{$h+}
+{$endif}
+
+var
+  str: string;
+begin
+  str := 'something';
+
+  if not str = 'hello' then
+    writeln('test')
+end.
+

+ 21 - 0
tests/webtbs/tw7070a.pp

@@ -0,0 +1,21 @@
+{ %norun }
+
+{$ifdef fpc}
+{$mode delphi}
+{$h+}
+{$endif}
+
+uses
+  Variants;
+
+procedure test(const a: array of string);
+begin
+end;
+
+var
+  a,b: variant;
+begin
+  a:=1;
+  b:=2;
+  test([a,b]);
+end.

+ 21 - 0
tests/webtbs/tw7070b.pp

@@ -0,0 +1,21 @@
+{ %norun }
+
+{$ifdef fpc}
+{$mode delphi}
+{$h+}
+{$endif}
+
+uses
+  Variants;
+
+procedure test(const a: array of variant);
+begin
+end;
+
+var
+  a,b: longint;
+begin
+  a:=1;
+  b:=2;
+  test([a,b]);
+end.