paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 21:49:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix bug ID #30759

Browse Source 
git-svn-id: trunk@35522 -
This commit is contained in:
michael 2017-03-04 17:38:04 +00:00
parent 9787c44c78
commit aa769348c0
2 changed files with 27 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
packages/fcl-passrc/src/pparser.pp
View File

@ -3737,6 +3737,17 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
ExpectToken(tkSquaredBraceClose); ExpectToken(tkSquaredBraceClose);
Result := Result + ']'; Result := Result + ']';
end; end;
repeat
NextToken;
if CurToken <> tkDot then
begin
UngetToken;
break;
end;
ExpectIdentifier;
Result := Result + '.' + CurTokenString;
AddToBinaryExprChain(Expr,Last,CreatePrimitiveExpr(aParent,pekIdent,CurTokenString),eopSubIdent);
until false;
end; end;
var var

16
packages/fcl-passrc/tests/tcclasstype.pas
View File

@ -139,6 +139,7 @@ type
Procedure TestPropertyImplements; Procedure TestPropertyImplements;
Procedure TestPropertyImplementsFullyQualifiedName; Procedure TestPropertyImplementsFullyQualifiedName;
Procedure TestPropertyReadFromRecordField; Procedure TestPropertyReadFromRecordField;
procedure TestPropertyReadFromArrayField;
procedure TestPropertyReadWriteFromRecordField; procedure TestPropertyReadWriteFromRecordField;
Procedure TestLocalSimpleType; Procedure TestLocalSimpleType;
Procedure TestLocalSimpleTypes; Procedure TestLocalSimpleTypes;
@ -1463,6 +1464,21 @@ begin
Assertequals('Default value','',Property1.DefaultValue); Assertequals('Default value','',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestPropertyReadFromArrayField;
begin
StartVisibility(visPublished);
AddMember('Property Something : Integer Read FPoint.W[x].y.Z');
ParseClass;
AssertProperty(Property1,visPublished,'Something','FPoint.W[x].y.Z','','','',0,False,False);
AssertNotNull('Have type',Property1.VarType);
AssertEquals('Property type class type',TPasUnresolvedTypeRef,Property1.vartype.ClassType);
AssertEquals('Property type name','Integer',Property1.vartype.name);
Assertequals('No index','',Property1.IndexValue);
AssertNull('No Index expression',Property1.IndexExpr);
AssertNull('No default expression',Property1.DefaultExpr);
Assertequals('Default value','',Property1.DefaultValue);
end;
procedure TTestClassType.TestPropertyReadWriteFromRecordField; procedure TTestClassType.TestPropertyReadWriteFromRecordField;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);