mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 10:19:30 +02:00
Added iioffset/fieldoffset code for _IMPLEMENTS
git-svn-id: trunk@4357 -
This commit is contained in:
parent
849878b472
commit
037fd46699
@ -221,6 +221,7 @@ implementation
|
||||
sc : TFPObjectList;
|
||||
paranr : word;
|
||||
i : longint;
|
||||
intfidx: longint;
|
||||
hreadparavs,
|
||||
hparavs : tparavarsym;
|
||||
readprocdef,
|
||||
@ -599,9 +600,28 @@ implementation
|
||||
end;
|
||||
if pattern <> p.proptype.def.mangledparaname() then
|
||||
begin
|
||||
writeln('Implements-property must implement interface of same type');
|
||||
writeln('Implements-property must implement interface of correct type');
|
||||
Message1(sym_e_illegal_field, pattern);
|
||||
end;
|
||||
intfidx := 0;
|
||||
with aclass.implementedinterfaces do
|
||||
begin
|
||||
for i := 1 to count do
|
||||
if interfaces(i).objname^ = pattern then
|
||||
begin
|
||||
intfidx := i;
|
||||
break;
|
||||
end;
|
||||
if intfidx > 0 then
|
||||
begin
|
||||
interfaces(intfidx).iitype := etFieldValue;
|
||||
interfaces(intfidx).iioffset := tfieldvarsym(p.readaccess.firstsym^.sym).fieldoffset;
|
||||
end else
|
||||
begin
|
||||
writeln('Implements-property used on unimplemented interface');
|
||||
Message1(sym_e_illegal_field, pattern);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ remove temporary procvardefs }
|
||||
|
Loading…
Reference in New Issue
Block a user