compiler: auto generate method/property dispid if it is not set explicitly

git-svn-id: trunk@14766 -

.gitattributes

@@ -8916,6 +8916,7 @@ tests/test/tcmp0.pp svneol=native#text/plain
 tests/test/tdel1.pp svneol=native#text/plain
 tests/test/tdispinterface1a.pp svneol=native#text/pascal
 tests/test/tdispinterface1b.pp svneol=native#text/pascal
+tests/test/tdispinterface2.pp svneol=native#text/plain
 tests/test/tendian1.pp svneol=native#text/plain
 tests/test/tenum1.pp svneol=native#text/plain
 tests/test/tenum2.pp svneol=native#text/plain

compiler/pdecobj.pas

@@ -730,6 +730,13 @@ implementation
                   begin
                     parse_object_proc_directives(pd);
 
+                    { check if dispid is set }
+                    if is_dispinterface(pd._class) and not (po_dispid in pd.procoptions) then
+                      begin
+                        pd.dispid:=pd._class.get_next_dispid;
+                        include(pd.procoptions, po_dispid);
+                      end;
+
                     { all Macintosh Object Pascal methods are virtual.  }
                     { this can't be a class method, because macpas mode }
                     { has no m_class                                    }

compiler/pdecvar.pas

@@ -277,7 +277,9 @@ implementation
                   else
                     Message(parser_e_dispid_must_be_ord_const);
                   pt.free;
-                end;
+                end
+              else
+                p.dispid:=aclass.get_next_dispid;
             end;
 
       var

compiler/symdef.pas

@@ -235,6 +235,8 @@ interface
        pmvcallstaticinfo = ^tmvcallstaticinfo;
        tmvcallstaticinfo = array[0..1024*1024-1] of tvmcallstatic;
        tobjectdef = class(tabstractrecorddef)
+       private
+          fcurrent_dispid: longint;
        public
           dwarf_struct_lab : tasmsymbol;
           childof        : tobjectdef;
@@ -301,6 +303,8 @@ interface
           function FindDestructor : tprocdef;
           function implements_any_interfaces: boolean;
           procedure reset; override;
+          { dispinterface support }
+          function get_next_dispid: longint;
           { enumerator support }
           function search_enumerator_get: tprocdef;
           function search_enumerator_move: tprocdef;
@@ -3792,6 +3796,7 @@ implementation
    constructor tobjectdef.create(ot : tobjecttyp;const n : string;c : tobjectdef);
      begin
         inherited create(objectdef);
+        fcurrent_dispid:=0;
         objecttype:=ot;
         objectoptions:=[];
         childof:=nil;
@@ -4553,6 +4558,12 @@ implementation
         classref_created_in_current_module:=false;
       end;
 
+    function tobjectdef.get_next_dispid: longint;
+      begin
+        inc(fcurrent_dispid);
+        result:=fcurrent_dispid;
+      end;
+
     function tobjectdef.search_enumerator_get: tprocdef;
      var
         objdef : tobjectdef;

tests/test/tdispinterface2.pp

@@ -0,0 +1,44 @@
+{ %TARGET=win32,win64,wince}
+
+program tdispinterface2;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+
+  { IIE }
+
+  IIE = dispinterface
+    ['{0002DF05-0000-0000-C000-000000000046}']
+    procedure Disp300; dispid 300;
+    property Disp1: integer;
+    procedure Disp2;
+    property Disp402: wordbool dispid 402;
+  end;
+
+var
+  cur_dispid: longint;
+
+{$HINTS OFF}
+procedure DoDispCallByID(res : Pointer; const disp : IDispatch;desc : PDispDesc; params : Pointer);
+begin
+  if desc^.dispid <> cur_dispid then
+    halt(cur_dispid);
+end;
+{$HINTS ON}
+
+var
+  II: IIE;
+begin
+  DispCallByIDProc := @DoDispCallByID;
+  cur_dispid := 300;
+  II.Disp300;
+  cur_dispid := 1;
+  II.Disp1 := 1;
+  cur_dispid := 2;
+  II.Disp2;
+  cur_dispid := 402;
+  II.Disp402 := True;
+end.