diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp index aea92962dc..bb397b0ef5 100644 --- a/packages/fcl-passrc/src/pparser.pp +++ b/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; diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index 5280018596..cb7745cacf 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/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;