Browse Source

fcl-passrc: fixed forbid anonymous range type as proc arg type

mattias 7 months ago
parent
commit
459e1901d2
2 changed files with 41 additions and 0 deletions
  1. 2 0
      packages/fcl-passrc/src/pparser.pp
  2. 39 0
      packages/fcl-passrc/tests/tcresolver.pas

+ 2 - 0
packages/fcl-passrc/src/pparser.pp

@@ -2272,6 +2272,8 @@ begin
       end;
     tkNumber,tkMinus,tkChar:
       begin
+      if Parent is TPasArgument then
+        ParseExcExpectedIdentifier;
       UngetToken;
       Result:=ParseRangeType(Parent,NamePos,TypeName,declParseType=dptFull);
       end;

+ 39 - 0
packages/fcl-passrc/tests/tcresolver.pas

@@ -401,6 +401,7 @@ type
     Procedure TestProc_ArgVarTypeAliasObjFPC;
     Procedure TestProc_ArgVarTypeAliasDelphi;
     Procedure TestProc_ArgVarTypeAliasDelphiMismatchFail;
+    Procedure TestProc_ArgAnonymouseRangeTypeFail;
     Procedure TestProc_ArgMissingSemicolonFail;
     Procedure TestProcOverload;
     Procedure TestProcOverloadImplDuplicateFail;
@@ -1006,6 +1007,7 @@ type
     Procedure TestAttributes_UnknownAttrWarning;
     Procedure TestAttributes_Members;
     Procedure TestAttributes_MethodParams;
+    Procedure TestAttributes_MethodParamsGroup;
 
     // library
     Procedure TestLibrary_Empty;
@@ -6482,6 +6484,16 @@ begin
     nIncompatibleTypeArgNoVarParamMustMatchExactly);
 end;
 
+procedure TTestResolver.TestProc_ArgAnonymouseRangeTypeFail;
+begin
+  StartProgram(false);
+  Add([
+  'procedure Fly(Speed: 1..2);',
+  'begin end;',
+  'begin']);
+  CheckParserException('Identifier expected at token "Number" in file afile.pp at line 2 column 22',nParserExpectedIdentifier);
+end;
+
 procedure TTestResolver.TestProc_ArgMissingSemicolonFail;
 begin
   StartProgram(false);
@@ -19303,6 +19315,33 @@ begin
   CheckResolverUnexpectedHints;
 end;
 
+procedure TTestResolver.TestAttributes_MethodParamsGroup;
+begin
+  StartProgram(false);
+  Add([
+  '{$modeswitch prefixedattributes}',
+  'type',
+  '  TObject = class',
+  '    constructor {#create}Create;',
+  '  end;',
+  '  {#custom}TCustomAttribute = class',
+  '  end;',
+  '  TMyClass = class',
+  '    procedure Fly([{#attr__custom__create__size}TCustom]Speed, Dist: word);',
+  '  end;',
+  'constructor TObject.Create;',
+  'begin',
+  'end;',
+  'procedure TMyClass.Fly(Speed, Dist: word);',
+  'begin',
+  'end;',
+  'begin',
+  '']);
+  ParseProgram;
+  CheckAttributeMarkers;
+  CheckResolverUnexpectedHints;
+end;
+
 procedure TTestResolver.TestLibrary_Empty;
 begin
   StartLibrary(false);