paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-31 01:11:29 +01:00
Code Issues Packages Projects Releases Wiki Activity

* merged fix for bug #1365

Browse Source
This commit is contained in:
peter 2001-02-03 00:26:35 +00:00
parent 3f16b1b8c7
commit f005ab378d
1 changed files with 28 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
compiler/ptconst.pas
View File

@ -762,7 +762,8 @@ implementation
p.free;
end
{ for objects we allow it only if it doesn't contain a vmt }
else if (oo_has_vmt in pobjectdef(def)^.objectoptions) then
else if (oo_has_vmt in pobjectdef(def)^.objectoptions) and
not(m_tp in aktmodeswitches) then
Message(parser_e_type_const_not_possible)
else
begin
@ -798,6 +799,18 @@ implementation
if pvarsym(srsym)^.address<aktpos then
Message(parser_e_invalid_record_const);
{ check in VMT needs to be added for TP mode }
if (m_tp in aktmodeswitches) and
(oo_has_vmt in pobjectdef(def)^.objectoptions) and
(pobjectdef(def)^.vmt_offset<pvarsym(srsym)^.address) then
begin
for i:=1 to pobjectdef(def)^.vmt_offset-aktpos do
curconstsegment.concat(tai_const.create_8bit(0));
curconstsegment.concat(tai_const_symbol.createname(pobjectdef(def)^.vmt_mangledname));
{ this is more general }
aktpos:=pobjectdef(def)^.vmt_offset + target_os.size_of_pointer;
end;
{ if needed fill }
if pvarsym(srsym)^.address>aktpos then
for i:=1 to pvarsym(srsym)^.address-aktpos do
@ -814,6 +827,16 @@ implementation
else break;
end;
end;
if (m_tp in aktmodeswitches) and
(oo_has_vmt in pobjectdef(def)^.objectoptions) and
(pobjectdef(def)^.vmt_offset>=aktpos) then
begin
for i:=1 to pobjectdef(def)^.vmt_offset-aktpos do
curconstsegment.concat(tai_const.create_8bit(0));
curconstsegment.concat(tai_const_symbol.createname(pobjectdef(def)^.vmt_mangledname));
{ this is more general }
aktpos:=pobjectdef(def)^.vmt_offset + target_os.size_of_pointer;
end;
for i:=1 to def^.size-aktpos do
curconstSegment.concat(Tai_const.Create_8bit(0));
consume(_RKLAMMER);
@ -837,7 +860,10 @@ implementation
end.
{
$Log$
Revision 1.15 2000-12-25 00:07:28 peter
Revision 1.16 2001-02-03 00:26:35 peter
* merged fix for bug 1365
Revision 1.15 2000/12/25 00:07:28 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)