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

packages/fcl-passrc/src/pparser.pp

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

packages/fcl-passrc/tests/tcresolver.pas

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