Browse Source

fcl-passrc: store access type of accessing default property

git-svn-id: trunk@35708 -
Mattias Gaertner 8 years ago
parent
commit
4e0fd4de53

+ 7 - 3
packages/fcl-passrc/src/pasresolver.pp

@@ -5143,6 +5143,9 @@ begin
         // class has default property
         if (ResolvedEl.IdentEl is TPasType) and (not PropEl.IsClass) then
           RaiseMsg(20170216152213,nIllegalQualifier,sIllegalQualifier,['['],Params);
+        if Params.Value.CustomData is TResolvedReference then
+          TResolvedReference(Params.Value.CustomData).Access:=rraRead;
+        CreateReference(PropEl,Params,Access);
         CheckCallPropertyCompatibility(PropEl,Params,true);
         FinishPropertyParamAccess(PropEl);
         exit;
@@ -9316,7 +9319,7 @@ begin
     exit(cExact);
 
   {$IFDEF VerbosePasResolver}
-  writeln('TPasResolver.CheckCustomTypeCompatibility LTypeEl=',GetObjName(LTypeEl),' RTypeEl=',GetObjName(RTypeEl));
+  writeln('TPasResolver.CheckAssignCompatibilityUserType LTypeEl=',GetObjName(LTypeEl),' RTypeEl=',GetObjName(RTypeEl));
   {$ENDIF}
   Result:=-1;
   if LTypeEl.ClassType=TPasClassType then
@@ -9371,7 +9374,7 @@ begin
   else if LTypeEl.ClassType=TPasArrayType then
     begin
     // arrays of different types
-    if IsOpenArray(LTypeEl) then
+    if IsOpenArray(LTypeEl) and (RTypeEl.ClassType=TPasArrayType) then
       begin
       LArray:=TPasArrayType(LTypeEl);
       RArray:=TPasArrayType(RTypeEl);
@@ -10446,7 +10449,8 @@ end;
 
 function TPasResolver.IsOpenArray(TypeEl: TPasType): boolean;
 begin
-  Result:=(TypeEl<>nil) and (TypeEl.ClassType=TPasArrayType)
+  Result:=(TypeEl<>nil)
+      and (TypeEl.ClassType=TPasArrayType)
       and (length(TPasArrayType(TypeEl).Ranges)=0)
       and (TypeEl.Parent<>nil)
       and (TypeEl.Parent.ClassType=TPasArgument);

+ 19 - 0
packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -99,6 +99,7 @@ type
     procedure TestWP_UnitFinalization;
     procedure TestWP_CallInherited;
     procedure TestWP_ProgramPublicDeclarations;
+    procedure TestWP_ClassDefaultProperty;
   end;
 
 implementation
@@ -1271,6 +1272,24 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_ClassDefaultProperty;
+begin
+  StartProgram(false);
+  Add('type');
+  Add('  {#tobject_used}TObject = class');
+  Add('    function {#getitems_notused}Getitems(Index: longint): string;');
+  Add('    procedure {#setitems_used}Setitems(Index: longint; Value: String);');
+  Add('    property {#items_used}Items[Index: longint]: string read GetItems write SetItems; default;');
+  Add('  end;');
+  Add('function TObject.Getitems(Index: longint): string; begin end;');
+  Add('procedure TObject.Setitems(Index: longint; Value: String); begin end;');
+  Add('var');
+  Add('  {#l_used}L: TObject;');
+  Add('begin');
+  Add('  L[0]:=''birdy'';');
+  AnalyzeWholeProgram;
+end;
+
 initialization
   RegisterTests([TTestUseAnalyzer]);