Browse Source

fcl-passrc: fixed parsing property hints

mattias 3 years ago
parent
commit
13ebe495df
2 changed files with 33 additions and 15 deletions
  1. 3 13
      packages/fcl-passrc/src/pparser.pp
  2. 30 2
      packages/fcl-passrc/tests/tcresolver.pas

+ 3 - 13
packages/fcl-passrc/src/pparser.pp

@@ -5790,16 +5790,6 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
     until CurToken<>tkComma;
   end;
 
-  procedure ConsumeSemi;
-  begin
-    if (CurToken = tkSemicolon) then
-      begin
-      NextToken;
-      if IsCurTokenHint then
-        UngetToken;
-      end;
-  end;
-
 var
   isArray , ok, IsClass: Boolean;
   ObjKind: TPasObjKind;
@@ -5921,10 +5911,10 @@ begin
       while DoCheckHint(Result) do
         begin
         NextToken; // eat Hint token
-        ConsumeSemi; // Now on hint token or semicolon
+        if (CurToken = tkSemicolon) then
+          NextToken;
         end;
-//      if Result.Hints=[] then
-        UngetToken;
+      UngetToken;
       end
     else if CurToken=tkend then
       // ok

+ 30 - 2
packages/fcl-passrc/tests/tcresolver.pas

@@ -936,10 +936,11 @@ type
     Procedure TestResourcestringPassVarArgFail;
 
     // hints
-    Procedure TestHint_ElementHints;
+    Procedure TestHint_ElementHintModifiers;
     Procedure TestHint_ElementHintsMsg;
     Procedure TestHint_ElementHintsAlias;
     Procedure TestHint_ElementHints_WarnOff_SymbolDeprecated;
+    Procedure TestHint_ClassElementHints;
     Procedure TestHint_UsesHints;
     Procedure TestHint_Garbage;
 
@@ -17198,7 +17199,7 @@ begin
   CheckResolverException(sVariableIdentifierExpected,nVariableIdentifierExpected);
 end;
 
-procedure TTestResolver.TestHint_ElementHints;
+procedure TTestResolver.TestHint_ElementHintModifiers;
 begin
   StartProgram(false);
   Add([
@@ -17293,6 +17294,33 @@ begin
   CheckResolverUnexpectedHints(true);
 end;
 
+procedure TTestResolver.TestHint_ClassElementHints;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TObject = class',
+  '    FWing: word experimental;',
+  '    property Wing: word read FWing; platform; experimental;',
+  '    procedure Fly; library;',
+  '  end;',
+  'procedure TObject.Fly;',
+  'begin',
+  '  if Wing=3 then ;',
+  'end;',
+  'var',
+  '  Bird: TObject;',
+  'begin',
+  '  Bird.Fly;',
+  '']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nSymbolXIsExperimental,'Symbol "FWing" is experimental');
+  CheckResolverHint(mtWarning,nSymbolXIsNotPortable,'Symbol "Wing" is not portable');
+  CheckResolverHint(mtWarning,nSymbolXIsExperimental,'Symbol "Wing" is experimental');
+  CheckResolverHint(mtWarning,nSymbolXBelongsToALibrary,'Symbol "Fly" belongs to a library');
+  CheckResolverUnexpectedHints;
+end;
+
 procedure TTestResolver.TestHint_UsesHints;
 var
   Src: String;