Codetools: Support constant array of records. Issue #23944, patch by Włodzimierz Bień.

components/codetools/customcodetool.pas

@@ -221,6 +221,7 @@ type
     procedure MoveCursorToNearestAtom(ACleanPos: integer);
     procedure MoveCursorToLastNodeAtom(ANode: TCodeTreeNode);
     function IsPCharInSrc(ACleanPos: PChar): boolean;
+    function GetPosPCharInSrc(ACleanPos: PChar): integer; // utility for debugging
 
     // read atoms
     procedure ReadNextAtom;
@@ -2490,6 +2491,18 @@ begin
   Result:=true;
 end;
 
+function TCustomCodeTool.GetPosPCharInSrc(ACleanPos: PChar): integer;
+var
+  p: PChar;
+begin
+  Result:=0;
+  if Src='' then exit;
+  p:=PChar(Src);
+  if p>ACleanPos then exit;
+  if ACleanPos>p+SrcLen then exit;
+  Result:= 1+integer(ACleanPos)-integer(p);
+end;
+
 procedure TCustomCodeTool.CreateChildNode(Desc: TCodeTreeNodeDesc);
 var NewNode: TCodeTreeNode;
 begin

components/codetools/finddeclarationtool.pas

@@ -4774,18 +4774,19 @@ var
   begin
     Result:=false;
     //debugln(['SearchInTypeOfVarConst ',ContextNode.Parent.DescAsString]);
-    if (ContextNode.Parent.Desc in [ctnConstDefinition,ctnVarDefinition])
-    and (Src[ContextNode.StartPos]='(') then
+    if (ContextNode.Parent.Desc in [ctnConstDefinition,ctnVarDefinition]) then
     begin
-      if FindIdentifierInTypeOfConstant(ContextNode.Parent,Params) then
-        Result:=CheckResult(true,false);
-    end else
-    if (ContextNode.Parent.Desc in [ctnConstDefinition,ctnVarDefinition]) and
-    (ContextNode.NextBrother<>nil) and
-    (Src[ContextNode.NextBrother.StartPos]='(') then
-    begin
-      if FindIdentifierInTypeOfConstant(ContextNode.Parent,Params) then
-        Result:=CheckResult(true,false);
+      if (Src[ContextNode.StartPos]='(') then
+      begin
+        if FindIdentifierInTypeOfConstant(ContextNode.Parent,Params) then
+          Result:=CheckResult(true,false);
+      end else
+      if (ContextNode.NextBrother<>nil) and
+      (Src[ContextNode.NextBrother.StartPos]='(') then
+      begin
+        if FindIdentifierInTypeOfConstant(ContextNode.Parent,Params) then
+          Result:=CheckResult(true,false);
+      end;
     end;
   end;
 
@@ -5448,7 +5449,7 @@ begin
             if SearchInGenericType(Params.IdentSpecializeNodeParamCount) then exit;
           // ctnGenericParams: skip here, it was searched before searching the ancestors
 
