Переглянути джерело

* fix for Mantis #31107: disallow calling of ordinary record methods using the record's type.

git-svn-id: trunk@35113 -
svenbarth 8 роки тому
батько
коміт
22e579cc74
3 змінених файлів з 33 додано та 2 видалено
  1. 1 0
      .gitattributes
  2. 13 2
      compiler/pexpr.pas
  3. 19 0
      tests/webtbf/tw31107.pp

+ 1 - 0
.gitattributes

@@ -13772,6 +13772,7 @@ tests/webtbf/tw30022.pp svneol=native#text/plain
 tests/webtbf/tw3047.pp svneol=native#text/plain
 tests/webtbf/tw30494.pp svneol=native#text/pascal
 tests/webtbf/tw31016.pp svneol=native#text/pascal
+tests/webtbf/tw31107.pp svneol=native#text/pascal
 tests/webtbf/tw3114.pp svneol=native#text/plain
 tests/webtbf/tw3116.pp svneol=native#text/plain
 tests/webtbf/tw3126.pp svneol=native#text/plain

+ 13 - 2
compiler/pexpr.pas

@@ -1276,6 +1276,7 @@ implementation
     procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
       var
         isclassref:boolean;
+        isrecordtype:boolean;
       begin
          if sym=nil then
            begin
@@ -1295,9 +1296,13 @@ implementation
                  if not assigned(p1.resultdef) then
                    do_typecheckpass(p1);
                  isclassref:=(p1.resultdef.typ=classrefdef);
+                 isrecordtype:=(p1.nodetype=typen) and (p1.resultdef.typ=recorddef);
                end
               else
-                isclassref:=false;
+                begin
+                  isclassref:=false;
+                  isrecordtype:=false;
+                end;
 
               if assigned(spezcontext) and not (sym.typ=procsym) then
                 internalerror(2015091801);
@@ -1313,7 +1318,13 @@ implementation
                       { we need to know which procedure is called }
                       do_typecheckpass(p1);
                       { calling using classref? }
-                      if isclassref and
+                      if (
+                            isclassref or
+                            (
+                              isrecordtype and
+                              not (cnf_inherited in callflags)
+                            )
+                          ) and
                          (p1.nodetype=calln) and
                          assigned(tcallnode(p1).procdefinition) then
                         begin

+ 19 - 0
tests/webtbf/tw31107.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+program tw31107;
+
+{$MODE DELPHI}
+
+uses RTTI;
+
+type
+  TFoo = class
+  private
+    FBar: string;
+  public
+    property Bar: string read FBar;
+  end;
+
+begin
+  Writeln(Assigned(TRttiContext.GetType(TFoo).GetProperty('Bar')));
+end.