* write vmt always according to the order of definitions

  * remove obsolete lastvtableindex

git-svn-id: trunk@5811 -

.gitattributes

@@ -7942,6 +7942,7 @@ tests/webtbs/tw7847.pp svneol=native#text/plain
 tests/webtbs/tw7963.pp svneol=native#text/plain
 tests/webtbs/tw7975.pp svneol=native#text/plain
 tests/webtbs/tw7975a.pp svneol=native#text/plain
+tests/webtbs/tw8018.pp svneol=native#text/plain
 tests/webtbs/tw8028.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain

compiler/nobj.pas

@@ -416,34 +416,31 @@ implementation
 
     procedure TVMTBuilder.add_vmt_entries(objdef:tobjectdef);
       var
+         def : tdef;
          pd  : tprocdef;
-         i,j : longint;
-         sym : tsym;
+         i   : longint;
          VMTSymEntry : TVMTSymEntry;
       begin
         { start with the base class }
         if assigned(objdef.childof) then
           add_vmt_entries(objdef.childof);
-        { process all procsyms }
-        for i:=0 to objdef.symtable.SymList.Count-1 do
+        { process all procdefs, we must process the defs to
+          keep the same order as that is written in the source
+          to be compatible with the indexes in the interface vtable (PFV) }
+        for i:=0 to objdef.symtable.DefList.Count-1 do
           begin
-            sym:=tsym(objdef.symtable.SymList[i]);
-            if sym.typ=procsym then
+            def:=tdef(objdef.symtable.DefList[i]);
+            if assigned(def) and
+               (def.typ=procdef) then
               begin
+                pd:=tprocdef(def);
                 { Find VMT procsym }
-                VMTSymEntry:=TVMTSymEntry(VMTSymEntryList.Find(sym.name));
+                VMTSymEntry:=TVMTSymEntry(VMTSymEntryList.Find(pd.procsym.name));
                 if not assigned(VMTSymEntry) then
-                  VMTSymEntry:=TVMTSymEntry.Create(VMTSymEntryList,sym.name);
-                { Add all procdefs }
-                for j:=0 to Tprocsym(sym).ProcdefList.Count-1 do
-                  begin
-                    pd:=tprocdef(Tprocsym(sym).ProcdefList[j]);
-                    if pd.procsym=tprocsym(sym) then
-                      begin
-                        if is_new_vmt_entry(VMTSymEntry,pd) then
-                          add_new_vmt_entry(VMTSymEntry,pd);
-                      end;
-                  end;
+                  VMTSymEntry:=TVMTSymEntry.Create(VMTSymEntryList,pd.procsym.name);
+                { VMT entry }
+                if is_new_vmt_entry(VMTSymEntry,pd) then
+                  add_new_vmt_entry(VMTSymEntry,pd);
               end;
           end;
       end;

compiler/pdecobj.pas

@@ -179,8 +179,6 @@ implementation
               if assigned(def) and
                  (def.typ=procdef) then
                 begin
-//                  tprocdef(def).extnumber:=aktobjectdef.lastvtableindex;
-//                  inc(aktobjectdef.lastvtableindex);
                   include(tprocdef(def).procoptions,po_virtualmethod);
                   tprocdef(def).forwarddef:=false;
                 end;

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=71;
+  CurrentPPUVersion=72;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/symdef.pas

@@ -235,7 +235,6 @@ interface
           iidstr         : pshortstring;
           iitype         : tinterfaceentrytype;
           iioffset       : longint;
-          lastvtableindex: longint;
           { store implemented interfaces defs and name mappings }
           ImplementedInterfaces : TFPObjectList;
           constructor create(ot : tobjecttyp;const n : string;c : tobjectdef);
@@ -3579,7 +3578,6 @@ implementation
         { create space for vmt !! }
         vmtentries:=nil;
         vmt_offset:=0;
-        lastvtableindex:=0;
         set_parent(c);
         objname:=stringdup(upper(n));
         objrealname:=stringdup(n);
@@ -3622,7 +3620,6 @@ implementation
               new(iidguid);
               ppufile.getguid(iidguid^);
               iidstr:=stringdup(ppufile.getstring);
-              lastvtableindex:=ppufile.getlongint;
            end;
 
          { load implemented interfaces }
@@ -3705,7 +3702,6 @@ implementation
           end;
         if assigned(iidstr) then
           tobjectdef(result).iidstr:=stringdup(iidstr^);
-        tobjectdef(result).lastvtableindex:=lastvtableindex;
         if assigned(ImplementedInterfaces) then
           begin
             for i:=0 to ImplementedInterfaces.count-1 do
@@ -3737,7 +3733,6 @@ implementation
            begin
               ppufile.putguid(iidguid^);
               ppufile.putstring(iidstr^);
-              ppufile.putlongint(lastvtableindex);
            end;
 
          if objecttype in [odt_class,odt_interfacecorba] then
@@ -3837,9 +3832,7 @@ implementation
         if assigned(c) then
           begin
              { only important for classes }
-             lastvtableindex:=c.lastvtableindex;
-             objectoptions:=objectoptions+(c.objectoptions*
-               inherited_objectoptions);
+             objectoptions:=objectoptions+(c.objectoptions*inherited_objectoptions);
              if not (objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) then
                begin
                   { add the data of the anchestor class }

tests/webtbs/tw8018.pp

@@ -0,0 +1,47 @@
+{$mode delphi}
+
+type
+  itest = interface(iunknown)
+    procedure Foo(); overload;
+    procedure Bar(); overload;
+    procedure Foo(x: integer); overload;
+    procedure Bar(x: integer); overload;
+  end;
+
+  ttest = class(tinterfacedobject, itest)
+    procedure Foo(); overload;
+    procedure Bar(); overload;
+    procedure Foo(x: integer); overload;
+    procedure Bar(x: integer); overload;
+  end;
+
+var
+  i : integer;
+  err : boolean;
+
+procedure ttest.Foo(); overload; begin writeln('#'); i:=1; end;
+procedure ttest.Foo(x: integer); overload; begin writeln('##'); i:=2; end;
+procedure ttest.Bar(); overload; begin writeln('###'); i:=3; end;
+procedure ttest.Bar(x: integer); overload; begin writeln('####'); i:=4; end;
+
+var
+  t: itest;
+  a: integer;
+begin
+  t := ttest.create();
+  t.Foo();
+  if i<>1 then
+    err:=true;
+  t.Foo(a);
+  if i<>2 then
+    err:=true;
+  t.Bar();
+  if i<>3 then
+    err:=true;
+  t.Bar(a);
+  if i<>4 then
+    err:=true;
+  t := nil;
+  if err then
+    halt(1);
+end.