paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 17:59:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: parser: forbid local types as proc args

Browse Source
This commit is contained in:
mattias 2024-12-30 11:54:52 +01:00
parent 459e1901d2
commit 4e5be1337c
2 changed files with 32 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -75,6 +75,7 @@ const
nParserSyntaxError = 2022;
nParserTypeSyntaxError = 2023;
nParserArrayTypeSyntaxError = 2024;
nParserParamsOrResultTypesNoLocalTypeDefs = 2025;
nParserExpectedIdentifier = 2026;
nParserNotAProcToken = 2026;
nRangeExpressionExpected = 2027;
@ -111,6 +112,7 @@ const
nInvalidMessageType = 2058;
nErrCompilationAborted = 2059; // FPC = 1018;
// resourcestring patterns of messages
resourcestring
SErrNoSourceGiven = 'No source file specified';
@ -137,6 +139,7 @@ resourcestring
SParserSyntaxError = 'Syntax error';
SParserTypeSyntaxError = 'Syntax error in type';
SParserArrayTypeSyntaxError = 'Syntax error in array type';
SParserParamsOrResultTypesNoLocalTypeDefs = 'Parameters or result types cannot contain local type definitions. Use a separate type definition in a type block.';
SParserExpectedIdentifier = 'Identifier expected';
SParserNotAProcToken = 'Not a procedure or function token';
SRangeExpressionExpected = 'Range expression expected';
@ -2150,7 +2153,7 @@ Const
NoHintTokens = [tkProcedure,tkFunction];
InterfaceKindTypes : Array[Boolean] of TPasObjKind = (okInterface,okObjcProtocol);
ClassKindTypes : Array[TLocalClassType] of TPasObjKind = (okClass,okObjCClass,okObjcCategory,okClassHelper);
ArgTypeTokens = [tkIdentifier,tkarray,tkSpecialize,tkCaret];
var
PM: TPackMode;
@ -2170,6 +2173,9 @@ begin
ParseExc(nParserTypeNotAllowedHere,SParserTypeNotAllowedHere,[CurtokenText]);
end;
if (Parent is TPasArgument) and not (CurToken in ArgTypeTokens) then
ParseExc(nParserParamsOrResultTypesNoLocalTypeDefs,SParserParamsOrResultTypesNoLocalTypeDefs);
case CurToken of
// types only allowed when full
tkObject: Result := ParseClassDecl(Parent, NamePos, TypeName, okObject,PM);
@ -2272,8 +2278,6 @@ begin
end;
tkNumber,tkMinus,tkChar:
begin
if Parent is TPasArgument then
ParseExcExpectedIdentifier;
UngetToken;
Result:=ParseRangeType(Parent,NamePos,TypeName,declParseType=dptFull);
end;

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

@ -402,6 +402,8 @@ type
Procedure TestProc_ArgVarTypeAliasDelphi;
Procedure TestProc_ArgVarTypeAliasDelphiMismatchFail;
Procedure TestProc_ArgAnonymouseRangeTypeFail;
Procedure TestProc_ArgAnonymouseEnumTypeFail;
Procedure TestProc_ArgAnonymouseSetTypeFail;
Procedure TestProc_ArgMissingSemicolonFail;
Procedure TestProcOverload;
Procedure TestProcOverloadImplDuplicateFail;
@ -6491,7 +6493,27 @@ begin
'procedure Fly(Speed: 1..2);',
'begin end;',
'begin']);
CheckParserException('Identifier expected at token "Number" in file afile.pp at line 2 column 22',nParserExpectedIdentifier);
CheckParserException('Parameters or result types cannot contain local type definitions. Use a separate type definition in a type block.',nParserParamsOrResultTypesNoLocalTypeDefs);
end;
procedure TTestResolver.TestProc_ArgAnonymouseEnumTypeFail;
begin
StartProgram(false);
Add([
'procedure Fly(Speed: (red, blue));',
'begin end;',
'begin']);
CheckParserException('Parameters or result types cannot contain local type definitions. Use a separate type definition in a type block.',nParserParamsOrResultTypesNoLocalTypeDefs);
end;
procedure TTestResolver.TestProc_ArgAnonymouseSetTypeFail;
begin
StartProgram(false);
Add([
'procedure Fly(Speed: set of (red, blue));',
'begin end;',
'begin']);
CheckParserException('Parameters or result types cannot contain local type definitions. Use a separate type definition in a type block.',nParserParamsOrResultTypesNoLocalTypeDefs);
end;
procedure TTestResolver.TestProc_ArgMissingSemicolonFail;
@ -9257,7 +9279,7 @@ begin
'end;',
'begin',
'']);
CheckResolverException('Cannot nest anonymous record',nCannotNestAnonymousX);
CheckParserException('Parameters or result types cannot contain local type definitions. Use a separate type definition in a type block.',nParserParamsOrResultTypesNoLocalTypeDefs);
end;
procedure TTestResolver.TestRecordAnonym_Advanced_ConstFail;
@ -16921,8 +16943,7 @@ begin
'begin',
'end;',
'begin']);
CheckResolverException('Cannot nest anonymous procedural type',
nCannotNestAnonymousX);
CheckParserException('Parameters or result types cannot contain local type definitions. Use a separate type definition in a type block.',nParserParamsOrResultTypesNoLocalTypeDefs);
end;
procedure TTestResolver.TestProcTypeAnonymous_PropertyFail;