Browse Source

* fixed bug #8919.
+ test.

git-svn-id: trunk@7448 -

yury 18 years ago
parent
commit
cf19c0993a
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

@@ -8260,6 +8260,7 @@ tests/webtbs/tw8847.pp svneol=native#text/plain
 tests/webtbs/tw8861.pp svneol=native#text/plain
 tests/webtbs/tw8861.pp svneol=native#text/plain
 tests/webtbs/tw8870.pp svneol=native#text/plain
 tests/webtbs/tw8870.pp svneol=native#text/plain
 tests/webtbs/tw8883.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/ub1873.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/ub1883.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain
 tests/webtbs/uw0555.pp svneol=native#text/plain

+ 2 - 1
compiler/nbas.pas

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