From be2119b489aef86d2c5890d45ffc5728f7f5b961 Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sat, 12 Jan 2008 19:01:49 +0000
Subject: [PATCH]   * 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 -
---
 .gitattributes          |  1 +
 compiler/htypechk.pas   | 12 ++++++---
 tests/webtbs/tw10623.pp | 60 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 70 insertions(+), 3 deletions(-)
 create mode 100644 tests/webtbs/tw10623.pp

diff --git a/.gitattributes b/.gitattributes
index 21aeb07b88..fd855845f5 100644
--- a/.gitattributes
+++ b/.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
diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 400c6a284e..ed81d30041 100644
--- a/compiler/htypechk.pas
+++ b/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 }
diff --git a/tests/webtbs/tw10623.pp b/tests/webtbs/tw10623.pp
new file mode 100644
index 0000000000..aa24bf8e5d
--- /dev/null
+++ b/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.
+