Merged revisions 10636,10643,10655 via svnmerge from

svn+ssh://[email protected]/FPC/svn/fpc/trunk

........
r10636 | jonas | 2008-04-12 19:47:12 +0200 (Sat, 12 Apr 2008) | 2 lines

  + test for already fixed mantis 11053

........
r10643 | jonas | 2008-04-13 12:21:26 +0200 (Sun, 13 Apr 2008) | 8 lines

  * fixed internalerror when having to choose between different
    overloads in case there is only one variant parameter and
    one of the candidates has more hidden parameters than the
    other at the start (e.g. function(para):char and
    function(para):shortstring, depending on in which order the
    hidden shortstring result and para are processed, mantis
    #11139)

........
r10655 | jonas | 2008-04-13 19:03:07 +0200 (Sun, 13 Apr 2008) | 3 lines

  * don't perform call/jmp into push/jmp in case we're generating
    pic, as that optimization is invalid in that case

........

git-svn-id: branches/fixes_2_2@10778 -

.gitattributes

@@ -7938,7 +7938,9 @@ tests/webtbs/tw10979.pp svneol=native#text/plain
 tests/webtbs/tw11006.pp svneol=native#text/plain
 tests/webtbs/tw1103.pp svneol=native#text/plain
 tests/webtbs/tw1104.pp svneol=native#text/plain
+tests/webtbs/tw11053.pp svneol=native#text/plain
 tests/webtbs/tw1111.pp svneol=native#text/plain
+tests/webtbs/tw11139.pp svneol=native#text/plain
 tests/webtbs/tw11169.pp svneol=native#text/plain
 tests/webtbs/tw1117.pp svneol=native#text/plain
 tests/webtbs/tw1122.pp svneol=native#text/plain

compiler/htypechk.pas

@@ -2390,8 +2390,20 @@ implementation
                   ord(currvcl in conflictvcls)-ord(bestvcl in conflictvcls);
         end;
 
+
+        function getfirstrealparaidx(pd: pcandidate): integer;
+          begin
+            { can be different for currpd and bestpd in case of overloaded }
+            { functions, e.g. lowercase():char and lowercase():shortstring }
+            { (depending on the calling convention and parameter order)    }
+            result:=pd^.firstparaidx;
+            while (result>=0) and (vo_is_hidden_para in tparavarsym(pd^.data.paras[result]).varoptions) do
+              dec(result);
+            if (vo_is_hidden_para in tparavarsym(pd^.data.paras[result]).varoptions) then
+              internalerror(2006122803);
+          end;
+
       var
-        paraidx : integer;
         currpara, bestpara: tparavarsym;
         currvcl, bestvcl: tvariantequaltype;
       begin
@@ -2401,18 +2413,8 @@ implementation
             < 0 when bestpd is better than currpd
             = 0 when both are equal
         }
-        if (currpd^.firstparaidx<>bestpd^.firstparaidx) then
-          internalerror(2006122801);
-         paraidx:=currpd^.firstparaidx;
-         while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(currpd^.data.paras[paraidx]).varoptions) do
-           if (vo_is_hidden_para in tparavarsym(bestpd^.data.paras[paraidx]).varoptions) then
-             dec(paraidx)
-           else
-             internalerror(2006122802);
-        if (vo_is_hidden_para in tparavarsym(currpd^.data.paras[paraidx]).varoptions) then
-          internalerror(2006122803);
-        currpara:=tparavarsym(currpd^.data.paras[paraidx]);
-        bestpara:=tparavarsym(bestpd^.data.paras[paraidx]);
+        currpara:=tparavarsym(currpd^.data.paras[getfirstrealparaidx(currpd)]);
+        bestpara:=tparavarsym(bestpd^.data.paras[getfirstrealparaidx(bestpd)]);
 
         { if one of the parameters is a regular variant, fall back to the }
         { default algorithm                                               }

compiler/i386/popt386.pas

@@ -1959,6 +1959,7 @@ begin
             case taicpu(p).opcode Of
               A_CALL:
                 if (current_settings.optimizecputype < cpu_Pentium2) and
+                   not(cs_create_pic in current_settings.moduleswitches) and
                    GetNextInstruction(p, hp1) and
                    (hp1.typ = ait_instruction) and
                    (taicpu(hp1).opcode = A_JMP) and

tests/webtbs/tw11053.pp

@@ -0,0 +1,57 @@
+program Project1;
+
+{$mode delphi}
+
+const height = 1;
+      width = 1;
+
+var pix: array [0..height-1,0..width-1] of Integer;
+
+procedure Main;
+var
+    dx, dy: Integer;
+    Color, digest: cardinal;
+    cx, cy, zx, zy: Double;
+    scale: Double;
+    deep: Integer;
+
+begin
+  FillChar(pix, SizeOf(pix), $f0);
+        scale := 0.05;
+        deep := 30;
+        Digest := 0;
+
+
+      for dy := 0 to height -1 do
+      begin
+        cy := (dy - height / 2) * scale;
+        for dx := 0 to width - 1 do
+        begin
+          color := 0;
+          cx := (dx - width / 2) * scale;
+
+          zx := cx;
+          zy := cy;
+
+          while zx * zx + zy * zy < 1 do
+          begin
+            zx := zx * zx - zy * zy + cx;
+            zy := 2 * zx * zy + cy;
+            Inc( color );
+            if color > Cardinal(deep) then break;
+          end;
+          pix[ dy, dx ] := color;
+        end;
+      end;
+
+  pix[ 0, 0 ] := 80;
+
+  Digest := 0;
+  for dy := 0 to height -1 do for dx := 0 to width - 1 do Digest := Digest + pix[dy, dx];
+
+  if (digest<>80) then
+    halt(1);
+end;
+begin
+  Main;
+end.

tests/webtbs/tw11139.pp

@@ -0,0 +1,28 @@
+function f(c: char): char; overload;
+begin
+  halt(1);
+end;
+
+function f(const s: shortstring): shortstring; overload;
+begin
+  f:=lowercase(s);
+end;
+
+function f(const a: ansistring): ansistring; overload;
+begin
+  halt(3);
+end;
+
+Procedure DoIt;
+var avar:variant;
+      txt:String;
+Begin
+avar:='Hello';
+txt:=f(avar);//this line causes the compilation error
+if (txt<>'hello') then
+  halt(4);
+end;
+
+begin
+  doit;
+end.