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

* correctly deal with writing debug information in the Stabs writer for class

Browse Source 
hierarchies from other units that were compiled without debug information
    in case not all classes from the hierarchy are explicitly used
    (mantis #22495, #21503, #21259)

git-svn-id: trunk@21972 -
This commit is contained in:
Jonas Maebe 2012-07-26 14:27:10 +00:00
parent 1d09005542
commit df2eddd169
5 changed files with 121 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -10287,6 +10287,8 @@ tests/test/packages/fcl-db/tdb6.pp svneol=native#text/plain
tests/test/packages/fcl-db/toolsunit.pas svneol=native#text/plain
tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
tests/test/packages/fcl-xml/thtmlwriter.pp svneol=native#text/plain
tests/test/packages/fcl-xml/tw22495.pp svneol=native#text/plain
tests/test/packages/fcl-xml/uw22495.pp svneol=native#text/plain
tests/test/packages/hash/sha1test.pp svneol=native#text/plain
tests/test/packages/hash/tmdtest.pp svneol=native#text/plain
tests/test/packages/webtbs/tw10045.pp svneol=native#text/plain

28
compiler/dbgbase.pas
View File

@ -311,8 +311,32 @@ implementation
internalerror(200610053);
dbg_state_used:
appenddef(list,def);
else
internalerror(200610054);
dbg_state_queued:
begin
{ can happen in case an objectdef was used from another
unit that was compiled without debug info, and we are
using Stabs (which means that parent types have to be
written before child types). In this case, the child
objectdef will be queued and never written, because its
definition is not inside the current unit and hence will
not be encountered }
if def.typ<>objectdef then
internalerror(2012072401);
if not assigned(tobjectdef(def).childof) or
(tobjectdef(def).childof.dbg_state=dbg_state_written) then
appenddef(list,def)
else if tobjectdef(def).childof.dbg_state=dbg_state_queued then
deftowritelist.add(def)
else if tobjectdef(def).childof.dbg_state=dbg_state_used then
{ comes somewhere after the current def in the looplist
and will be written at that point, so we will have to
wait until the next iteration }
deftowritelist.add(def)
else
internalerror(2012072402);
end;
else
internalerror(200610054);
end;
end;
looplist.clear;

43
compiler/dbgstabs.pas
View File

@ -1038,22 +1038,23 @@ implementation
while assigned(anc.childof) do
begin
anc:=anc.childof;
if (anc.dbg_state=dbg_state_writing) then
{ happens in case a field of a parent is of the (forward }
{ defined) child type }
begin
{ We don't explicitly requeue it, but the fact that }
{ a child type was used in a parent before the child }
{ type was fully defined means that it was forward }
{ declared, and will still be encountered later (it }
{ cannot have been declared in another unit, because }
{ then this and that other unit would depend on }
{ eachother's interface) }
{ Setting the state to queued however allows us to }
{ get the def number already without an IE }
def.dbg_state:=dbg_state_queued;
exit;
end;
case anc.dbg_state of
dbg_state_writing:
{ happens in case a field of a parent is of the (forward
defined) child type
}
begin
{ We don't explicitly requeue it, but the fact that
a child type was used in a parent before the child
type was fully defined means that it was forward
declared, and will still be encountered later.
Setting the state to queued however allows us to
get the def number already without an IE
}
def.dbg_state:=dbg_state_queued;
break;
end;
end;
end;
appenddef(list,vmtarraytype);
if assigned(tobjectdef(def).ImplementedInterfaces) then
@ -1064,6 +1065,16 @@ implementation
while assigned(anc.childof) do
begin
anc:=anc.childof;
{ in case this is an object family declared in another unit
that was compiled without debug info, this ancestor may not
yet have a stabs number and not yet be added to defstowrite
-> take care of that now, while its dbg_state is still
dbg_state_unused in case the aforementioned things haven't
happened yet (afterwards it will become dbg_state_writing,
and then def_stab_number() won't do anything anymore because
it assumes it's already happened
}
def_stab_number(anc);
appenddef(list,anc);
if assigned(anc.ImplementedInterfaces) then
for i:=0 to anc.ImplementedInterfaces.Count-1 do

17
tests/test/packages/fcl-xml/tw22495.pp Normal file
View File

@ -0,0 +1,17 @@
{ %norun }
{ %cpu=i386,powerpc,arm,sparc,mips }
{ %opt=-gs }
{ Stabs is only supported for 32 bit targets }
{$mode objfpc}
program tw22495;
uses uw22495;
var cl:INode;
begin
end.

49
tests/test/packages/fcl-xml/uw22495.pp Normal file
View File

@ -0,0 +1,49 @@
{$mode objfpc}
unit uw22495;
interface
uses
DOM;
type
TNode = class;
INode = interface
['{DCE90E41-4D14-4BAE-9AFC-BA10FF643EA0}']
function GetChildNodes: TNode; // if you delete this line, then the error disappears
end;
TNode = class(TInterfacedObject, INode)
protected
function GetChildNodes: TNode;
function xxx:TDomNode; // if you do either of the next points, then the error disappears:
// - exchange this line with the next one, or
// - delete this procedure (along with its body), or
// - make this procedure public
function getOwnerDocument: TDOMDocument; // if you delete this procedure, then the error disappears
public
end;
implementation
{ TNode }
function TNode.GetChildNodes: TNode;
begin
Result:=nil;
end;
function TNode.xxx:TDomNode;
begin
Result:=nil;
end;
function TNode.getOwnerDocument:TDOMDocument;
begin
Result:=nil;
end;
end.