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

compiler: fix compiler crash (bug #0018222)

Browse Source 
- don't use source pointeddef for copied tpointerdef,tclassrefdef if pointteddef is a forward def because in this case when forward def will be resolved copied def will point to garbage
  - put copied def into list of defs awaiting resolve if it was copied from forward def
  + test

git-svn-id: trunk@16575 -
This commit is contained in:
paul 2010-12-17 07:50:47 +00:00
parent d1026bb052
commit 54b5172286
4 changed files with 162 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10910,6 +10910,7 @@ tests/webtbs/tw18123.pp svneol=native#text/pascal
tests/webtbs/tw18127.pp svneol=native#text/pascal
tests/webtbs/tw18131.pp svneol=native#text/pascal
tests/webtbs/tw1820.pp svneol=native#text/plain
tests/webtbs/tw18222.pp svneol=native#text/pascal
tests/webtbs/tw1825.pp svneol=native#text/plain
tests/webtbs/tw1850.pp svneol=native#text/plain
tests/webtbs/tw1851.pp svneol=native#text/plain

3
compiler/pdecl.pas
View File

@ -558,6 +558,9 @@ implementation
end;
include(hdef.defoptions,df_unique);
if (hdef.typ in [pointerdef,classrefdef]) and
(tabstractpointerdef(hdef).pointeddef.typ=forwarddef) then
current_module.checkforwarddefs.add(hdef);
end;
if not assigned(hdef.typesym) then
hdef.typesym:=newtype;

38
compiler/symdef.pas
View File

@ -129,9 +129,10 @@ interface
tforwarddef = class(tstoreddef)
tosymname : pshortstring;
forwardpos : tfileposinfo;
constructor create(const s:string;const pos : tfileposinfo);
constructor create(const s:string;const pos:tfileposinfo);
destructor destroy;override;
function GetTypeName:string;override;
function getcopy:tstoreddef;override;
function GetTypeName:string;override;
end;
tundefineddef = class(tstoreddef)
@ -162,7 +163,7 @@ interface
is_far : boolean;
constructor create(def:tdef);
constructor createfar(def:tdef);
function getcopy : tstoreddef;override;
function getcopy:tstoreddef;override;
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
function GetTypeName:string;override;
@ -333,9 +334,10 @@ interface
constructor create(def:tdef);
constructor ppuload(ppufile:tcompilerppufile);
procedure ppuwrite(ppufile:tcompilerppufile);override;
function GetTypeName:string;override;
function is_publishable : boolean;override;
function rtti_mangledname(rt:trttitype):string;override;
function getcopy:tstoreddef;override;
function GetTypeName:string;override;
function is_publishable : boolean;override;
function rtti_mangledname(rt:trttitype):string;override;
procedure register_created_object_type;override;
end;
@ -2101,7 +2103,13 @@ implementation
function tpointerdef.getcopy : tstoreddef;
begin
result:=tpointerdef.create(pointeddef);
{ don't use direct pointeddef if it is a forwarddef because in other case
one of them will be destroyed on forward type resolve and the second will
point to garbage }
if pointeddef.typ=forwarddef then
result:=tpointerdef.create(tforwarddef(pointeddef).getcopy)
else
result:=tpointerdef.create(pointeddef);
tpointerdef(result).is_far:=is_far;
tpointerdef(result).savesize:=savesize;
end;
@ -2147,6 +2155,16 @@ implementation
end;
function tclassrefdef.getcopy:tstoreddef;
begin
if pointeddef.typ=forwarddef then
result:=tclassrefdef.create(tforwarddef(pointeddef).getcopy)
else
result:=tclassrefdef.create(pointeddef);
tclassrefdef(result).savesize:=savesize;
end;
function tclassrefdef.GetTypeName : string;
begin
GetTypeName:='Class Of '+pointeddef.typename;
@ -5236,7 +5254,7 @@ implementation
TFORWARDDEF
****************************************************************************}
constructor tforwarddef.create(const s:string;const pos : tfileposinfo);
constructor tforwarddef.create(const s:string;const pos:tfileposinfo);
begin
inherited create(forwarddef);
tosymname:=stringdup(s);
@ -5256,6 +5274,10 @@ implementation
inherited destroy;
end;
function tforwarddef.getcopy:tstoreddef;
begin
result:=tforwarddef.create(tosymname^, forwardpos);
end;
{****************************************************************************
TUNDEFINEDDEF

128
tests/webtbs/tw18222.pp Normal file
View File

@ -0,0 +1,128 @@
{ %norun }
program tw18222;
{$mode objfpc}{$H-}
uses sysutils;
type
TFoo = class
public
FooValue: Integer;
end;
PFoo = ^TFoo;
PFooTyped = type PFoo;
PPFoo = ^PFoo;
TFooClass = Class of TFoo;
PFooClass = ^TFooClass;
PPFooClass = ^PFooClass;
TMyAnsiString = AnsiString;
TMyOwnAnsiString = type AnsiString;
procedure FooFunc(
ArgAnsiString1: AnsiString; var ArgAnsiString2: AnsiString; const ArgAnsiString3: AnsiString;
ArgPAnsiString1: PAnsiString; var ArgPAnsiString2: PAnsiString; const ArgPAnsiString3: PAnsiString;
ArgChar1: Char; var ArgChar2: Char; const ArgChar3: Char;
ArgPChar1: PChar; var ArgPChar2: PChar; const ArgPChar3: PChar;
ArgQW1, ArgQW2: QWord;
Foo1, Foo1n: TFoo; var Foo2, Foo2n: TFoo;
pFoo1, pFoo1n: PFoo; var pFoo2, pFoo2n: PFoo;
FooClass1, FooClass1n: TFooClass; var FooClass2, FooClass2n: TFooClass;
pFooClass1, pFooClass1n: PFooClass; var pFooClass2, pFooClass2n: PFooClass
);
var
TestInt: Integer;
TesTShortString: String[10];
TestAnsiString: AnsiString;
TestMyAnsiString: TMyAnsiString;
TestMyOwnAnsiString: TMyOwnAnsiString;
TestPChar: PChar;
TestQW1: QWord;
TestQW2: QWord;
TestPPFoo: PPFoo;
//TestPFooTyped: PFooTyped;
TestPPFooClass: PPFooClass;
function SubFoo(var AVal1: Integer; AVal2: Integer) : Integer;
begin
AVal1 := 2 * AVal2;
Result := AVal2;
inc(AVal2); // First BreakBoint
end;
begin
TestInt := 3;
TesTShortString := IntToStr(TestInt) + ':';
TestAnsiString := TesTShortString + ' Foo';
TestMyAnsiString := TesTShortString + ' FooMy';
TestMyOwnAnsiString := TesTShortString + ' FooMyOwn';
TestPChar := @TestAnsiString[2];
TestQw1 := ArgQw1 + 1; dec(TestQW1);
TestQw2 := ArgQw2 + 1; dec(TestQW2);
TestPPFoo := @pFoo1;
TestPPFooClass := @pFooClass1;
SubFoo(TestInt, 5);
// access all values, so the will not be optimized away
writeln(TestPChar);
// params
writeln(ArgAnsiString1, ArgAnsiString2, ArgAnsiString3, ArgChar1, ArgChar2, ArgChar3); // breakpoint 2
writeln(ArgQw1, ArgQw1, TestQW1, TestQW2);
if (Foo1 is FooClass1) and (Foo2 is FooClass2) and (Foo1n = Foo2n) and (FooClass1 = FooClass2) then
writeln(Foo1.FooValue + foo2.FooValue);
end;
var
a1, a2, a3: ansistring;
a2p: PAnsiString;
c1, c2, c3: Char;
c2p: PChar;
f1, f2, fn: TFoo;
f1p, fnp: PFoo;
fc, fcn: TFooclass;
fcp, fcnp: PFooClass;
begin
a1 := 'abc'; a2 := 'def'; a3 := 'ghi';
a2p := @a2;
c1 := 'X'; c2 := 'Y'; c2 := 'Z';
c2p := @c2;
f1 := TFoo.Create;
f2 := TFoo.Create;
fn := nil;
f1p := @f1;
fnp := @fn;
fc := TFoo;
fcn := nil;
fcp := @fc;
fcnp := @fcp;
FooFunc(
a1, a2, a3,
@a1, a2p, @a3,
c1, c2, c3,
@c1, c2p, @c3,
//ArgQW1, ArgQW2: QWord;
139784704, 139784871,
//Foo1, Foo1n: TFoo; var Foo2, Foo2n: TFoo
f1, nil, f2, fn,
f1p, nil, f1p, fnp,
//FooClass1, FooClass1n: TFooclass; var FooClass2, FooClass2n: TFoo
TFoo, nil, fc, fcn,
fcp, nil, fcp, fcnp
);
FreeAndNil(f1);
FreeAndNil(f2);
end.