compiler: fix compiler crash (bug #0018222)

  - 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 -

.gitattributes

@@ -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

compiler/pdecl.pas

@@ -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;

compiler/symdef.pas

@@ -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

tests/webtbs/tw18222.pp

@@ -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.