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

fcl-passrc: parser: forbid anonymous/local types in proc args and result types

Browse Source
This commit is contained in:
mattias 2024-12-30 15:00:34 +01:00
parent 4e5be1337c
commit 80c59d2474
3 changed files with 17 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2153,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];
FuncArgResultTypeTokens = [tkIdentifier,tkarray,tkSpecialize];
var
PM: TPackMode;
@ -2173,7 +2173,8 @@ begin
ParseExc(nParserTypeNotAllowedHere,SParserTypeNotAllowedHere,[CurtokenText]);
end;
if (Parent is TPasArgument) and not (CurToken in ArgTypeTokens) then
if (not (CurToken in FuncArgResultTypeTokens))
and ((Parent is TPasArgument) or (Parent is TPasResultElement)) then
ParseExc(nParserParamsOrResultTypesNoLocalTypeDefs,SParserParamsOrResultTypesNoLocalTypeDefs);
case CurToken of

17
packages/fcl-passrc/tests/tcprocfunc.pas
View File

@ -104,8 +104,6 @@ type
Procedure TestFunctionArrayOfConstArg;
procedure TestProcedureConstArrayOfConstArg;
Procedure TestFunctionConstArrayOfConstArg;
procedure TestProcedureOnePointerArg;
procedure TestFUnctionPointerResult;
Procedure TestProcedureCdecl;
Procedure TestFunctionCdecl;
@ -501,8 +499,6 @@ begin
AssertFunc([],[],ccDefault,0);
end;
procedure TTestProcedureFunction.TestProcedureOneArg;
begin
ParseProcedure('(B : Integer)');
@ -510,19 +506,6 @@ begin
AssertArg(ProcType,0,'B',argDefault,'Integer','');
end;
procedure TTestProcedureFunction.TestProcedureOnePointerArg;
begin
ParseProcedure('(B : ^Integer)');
AssertProc([],[],ccDefault,1);
AssertArg(ProcType,0,'B',argDefault,'^Integer','');
end;
procedure TTestProcedureFunction.TestFUnctionPointerResult;
begin
ParseFunction('()','^LongInt');
AssertFunc([],[],ccDefault,0);
end;
procedure TTestProcedureFunction.TestFunctionOneArg;
begin
ParseFunction('(B : Integer)');

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

@ -404,6 +404,7 @@ type
Procedure TestProc_ArgAnonymouseRangeTypeFail;
Procedure TestProc_ArgAnonymouseEnumTypeFail;
Procedure TestProc_ArgAnonymouseSetTypeFail;
Procedure TestProc_ArgAnonymousePointerTypeFail;
Procedure TestProc_ArgMissingSemicolonFail;
Procedure TestProcOverload;
Procedure TestProcOverloadImplDuplicateFail;
@ -6516,6 +6517,16 @@ 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_ArgAnonymousePointerTypeFail;
begin
StartProgram(false);
Add([
'procedure Fly(Speed: ^word);',
'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;
begin
StartProgram(false);
@ -9265,7 +9276,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_ArgumentFail;
@ -16919,8 +16930,7 @@ begin
'var',
' f: function:function:longint;',
'begin']);
CheckResolverException('Cannot nest anonymous functional 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_ResultTypeFail;
@ -16931,8 +16941,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_ArgumentFail;