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

* fixed inlinetree parsing in det_resulttype

Browse Source
This commit is contained in:
peter 2002-11-27 02:31:17 +00:00
parent 2b6e06bd4a
commit 1ba12c259e
1 changed files with 70 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
compiler/ncal.pas
View File

@ -168,7 +168,7 @@ type
objinfo : tobjectdef; objinfo : tobjectdef;
constructor create(def : tobjectdef); constructor create(def : tobjectdef);
end; end;
{**************************************************************************** {****************************************************************************
HELPERS HELPERS
@ -865,8 +865,8 @@ type
{ If this is an abstract method insert into the list } { If this is an abstract method insert into the list }
if (po_abstractmethod in hp.procoptions) then if (po_abstractmethod in hp.procoptions) then
AbstractMethodsList.Insert(hp.procsym.name) AbstractMethodsList.Insert(hp.procsym.name)
else else
{ If this symbol is already in the list, and it is { If this symbol is already in the list, and it is
an overriding method or dynamic, then remove it from the list an overriding method or dynamic, then remove it from the list
} }
begin begin
@ -876,7 +876,7 @@ type
if po_overridingmethod in hp.procoptions then if po_overridingmethod in hp.procoptions then
AbstractMethodsList.Remove(hp.procsym.name); AbstractMethodsList.Remove(hp.procsym.name);
end; end;
end; end;
end; end;
end; end;
@ -894,30 +894,30 @@ type
objectdf := nil; objectdf := nil;
{ verify if trying to create an instance of a class which contains { verify if trying to create an instance of a class which contains
non-implemented abstract methods } non-implemented abstract methods }
{ first verify this class type, no class than exit } { first verify this class type, no class than exit }
{ also, this checking can only be done if the constructor is directly { also, this checking can only be done if the constructor is directly
called, indirect constructor calls cannot be checked. called, indirect constructor calls cannot be checked.
} }
if assigned(methodpointer) and assigned(methodpointer.resulttype.def) then if assigned(methodpointer) and assigned(methodpointer.resulttype.def) then
if (methodpointer.resulttype.def.deftype = classrefdef) and if (methodpointer.resulttype.def.deftype = classrefdef) and
(methodpointer.nodetype in [typen,loadvmtn]) then (methodpointer.nodetype in [typen,loadvmtn]) then
begin begin
if (tclassrefdef(methodpointer.resulttype.def).pointertype.def.deftype = objectdef) then if (tclassrefdef(methodpointer.resulttype.def).pointertype.def.deftype = objectdef) then
objectdf := tobjectdef(tclassrefdef(methodpointer.resulttype.def).pointertype.def); objectdf := tobjectdef(tclassrefdef(methodpointer.resulttype.def).pointertype.def);
end; end;
if not assigned(objectdf) then exit; if not assigned(objectdf) then exit;
if assigned(objectdf.symtable.name) then if assigned(objectdf.symtable.name) then
_classname := objectdf.symtable.name^ _classname := objectdf.symtable.name^
else else
_classname := ''; _classname := '';
parents := tlinkedlist.create; parents := tlinkedlist.create;
AbstractMethodsList := tstringlist.create; AbstractMethodsList := tstringlist.create;
{ insert all parents in this class : the first item in the { insert all parents in this class : the first item in the
list will be the base parent of the class . list will be the base parent of the class .
} }
while assigned(objectdf) do while assigned(objectdf) do
begin begin
@ -925,7 +925,7 @@ type
parents.insert(objectinfo); parents.insert(objectinfo);
objectdf := objectdf.childof; objectdf := objectdf.childof;
end; end;
{ now all parents are in the correct order { now all parents are in the correct order
insert all abstract methods in the list, and remove insert all abstract methods in the list, and remove
those which are overriden by parent classes. those which are overriden by parent classes.
} }
@ -944,9 +944,9 @@ type
while assigned(stritem) do while assigned(stritem) do
begin begin
if assigned(stritem.fpstr) then if assigned(stritem.fpstr) then
Message2(type_w_instance_with_abstract,lower(_classname),lower(stritem.fpstr^)); Message2(type_w_instance_with_abstract,lower(_classname),lower(stritem.fpstr^));
stritem := tstringlistitem(stritem.next); stritem := tstringlistitem(stritem.next);
end; end;
if assigned(AbstractMethodsList) then if assigned(AbstractMethodsList) then
AbstractMethodsList.Free; AbstractMethodsList.Free;
end; end;
@ -2756,15 +2756,64 @@ type
function tprocinlinenode.det_resulttype : tnode; function tprocinlinenode.det_resulttype : tnode;
var
storesymtablelevel : longint;
storeparasymtable,
storelocalsymtable : tsymtabletype;
oldprocdef : tprocdef;
oldprocinfo : tprocinfo;
oldinlining_procedure : boolean;
begin begin
result:=nil;
oldinlining_procedure:=inlining_procedure;
oldprocdef:=aktprocdef;
oldprocinfo:=procinfo;
{ we're inlining a procedure }
inlining_procedure:=true;
aktprocdef:=inlineprocdef;
{ clone procinfo, but not the asmlists }
procinfo:=tprocinfo(cprocinfo.newinstance);
move(pointer(oldprocinfo)^,pointer(procinfo)^,cprocinfo.InstanceSize);
procinfo.aktentrycode:=nil;
procinfo.aktexitcode:=nil;
procinfo.aktproccode:=nil;
procinfo.aktlocaldata:=nil;
{ set new procinfo }
procinfo.return_offset:=retoffset;
procinfo.para_offset:=para_offset;
procinfo.no_fast_exit:=false;
{ set it to the same lexical level }
storesymtablelevel:=aktprocdef.localst.symtablelevel;
storelocalsymtable:=aktprocdef.localst.symtabletype;
storeparasymtable:=aktprocdef.parast.symtabletype;
aktprocdef.localst.symtablelevel:=oldprocdef.localst.symtablelevel;
aktprocdef.localst.symtabletype:=inlinelocalsymtable;
aktprocdef.parast.symtabletype:=inlineparasymtable;
{ pass inlinetree }
resulttypepass(inlinetree);
resulttype:=inlineprocdef.rettype; resulttype:=inlineprocdef.rettype;
{ retrieve info from inlineprocdef } { retrieve info from inlineprocdef }
retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) } retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) }
para_offset:=0; para_offset:=0;
para_size:=inlineprocdef.para_size(target_info.alignment.paraalign); para_size:=inlineprocdef.para_size(target_info.alignment.paraalign);
if paramanager.ret_in_param(inlineprocdef.rettype.def,inlineprocdef.proccalloption) then if paramanager.ret_in_param(inlineprocdef.rettype.def,inlineprocdef.proccalloption) then
inc(para_size,POINTER_SIZE); inc(para_size,POINTER_SIZE);
result:=nil;
{ restore procinfo }
procinfo.free;
procinfo:=oldprocinfo;
{ restore symtable }
aktprocdef.localst.symtablelevel:=storesymtablelevel;
aktprocdef.localst.symtabletype:=storelocalsymtable;
aktprocdef.parast.symtabletype:=storeparasymtable;
{ restore }
aktprocdef:=oldprocdef;
inlining_procedure:=oldinlining_procedure;
end; end;
@ -2795,7 +2844,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.110 2002-11-25 18:43:32 carl Revision 1.111 2002-11-27 02:31:17 peter
* fixed inlinetree parsing in det_resulttype
Revision 1.110 2002/11/25 18:43:32 carl
- removed the invalid if <> checking (Delphi is strange on this) - removed the invalid if <> checking (Delphi is strange on this)
+ implemented abstract warning on instance creation of class with + implemented abstract warning on instance creation of class with
abstract methods. abstract methods.