소스 검색

* fixed internal error when a subscripted object is used in a property
(mantis #12756)

git-svn-id: trunk@12956 -

Jonas Maebe 16 년 전
부모
커밋
624a7be9b1
3개의 변경된 파일28개의 추가작업 그리고 1개의 파일을 삭제
  1. 1 0
      .gitattributes
  2. 3 1
      compiler/ncgrtti.pas
  3. 24 0
      tests/webtbs/tw12756.pp

+ 1 - 0
.gitattributes

@@ -8777,6 +8777,7 @@ tests/webtbs/tw12614.pp svneol=native#text/plain
 tests/webtbs/tw12685.pp svneol=native#text/plain
 tests/webtbs/tw1269.pp svneol=native#text/plain
 tests/webtbs/tw1275.pp svneol=native#text/plain
+tests/webtbs/tw12756.pp svneol=native#text/plain
 tests/webtbs/tw12788.pp svneol=native#text/plain
 tests/webtbs/tw1279.pp svneol=native#text/plain
 tests/webtbs/tw1283.pp svneol=native#text/plain

+ 3 - 1
compiler/ncgrtti.pas

@@ -271,7 +271,9 @@ implementation
                          end;
                        sl_subscript :
                          begin
-                           if not(assigned(def) and (def.typ=recorddef)) then
+                           if not(assigned(def) and
+                                  ((def.typ=recorddef) or
+                                   is_object(def))) then
                              internalerror(200402171);
                            inc(address,tfieldvarsym(hp^.sym).fieldoffset);
                            def:=tfieldvarsym(hp^.sym).vardef;

+ 24 - 0
tests/webtbs/tw12756.pp

@@ -0,0 +1,24 @@
+{$mode delphi}
+{$M+}
+
+type
+  TFooR = object { put "record" here and it works. }
+    Thing : integer;
+  end;
+  
+  TFoo = class
+  private
+    fRecord : TFooR;
+  published
+    property Thing : integer read fRecord.Thing;
+  end;
+
+var
+  fFoo : TFoo;
+begin
+  fFoo := TFoo.Create;
+  fFoo.fRecord.Thing:=123;
+  if (fFoo.Thing <> 123) then
+    halt(1);
+  fFoo.free;
+end.