paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-11 18:11:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@14766 -
This commit is contained in:
paul 2010-01-22 02:46:03 +00:00
parent 29961c1b8c
commit bd6f1d7447
5 changed files with 66 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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

7
compiler/pdecobj.pas
View File

@ -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 }

4
compiler/pdecvar.pas
View File

@ -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

11
compiler/symdef.pas
View File

@ -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;

44
tests/test/tdispinterface2.pp Normal file
View File

@ -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.