Просмотр исходного кода

* simply discard overloaded routines which cannot accept a variant
when determining the optimal candidate for a single variant
parameter, rather than giving an internal error (mantis #10623)

git-svn-id: trunk@9726 -

Jonas Maebe 17 лет назад
Родитель
Сommit
be2119b489
3 измененных файлов с 70 добавлено и 3 удалено
  1. 1 0
      .gitattributes
  2. 9 3
      compiler/htypechk.pas
  3. 60 0
      tests/webtbs/tw10623.pp

+ 1 - 0
.gitattributes

@@ -7969,6 +7969,7 @@ tests/webtbs/tw1046.pp svneol=native#text/plain
 tests/webtbs/tw1050.pp svneol=native#text/plain
 tests/webtbs/tw10540.pp svneol=native#text/plain
 tests/webtbs/tw1061.pp svneol=native#text/plain
+tests/webtbs/tw10623.pp svneol=native#text/plain
 tests/webtbs/tw1066a.pp svneol=native#text/plain
 tests/webtbs/tw1066b.pp svneol=native#text/plain
 tests/webtbs/tw1068.pp svneol=native#text/plain

+ 9 - 3
compiler/htypechk.pas

@@ -2203,7 +2203,6 @@ implementation
         variantstringdef_cl: array[tstringtype] of tvariantequaltype =
           (tve_sstring,tve_astring,tve_astring,tve_wstring,tve_unicodestring);
       begin
-        result:=tve_incompatible;
         case def.typ of
           orddef:
             begin
@@ -2222,7 +2221,9 @@ implementation
               result:=tve_boolformal;
             end;
           else
-            internalerror(2006122804);
+            begin
+              result:=tve_incompatible;
+            end;
         end
       end;
 
@@ -2387,6 +2388,11 @@ implementation
         { if both are the same, there is a conflict }
         if (currvcl=bestvcl) then
           result:=0
+        { if one of the two cannot be used as variant, the other is better }
+        else if (bestvcl=tve_incompatible) then
+          result:=1
+        else if (currvcl=tve_incompatible) then
+          result:=-1
         { boolean and formal are better than chari64str, but conflict with }
         { everything else                                                  }
         else if (currvcl=tve_boolformal) or
@@ -2417,7 +2423,7 @@ implementation
           result:=calculate_relation(currvcl,bestvcl,tve_smallint,[tve_cardinal])
         { cardinal conflicts with each longint and is better than everything }
         { which has not yet been tested                                      }
-        else if (currvcl = tve_cardinal) or
+        else if (currvcl=tve_cardinal) or
                 (bestvcl=tve_cardinal) then
           result:=calculate_relation(currvcl,bestvcl,tve_cardinal,[tve_longint])
         { longint is better than everything which has not yet been tested }

+ 60 - 0
tests/webtbs/tw10623.pp

@@ -0,0 +1,60 @@
+{$mode delphi}
+
+uses
+  Variants
+  ;
+
+type
+
+
+  // TMockMethod
+  //
+  TMockMethod = class
+  private 
+    FReturnValue: variant; 
+    
+  public
+
+    //: Set return value
+    procedure Returns(AValue: Variant); overload;
+    procedure Returns(AValue: Pointer); overload; // if i change this from type Pointer to Double it works
+    procedure Returns(AValue: Integer); overload;
+  end;
+
+
+function Failure: TMockMethod;
+begin
+  Result := TMockMethod.Create;
+
+  { TODO: Free Pascal Compiler version 2.2.0 [2007/08/30] for i386 crash with Internal error 2006122804 on this line
+	using fpc -Sd PascalMockBug.pas or fpc -S2 PascalMockBug.pas
+  }
+  Result.Returns(Result.FReturnValue);
+end;
+
+
+{ TMockMethod }
+
+
+procedure TMockMethod.Returns(AValue: Integer);
+begin
+  halt(1);
+end;
+
+procedure TMockMethod.Returns(AValue: Pointer);
+begin
+  halt(1);
+end;
+
+procedure TMockMethod.Returns(AValue: Variant);
+begin
+  writeln('ok');
+end;
+
+var
+  c: tmockmethod;
+begin
+  c:=Failure;
+  c.free;
+end.
+