Browse Source

Merged revisions 7448 via svnmerge from
http://svn.freepascal.org/svn/fpc/trunk

........
r7448 | yury | 2007-05-24 11:15:28 +0300 (Чт, 24 май 2007) | 2 lines

* fixed bug #8919.
+ test.
........

git-svn-id: branches/fixes_2_2@7463 -

yury 18 years ago
parent
commit
b5a3777c01
3 changed files with 36 additions and 1 deletions
  1. 1 0
      .gitattributes
  2. 2 1
      compiler/nbas.pas
  3. 33 0
      tests/webtbs/tw8919.pp

+ 1 - 0
.gitattributes

@@ -8107,6 +8107,7 @@ tests/webtbs/tw8847.pp svneol=native#text/plain
 tests/webtbs/tw8861.pp svneol=native#text/plain
 tests/webtbs/tw8870.pp svneol=native#text/plain
 tests/webtbs/tw8883.pp svneol=native#text/plain
+tests/webtbs/tw8919.pp svneol=native#text/plain
 tests/webtbs/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 2 - 1
compiler/nbas.pas

@@ -648,7 +648,8 @@ implementation
           { no init/final needed }
           not (_typedef.needs_inittable) and
           ((_typedef.typ <> pointerdef) or
-           (not tpointerdef(_typedef).pointeddef.needs_inittable));
+           (is_object(tpointerdef(_typedef).pointeddef) or
+            not tpointerdef(_typedef).pointeddef.needs_inittable));
       end;
 
     constructor ttempcreatenode.create_withnode(_typedef: tdef; _size: aint; _temptype: ttemptype; allowreg:boolean; withnode: tnode);

+ 33 - 0
tests/webtbs/tw8919.pp

@@ -0,0 +1,33 @@
+
+{$mode delphi}
+
+type
+  TOnProc = procedure of object;
+
+  PMyObj = ^TMyObj;
+  TMyObj = object
+  private
+    FOnProc: TOnProc;
+
+    s: ansistring;
+  public
+    property OnProc: TOnProc read FOnProc write FOnProc;
+    procedure Proc;
+  end;
+
+procedure TMyObj.Proc;
+begin
+end;
+
+var
+  obj: PMyObj;
+
+begin
+  New(obj);
+  obj^.OnProc:=obj^.Proc;
+  if TMethod(obj^.OnProc).Data <> obj then begin
+    writeln('Test FAILED!');
+    Halt(1);
+  end;
+  writeln('Test OK!');
+end.