Browse Source

fcl-passrc: resolver: check property has read or write accessor,

git-svn-id: trunk@39025 -
Mattias Gaertner 7 years ago
parent
commit
1e6f23a72c

+ 2 - 1
packages/fcl-passrc/src/pasresolveeval.pas

@@ -120,7 +120,7 @@ const
   nExpectXArrayElementsButFoundY = 3047;
   nExpectXArrayElementsButFoundY = 3047;
   nCannotCreateADescendantOfTheSealedXY = 3048;
   nCannotCreateADescendantOfTheSealedXY = 3048;
   nAncestorIsNotExternal = 3049;
   nAncestorIsNotExternal = 3049;
-  // free 3050
+  nPropertyMustHaveReadOrWrite = 3050;
   nExternalClassInstanceCannotAccessStaticX = 3051;
   nExternalClassInstanceCannotAccessStaticX = 3051;
   nXModifierMismatchY = 3052;
   nXModifierMismatchY = 3052;
   nSymbolCannotBePublished = 3053;
   nSymbolCannotBePublished = 3053;
@@ -236,6 +236,7 @@ resourcestring
   sExpectXArrayElementsButFoundY = 'Expect %s array elements, but found %s';
   sExpectXArrayElementsButFoundY = 'Expect %s array elements, but found %s';
   sCannotCreateADescendantOfTheSealedXY = 'Cannot create a descendant of the sealed %s "%s"';
   sCannotCreateADescendantOfTheSealedXY = 'Cannot create a descendant of the sealed %s "%s"';
   sAncestorIsNotExternal = 'Ancestor "%s" is not external';
   sAncestorIsNotExternal = 'Ancestor "%s" is not external';
+  sPropertyMustHaveReadOrWrite = 'Property must have read or write accessor';
   sVirtualMethodXHasLowerVisibility = 'Virtual method "%s" has a lower visibility (%s) than parent class %s (%s)';
   sVirtualMethodXHasLowerVisibility = 'Virtual method "%s" has a lower visibility (%s) than parent class %s (%s)';
   sExternalClassInstanceCannotAccessStaticX = 'External class instance cannot access static %s';
   sExternalClassInstanceCannotAccessStaticX = 'External class instance cannot access static %s';
   sXModifierMismatchY = '%s modifier "%s" mismatch';
   sXModifierMismatchY = '%s modifier "%s" mismatch';

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

@@ -6018,7 +6018,9 @@ begin
         end
         end
       else
       else
         RaiseXExpectedButYFound(20170216151921,'variable',GetElementTypeName(AccEl),PropEl.WriteAccessor);
         RaiseXExpectedButYFound(20170216151921,'variable',GetElementTypeName(AccEl),PropEl.WriteAccessor);
-      end;
+      end
+    else if (PropEl.ReadAccessor=nil) and (PropEl.VarType<>nil) then
+      RaiseMsg(20180519173551,nPropertyMustHaveReadOrWrite,sPropertyMustHaveReadOrWrite,[],PropEl);
 
 
     if length(PropEl.Implements)>0 then
     if length(PropEl.Implements)>0 then
       CheckImplements;
       CheckImplements;
@@ -18447,8 +18449,11 @@ begin
         Include(ResolvedEl.Flags,rrfCanBeStatement);
         Include(ResolvedEl.Flags,rrfCanBeStatement);
       end
       end
     else
     else
-      // index property
+      begin
+      // index property without name
+      // Note: computing the pekArrayParams TParamsExpr will convert this to the type
       SetResolverIdentifier(ResolvedEl,btContext,El,nil,nil,[]);
       SetResolverIdentifier(ResolvedEl,btContext,El,nil,nil,[]);
+      end;
     end
     end
   else if ElClass=TPasArgument then
   else if ElClass=TPasArgument then
     begin
     begin

+ 14 - 1
packages/fcl-passrc/tests/tcresolver.pas

@@ -596,6 +596,7 @@ type
     // property
     // property
     Procedure TestProperty1;
     Procedure TestProperty1;
     Procedure TestPropertyAccessorNotInFront;
     Procedure TestPropertyAccessorNotInFront;
+    Procedure TestPropertyReadAndWriteMissingFail;
     Procedure TestPropertyReadAccessorVarWrongType;
     Procedure TestPropertyReadAccessorVarWrongType;
     Procedure TestPropertyReadAccessorProcNotFunc;
     Procedure TestPropertyReadAccessorProcNotFunc;
     Procedure TestPropertyReadAccessorFuncWrongResult;
     Procedure TestPropertyReadAccessorFuncWrongResult;
@@ -10157,6 +10158,18 @@ begin
   CheckResolverException('identifier not found "FB"',nIdentifierNotFound);
   CheckResolverException('identifier not found "FB"',nIdentifierNotFound);
 end;
 end;
 
 
+procedure TTestResolver.TestPropertyReadAndWriteMissingFail;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    property B: longint;',
+  '  end;',
+  'begin']);
+  CheckResolverException(sPropertyMustHaveReadOrWrite,nPropertyMustHaveReadOrWrite);
+end;
+
 procedure TTestResolver.TestPropertyReadAccessorVarWrongType;
 procedure TTestResolver.TestPropertyReadAccessorVarWrongType;
 begin
 begin
   StartProgram(false);
   StartProgram(false);
@@ -10625,7 +10638,7 @@ begin
   Add('end;');
   Add('end;');
   Add('var Obj: tobject;');
   Add('var Obj: tobject;');
   Add('begin');
   Add('begin');
-  Add('  obj.Items[3]:=4;');
+  Add('  obj.Items[3]:=''4'';');
   CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "String"',
   CheckResolverException('Incompatible type arg no. 1: Got "Longint", expected "String"',
     nIncompatibleTypeArgNo);
     nIncompatibleTypeArgNo);
 end;
 end;