浏览代码

* ignore is_publishable for properties in interfaces (related to $M+ directive). $M has effect on visibility of default section for classes. Interface has always only public section (fix for problem in tb0631.pp)

git-svn-id: trunk@37136 -
maciej-izak 8 年之前
父节点
当前提交
8b5524ac3a
共有 3 个文件被更改,包括 29 次插入1 次删除
  1. 1 0
      .gitattributes
  2. 5 1
      compiler/pdecvar.pas
  3. 23 0
      tests/tbs/tb0631.pp

+ 1 - 0
.gitattributes

@@ -11384,6 +11384,7 @@ tests/tbs/tb0627b.pp svneol=native#text/pascal
 tests/tbs/tb0628.pp svneol=native#text/pascal
 tests/tbs/tb0628.pp svneol=native#text/pascal
 tests/tbs/tb0629.pp svneol=native#text/pascal
 tests/tbs/tb0629.pp svneol=native#text/pascal
 tests/tbs/tb0630.pp svneol=native#text/pascal
 tests/tbs/tb0630.pp svneol=native#text/pascal
+tests/tbs/tb0631.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain
 tests/tbs/tb613.pp svneol=native#text/plain

+ 5 - 1
compiler/pdecvar.pas

@@ -498,8 +498,12 @@ implementation
                   message(parser_e_no_property_found_to_override);
                   message(parser_e_no_property_found_to_override);
                 end;
                 end;
            end;
            end;
+         { ignore is_publishable for interfaces (related to $M+ directive).
+           $M has effect on visibility of default section for classes. 
+           Interface has always only public section (fix for problem in tb0631.pp) }
          if ((p.visibility=vis_published) or is_dispinterface(astruct)) and
          if ((p.visibility=vis_published) or is_dispinterface(astruct)) and
-            (not(p.propdef.is_publishable) or (sp_static in p.symoptions)) then
+            ((not(p.propdef.is_publishable) and not is_interface(astruct)) or
+             (sp_static in p.symoptions)) then
            begin
            begin
              Message(parser_e_cant_publish_that_property);
              Message(parser_e_cant_publish_that_property);
              p.visibility:=vis_public;
              p.visibility:=vis_public;

+ 23 - 0
tests/tbs/tb0631.pp

@@ -0,0 +1,23 @@
+program tb0631;
+
+{$MODE DELPHI}
+
+uses
+  typinfo;
+
+type
+  {$M+}
+  IFoo = interface
+  ['{6AE439A1-06AA-460A-9CEB-71A1FD1BCFFB}']
+    procedure SetFoo(a: pointer);
+    property Foo: pointer write SetFoo;
+  end;
+
+begin
+  if PInterfaceData(TypInfo.GetTypeData(TypeInfo(IFoo)))^.PropertyTable^.Prop[0]^.PropType 
+    <> TypeInfo(Pointer) 
+  then
+    halt(1);
+  WriteLn('ok');
+end.
+