paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-04 11:38:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: parser: record property must have type

Browse Source 
git-svn-id: trunk@40650 -
This commit is contained in:
Mattias Gaertner 2018-12-25 22:45:44 +00:00
parent d75ba7cb11
commit 6ff287637a
3 changed files with 40 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5257,7 +5257,9 @@ begin
begin begin
Result.VarType := ParseType(Result,CurSourcePos); Result.VarType := ParseType(Result,CurSourcePos);
NextToken; NextToken;
end; end
else if not IsClass then
ParseExcTokenError(':');
if CurTokenIsIdentifier('INDEX') then if CurTokenIsIdentifier('INDEX') then
begin begin
NextToken; NextToken;

21
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -489,8 +489,7 @@ type
// advanced record // advanced record
Procedure TestAdvRecord; Procedure TestAdvRecord;
Procedure TestAdvRecord_Private; Procedure TestAdvRecord_Private;
// ToDO: Procedure TestAdvRecord_PropertyWithoutTypeFail; Procedure TestAdvRecord_StrictPrivate; // ToDo
// Todo: Procedure TestAdvRecord_ForwardFail
// ToDo: public, private, strict private // ToDo: public, private, strict private
// ToDo: TestAdvRecordPublishedFail // ToDo: TestAdvRecordPublishedFail
// ToDo: TestAdvRecord_VirtualFail // ToDo: TestAdvRecord_VirtualFail
@ -7858,6 +7857,24 @@ begin
ParseProgram; ParseProgram;
end; end;
procedure TTestResolver.TestAdvRecord_StrictPrivate;
begin
exit;
StartProgram(false);
Add([
'{$modeswitch advancedrecords}',
'type',
' TRec = record',
' strict private',
' A: word;',
' end;',
'var',
' r: TRec;',
'begin',
' r.a:=r.a;']);
CheckResolverException('aaa',123);
end;
procedure TTestResolver.TestClass; procedure TTestResolver.TestClass;
begin begin
StartProgram(false); StartProgram(false);

19
packages/fcl-passrc/tests/tctypeparser.pas
View File

@ -353,6 +353,8 @@ type
Procedure TestPropertyFail; Procedure TestPropertyFail;
Procedure TestAdvRec_Property; Procedure TestAdvRec_Property;
Procedure TestAdvRec_PropertyImplementsFail; Procedure TestAdvRec_PropertyImplementsFail;
Procedure TestAdvRec_PropertyNoTypeFail;
Procedure TestAdvRec_ForwardFail;
end; end;
{ TTestProcedureTypeParser } { TTestProcedureTypeParser }
@ -1283,7 +1285,8 @@ begin
except except
on E: EParserError do on E: EParserError do
begin begin
AssertEquals('Expected {'+Msg+'}, but got msg {'+Parser.LastMsg+'}',MsgNumber,Parser.LastMsgNumber); AssertEquals('Expected {'+Msg+'} '+IntToStr(MsgNumber)+', but got msg {'+Parser.LastMsg+'} '+IntToStr(Parser.LastMsgNumber),MsgNumber,Parser.LastMsgNumber);
AssertEquals('Expected {'+Msg+'}, but got msg {'+Parser.LastMsg+'}',Msg,Parser.LastMsg);
ok:=true; ok:=true;
end; end;
end; end;
@ -2543,6 +2546,20 @@ begin
ParseRecordFail('Expected ";"',nParserExpectTokenError); ParseRecordFail('Expected ";"',nParserExpectTokenError);
end; end;
procedure TTestRecordTypeParser.TestAdvRec_PropertyNoTypeFail;
begin
StartRecord(true);
AddMember('Property Something;');
ParseRecordFail('Expected ":"',nParserExpectTokenError);
end;
procedure TTestRecordTypeParser.TestAdvRec_ForwardFail;
begin
StartRecord(true);
FDecl.Add(';TMyRecord = record');
ParseRecordFail('Syntax error in type',nParserTypeSyntaxError);
end;
{ TBaseTestTypeParser } { TBaseTestTypeParser }
Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass; Function TBaseTestTypeParser.ParseType(ASource: String; ATypeClass: TClass;