* ReadOnly DispID property (bug 30780)

git-svn-id: trunk@34878 -

packages/fcl-passrc/src/pastree.pp

@@ -775,6 +775,7 @@ type
     Args: TFPList;        // List of TPasArgument objects
     ReadAccessorName, WriteAccessorName, ImplementsName,
       StoredAccessorName: string;
+    DispIDReadOnly,
     IsDefault, IsNodefault: Boolean;
     property IsClass: boolean read GetIsClass write SetIsClass;
     Function ResolvedType : TPasType;

packages/fcl-passrc/src/pparser.pp

@@ -3636,6 +3636,11 @@ begin
       Result.WriteAccessorName := GetAccessorName(Result,Result.WriteAccessor);
       NextToken;
       end;
+    if CurTokenIsIdentifier('READONLY') then
+      begin
+      Result.DispIDReadOnly:=True;
+      NextToken;
+      end;
     if CurTokenIsIdentifier('DISPID') then
       begin
       NextToken;

packages/fcl-passrc/tests/tcclasstype.pas

@@ -151,6 +151,7 @@ type
     procedure TestInterfaceOneMethod;
     procedure TestInterfaceProperty;
     procedure TestInterfaceDispProperty;
+    procedure TestInterfaceDispPropertyReadOnly;
     procedure TestInterfaceNoConstructor;
     procedure TestInterfaceNoDestructor;
     procedure TestInterfaceNoFields;
@@ -1647,6 +1648,23 @@ begin
   AssertEquals('Have number','1', (Property1.DispIDExpr as TPrimitiveExpr).Value);
 end;
 
+procedure TTestClassType.TestInterfaceDispPropertyReadOnly;
+begin
+  StartInterface('IInterface','',True);
+  AddMember('Property S : Integer readonly DispID 1');
+  EndClass();
+  ParseClass;
+  AssertEquals('Is interface',okDispInterface,TheClass.ObjKind);
+  if TheClass.members.Count<1 then
+    Fail('No members for method');
+  AssertNotNull('Have property',Property1);
+  AssertMemberName('S',Property1);
+  AssertNotNull('Have property dispID',Property1.DispIDExpr);
+  AssertTrue('DispID property is readonly',Property1.DispIDReadOnly);
+  AssertEquals('Have number',pekNumber,Property1.DispIDExpr.Kind);
+  AssertEquals('Have number','1', (Property1.DispIDExpr as TPrimitiveExpr).Value);
+end;
+
 procedure TTestClassType.TestInterfaceNoConstructor;
 begin
   StartInterface('','');