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

packages/fcl-passrc/src/pparser.pp

@@ -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

packages/fcl-passrc/tests/tcprocfunc.pas

@@ -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)');

packages/fcl-passrc/tests/tcresolver.pas

@@ -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;