* use the correct procdef when taking the address of an overloaded function

in a typed constant (mantis #16820)

git-svn-id: trunk@15508 -

.gitattributes

@@ -10523,6 +10523,7 @@ tests/webtbs/tw16770.pp svneol=native#text/plain
 tests/webtbs/tw16772.pp svneol=native#text/plain
 tests/webtbs/tw16803.pp svneol=native#text/plain
 tests/webtbs/tw1681.pp svneol=native#text/plain
+tests/webtbs/tw16820.pp svneol=native#text/plain
 tests/webtbs/tw1696.pp svneol=native#text/plain
 tests/webtbs/tw1699.pp svneol=native#text/plain
 tests/webtbs/tw1709.pp svneol=native#text/plain

compiler/nld.pas

@@ -37,8 +37,8 @@ interface
 
        tloadnode = class(tunarynode)
        protected
-          procdef : tprocdef;
+          fprocdef : tprocdef;
-          procdefderef : tderef;
+          fprocdefderef : tderef;
        public
           symtableentry : tsym;
           symtableentryderef : tderef;
@@ -58,6 +58,7 @@ interface
           function  docompare(p: tnode): boolean; override;
           procedure printnodedata(var t:text);override;
           procedure setprocdef(p : tprocdef);
+          property procdef: tprocdef read fprocdef write setprocdef;
        end;
        tloadnodeclass = class of tloadnode;
 
@@ -167,7 +168,7 @@ implementation
           internalerror(200108121);
          symtableentry:=v;
          symtable:=st;
-         procdef:=nil;
+         fprocdef:=nil;
       end;
 
 
@@ -178,7 +179,7 @@ implementation
           internalerror(200108122);
          symtableentry:=v;
          symtable:=st;
-         procdef:=d;
+         fprocdef:=d;
       end;
 
 
@@ -187,7 +188,7 @@ implementation
         inherited ppuload(t,ppufile);
         ppufile.getderef(symtableentryderef);
         symtable:=nil;
-        ppufile.getderef(procdefderef);
+        ppufile.getderef(fprocdefderef);
       end;
 
 
@@ -195,7 +196,7 @@ implementation
       begin
         inherited ppuwrite(ppufile);
         ppufile.putderef(symtableentryderef);
-        ppufile.putderef(procdefderef);
+        ppufile.putderef(fprocdefderef);
       end;
 
 
@@ -203,7 +204,7 @@ implementation
       begin
         inherited buildderefimpl;
         symtableentryderef.build(symtableentry);
-        procdefderef.build(procdef);
+        fprocdefderef.build(fprocdef);
       end;
 
 
@@ -212,7 +213,7 @@ implementation
         inherited derefimpl;
         symtableentry:=tsym(symtableentryderef.resolve);
         symtable:=symtableentry.owner;
-        procdef:=tprocdef(procdefderef.resolve);
+        fprocdef:=tprocdef(fprocdefderef.resolve);
       end;
 
 
@@ -233,7 +234,7 @@ implementation
          n:=tloadnode(inherited dogetcopy);
          n.symtable:=symtable;
          n.symtableentry:=symtableentry;
-         n.procdef:=procdef;
+         n.fprocdef:=fprocdef;
          result:=n;
       end;
 
@@ -322,15 +323,15 @@ implementation
                  procdefs the matching procdef will be choosen
                  when the expected procvardef is known, see get_information
                  in htypechk.pas (PFV) }
-               if not assigned(procdef) then
+               if not assigned(fprocdef) then
-                 procdef:=tprocdef(tprocsym(symtableentry).ProcdefList[0])
+                 fprocdef:=tprocdef(tprocsym(symtableentry).ProcdefList[0])
-               else if po_kylixlocal in procdef.procoptions then
+               else if po_kylixlocal in fprocdef.procoptions then
                  CGMessage(type_e_cant_take_address_of_local_subroutine);
 
-               { the result is a procdef, addrn and proc_to_procvar
+               { the result is a fprocdef, addrn and proc_to_procvar
                  typeconvn need this as resultdef so they know
                  that the address needs to be returned }
-               resultdef:=procdef;
+               resultdef:=fprocdef;
 
                { process methodpointer }
                if assigned(left) then
@@ -410,7 +411,7 @@ implementation
         docompare :=
           inherited docompare(p) and
           (symtableentry = tloadnode(p).symtableentry) and
-          (procdef = tloadnode(p).procdef) and
+          (fprocdef = tloadnode(p).fprocdef) and
           (symtable = tloadnode(p).symtable);
       end;
 
@@ -420,14 +421,14 @@ implementation
         inherited printnodedata(t);
         write(t,printnodeindention,'symbol = ',symtableentry.name);
         if symtableentry.typ=procsym then
-          write(t,printnodeindention,'procdef = ',procdef.mangledname);
+          write(t,printnodeindention,'procdef = ',fprocdef.mangledname);
         writeln(t,'');
       end;
 
 
     procedure tloadnode.setprocdef(p : tprocdef);
       begin
-        procdef:=p;
+        fprocdef:=p;
         resultdef:=p;
         if po_local in p.procoptions then
           CGMessage(type_e_cant_take_address_of_local_subroutine);

compiler/ptconst.pas

@@ -1005,7 +1005,7 @@ implementation
           if (n.nodetype=loadn) and
              (tloadnode(n).symtableentry.typ=procsym) then
             begin
-              pd:=tprocdef(tprocsym(tloadnode(n).symtableentry).ProcdefList[0]);
+              pd:=tloadnode(n).procdef;
               list.concat(Tai_const.createname(pd.mangledname,0));
             end
           else

tests/webtbs/tw16820.pp

@@ -0,0 +1,59 @@
+{$ifdef fpc}
+{$mode delphi}{$H+}
+{$endif}
+
+uses
+  Classes, SysUtils;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class
+  private
+    { private declarations }
+  public
+    { public declarations }
+    procedure test;
+  end; 
+
+  FNType = function(A, B: integer): integer;
+var
+  Form1: TForm1; 
+
+function Add23(A, B: integer; C: cardinal): integer; overload; forward;
+function Add23(A, B: integer): integer; overload; forward;
+
+const
+  FPArray: FNType = Add23;
+
+function Add23(A, B: integer; C: cardinal): integer; overload;
+  begin
+    Result := A + B + C;
+    halt(1);
+  end;
+
+function Add23(A, B: integer): integer; overload;
+  begin
+    Result := A - B;
+  end;
+
+{ TForm1 }
+
+procedure TForm1.test;
+  var
+    a, b: integer;
+  begin
+    a := 3;
+    b := 4;
+    writeln(FParray(a, b));
+end;
+
+var
+  f: tform1;
+begin
+  f:=tform1.create;
+  f.test;
+  f.free;
+end.
+