paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-23 12:19:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

Added iioffset/fieldoffset code for _IMPLEMENTS

Browse Source 
git-svn-id: trunk@4357 -
This commit is contained in:
chrivers 2006-08-06 00:49:40 +00:00
parent 849878b472
commit 037fd46699
1 changed files with 21 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
compiler/pdecvar.pas
View File

@ -221,6 +221,7 @@ implementation
sc : TFPObjectList; sc : TFPObjectList;
paranr : word; paranr : word;
i : longint; i : longint;
intfidx: longint;
hreadparavs, hreadparavs,
hparavs : tparavarsym; hparavs : tparavarsym;
readprocdef, readprocdef,
@ -599,9 +600,28 @@ implementation
end; end;
if pattern <> p.proptype.def.mangledparaname() then if pattern <> p.proptype.def.mangledparaname() then
begin 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); Message1(sym_e_illegal_field, pattern);
end; 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; end;
{ remove temporary procvardefs } { remove temporary procvardefs }