-          ctnIdentifier:
+          ctnIdentifier, ctnRangedArrayType:
             if (ContextNode.Parent.Desc in [ctnConstDefinition,ctnVarDefinition])
             then begin
               if ((ContextNode=ContextNode.Parent.LastChild) // simple const
@@ -9922,17 +9923,48 @@ var
   ExprType: TExpressionType;
   TypeParams: TFindDeclarationParams;
   OldInput: TFindDeclarationInput;
+
 begin
   Result:=false;
   //debugln(['TFindDeclarationTool.FindIdentifierInTypeOfConstant ',VarConstNode.DescAsString]);
   TypeNode:=VarConstNode.FirstChild;
   if TypeNode=nil then exit;
-  if TypeNode.Desc=ctnIdentifier then begin
+  if TypeNode.Desc in [ctnIdentifier, ctnRangedArrayType] then begin
     // resolve type
     //debugln(['TFindDeclarationTool.FindIdentifierInTypeOfConstant ']);
     TypeParams:=TFindDeclarationParams.Create(Params);
     try
-      TypeParams.ContextNode:=TypeNode;
+      if (TypeNode.Desc = ctnIdentifier) then begin
+        if (TypeNode.NextBrother<>nil) and (TypeNode.NextBrother.Desc=ctnConstant) then begin
+        // const/var a: TypeArrayOfRecords = ();
+          // find TypeArrayOfRecords
+          TypeParams.ContextNode:=TypeNode.Parent;
+          TypeParams.SetIdentifier(Self,nil,nil);
+          TypeParams.Flags:=fdfDefaultForExpressions;
+          ExprType:=FindExpressionTypeOfTerm(TypeNode.StartPos,-1,TypeParams,false);
+
+          if (ExprType.Desc=xtContext) then begin
+            if (ExprType.Context.Node.Desc=ctnRangedArrayType) then begin
+            // if an array found then switch context
+              TypeNode:=ExprType.Context.Node;
+              TypeParams.Clear;
+              TypeParams.ContextNode:=TypeNode;
+            end else
+            if (ExprType.Context.Node.Desc=ctnRecordType) then
+              // record = OK
+            else
+              exit;
+          end;
+        end else
+          TypeParams.ContextNode:=TypeNode;
+      end;
+      if (TypeNode.Desc = ctnRangedArrayType) then begin
+        // const/var a: array [0..1] of recordtype = ();
+        TypeParams.ContextNode:=TypeNode.Parent;
+        while (TypeNode<>nil) and (TypeNode.Desc = ctnRangedArrayType) do
+          TypeNode:=TypeNode.LastChild;
+      end;
+
       TypeParams.SetIdentifier(Self,nil,nil);
       TypeParams.Flags:=fdfDefaultForExpressions;
       ExprType:=FindExpressionTypeOfTerm(TypeNode.StartPos,-1,TypeParams,false);

components/codetools/pascalparsertool.pas

@@ -5010,6 +5010,8 @@ function TPascalParserTool.KeyWordFuncTypeArray: boolean;
 }
 
   function ReadElemType: boolean;
+  var
+    EndOfType: integer;
   begin
     if CurPos.Flag in [cafSemicolon,cafRoundBracketClose,cafEdgedBracketClose]
     then begin
@@ -5021,8 +5023,12 @@ function TPascalParserTool.KeyWordFuncTypeArray: boolean;
       if not UpAtomIs('OF') then
         SaveRaiseStringExpectedButAtomFound(20170425090708,'"of"');
       ReadNextAtom;
+      EndOfType:=CurPos.EndPos;
       Result:=ParseType(CurPos.StartPos);
-      CurNode.EndPos:=CurPos.StartPos;
+      if CurNode.Desc=ctnRangedArrayType then
+        CurNode.EndPos:=EndOfType // note: ParseType has different ending than ReadTillTypeEnd
+      else
+        CurNode.EndPos:=CurPos.StartPos;
       EndChildNode; // close array
     end;
   end;

components/codetools/tests/laztests/test_const_array_of_records.pas

@@ -0,0 +1,37 @@
+unit test_const_array_of_records;
+
+{$mode ObjFPC}
+
+interface
+
+type
+  TRec = record
+    One: Word;
+    Two: Word;
+  end;
+  aTRec = array [0..1] of TRec;
+const
+  cRec: aTRec = ((One: 111; Two: 222),
+    (One{5,9;19,14;6,15;7,18;6,19;8,21;6,22;7,23;6,24;11,32;24,32;7,34;20,34;26,35}: 1111;
+    Two: 2222));
+  bRec: array [0..1] of TRec =
+    ((One: 111; Two: 222),
+    (One: 1111; Two: 2222));
+  mRec: array [0..1,0..1] of TRec =
+    (((One: 111; Two: 222),
+    (One: 1111; Two: 2222)),
+    ((One: 111; Two: 222),
+    (One: 1111; Two: 2222)));
+var
+  Rec: TRec = (One: 111; Two: 222);
+  oRec: array of TRec;
+implementation
+
+begin
+  setlength(oRec,1);
+  oRec[0].One:=cRec[0].One;
+  oRec[0].Two:=bRec[0].Two;
+  Rec.One:=cRec[1].One;
+  oRec[0].Two:=mRec[0,0].One;
+end.
+