paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 19:09:23 +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; nParserSyntaxError = 2022;
nParserTypeSyntaxError = 2023; nParserTypeSyntaxError = 2023;
nParserArrayTypeSyntaxError = 2024; nParserArrayTypeSyntaxError = 2024;
nParserParamsOrResultTypesNoLocalTypeDefs = 2025;
nParserExpectedIdentifier = 2026; nParserExpectedIdentifier = 2026;
nParserNotAProcToken = 2026; nParserNotAProcToken = 2026;
nRangeExpressionExpected = 2027; nRangeExpressionExpected = 2027;
@ -111,6 +112,7 @@ const
nInvalidMessageType = 2058; nInvalidMessageType = 2058;
nErrCompilationAborted = 2059; // FPC = 1018; nErrCompilationAborted = 2059; // FPC = 1018;
// resourcestring patterns of messages // resourcestring patterns of messages
resourcestring resourcestring
SErrNoSourceGiven = 'No source file specified'; SErrNoSourceGiven = 'No source file specified';
@ -137,6 +139,7 @@ resourcestring
SParserSyntaxError = 'Syntax error'; SParserSyntaxError = 'Syntax error';
SParserTypeSyntaxError = 'Syntax error in type'; SParserTypeSyntaxError = 'Syntax error in type';
SParserArrayTypeSyntaxError = 'Syntax error in array 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'; SParserExpectedIdentifier = 'Identifier expected';
SParserNotAProcToken = 'Not a procedure or function token'; SParserNotAProcToken = 'Not a procedure or function token';
SRangeExpressionExpected = 'Range expression expected'; SRangeExpressionExpected = 'Range expression expected';
@ -2150,7 +2153,7 @@ Const
NoHintTokens = [tkProcedure,tkFunction]; NoHintTokens = [tkProcedure,tkFunction];
InterfaceKindTypes : Array[Boolean] of TPasObjKind = (okInterface,okObjcProtocol); InterfaceKindTypes : Array[Boolean] of TPasObjKind = (okInterface,okObjcProtocol);
ClassKindTypes : Array[TLocalClassType] of TPasObjKind = (okClass,okObjCClass,okObjcCategory,okClassHelper); ClassKindTypes : Array[TLocalClassType] of TPasObjKind = (okClass,okObjCClass,okObjcCategory,okClassHelper);
ArgTypeTokens = [tkIdentifier,tkarray,tkSpecialize,tkCaret];
var var
PM: TPackMode; PM: TPackMode;
@ -2170,6 +2173,9 @@ begin
ParseExc(nParserTypeNotAllowedHere,SParserTypeNotAllowedHere,[CurtokenText]); ParseExc(nParserTypeNotAllowedHere,SParserTypeNotAllowedHere,[CurtokenText]);
end; end;
if (Parent is TPasArgument) and not (CurToken in ArgTypeTokens) then
ParseExc(nParserParamsOrResultTypesNoLocalTypeDefs,SParserParamsOrResultTypesNoLocalTypeDefs);
case CurToken of case CurToken of
// types only allowed when full // types only allowed when full
tkObject: Result := ParseClassDecl(Parent, NamePos, TypeName, okObject,PM); tkObject: Result := ParseClassDecl(Parent, NamePos, TypeName, okObject,PM);
@ -2272,8 +2278,6 @@ begin
end; end;
tkNumber,tkMinus,tkChar: tkNumber,tkMinus,tkChar:
begin begin
if Parent is TPasArgument then
ParseExcExpectedIdentifier;
UngetToken; UngetToken;
Result:=ParseRangeType(Parent,NamePos,TypeName,declParseType=dptFull); Result:=ParseRangeType(Parent,NamePos,TypeName,declParseType=dptFull);
end; end;

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

@ -402,6 +402,8 @@ type
Procedure TestProc_ArgVarTypeAliasDelphi; Procedure TestProc_ArgVarTypeAliasDelphi;
Procedure TestProc_ArgVarTypeAliasDelphiMismatchFail; Procedure TestProc_ArgVarTypeAliasDelphiMismatchFail;
Procedure TestProc_ArgAnonymouseRangeTypeFail; Procedure TestProc_ArgAnonymouseRangeTypeFail;
Procedure TestProc_ArgAnonymouseEnumTypeFail;
Procedure TestProc_ArgAnonymouseSetTypeFail;
Procedure TestProc_ArgMissingSemicolonFail; Procedure TestProc_ArgMissingSemicolonFail;
Procedure TestProcOverload; Procedure TestProcOverload;
Procedure TestProcOverloadImplDuplicateFail; Procedure TestProcOverloadImplDuplicateFail;
@ -6491,7 +6493,27 @@ begin
'procedure Fly(Speed: 1..2);', 'procedure Fly(Speed: 1..2);',
'begin end;', 'begin end;',
'begin']); '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; end;
procedure TTestResolver.TestProc_ArgMissingSemicolonFail; procedure TTestResolver.TestProc_ArgMissingSemicolonFail;
@ -9257,7 +9279,7 @@ begin
'end;', 'end;',
'begin', '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; end;
procedure TTestResolver.TestRecordAnonym_Advanced_ConstFail; procedure TTestResolver.TestRecordAnonym_Advanced_ConstFail;
@ -16921,8 +16943,7 @@ begin
'begin', 'begin',
'end;', 'end;',
'begin']); 'begin']);
CheckResolverException('Cannot nest anonymous procedural type', CheckParserException('Parameters or result types cannot contain local type definitions. Use a separate type definition in a type block.',nParserParamsOrResultTypesNoLocalTypeDefs);
nCannotNestAnonymousX);
end; end;
procedure TTestResolver.TestProcTypeAnonymous_PropertyFail; procedure TTestResolver.TestProcTypeAnonymous_PropertyFail;