fcl-passrc: resolver: deprecated hintmessage, asm-block without assembler modifier, less hints

git-svn-id: trunk@35902 -

packages/fcl-passrc/src/pasresolver.pp

@@ -264,7 +264,8 @@ const
   nSymbolXIsNotImplemented = 3060;
   nSymbolXBelongsToALibrary = 3061;
   nSymbolXIsDeprecated = 3062;
-  nRangeCheckError = 3063;
+  nSymbolXIsDeprecatedY = 3063;
+  nRangeCheckError = 3064;
 
 // resourcestring patterns of messages
 resourcestring
@@ -330,6 +331,7 @@ resourcestring
   sSymbolXIsNotImplemented = 'Symbol "%s" is implemented';
   sSymbolXBelongsToALibrary = 'Symbol "%s" belongs to a library';
   sSymbolXIsDeprecated = 'Symbol "%s" is deprecated';
+  sSymbolXIsDeprecatedY = 'Symbol "%s" is deprecated: %s';
   sRangeCheckError = 'Range check error';
 
 type
@@ -3290,6 +3292,8 @@ begin
   Body:=aProc.Body;
   if Body<>nil then
     begin
+    if Body.Body is TPasImplAsmStatement then
+      aProc.Modifiers:=aProc.Modifiers+[pmAssembler];
     ResolveImplBlock(Body.Body);
 
     // check if all forward procs are resolved
@@ -4224,8 +4228,14 @@ begin
   if El.Hints=[] then exit(false);
   Result:=true;
   if hDeprecated in El.Hints then
-    LogMsg(20170419190434,mtWarning,nSymbolXIsDeprecated,sSymbolXIsDeprecated,
-      [El.Name],PosEl);
+    begin
+    if El.HintMessage<>'' then
+      LogMsg(20170422160807,mtWarning,nSymbolXIsDeprecatedY,sSymbolXIsDeprecatedY,
+        [El.Name,El.HintMessage],PosEl)
+    else
+      LogMsg(20170419190434,mtWarning,nSymbolXIsDeprecated,sSymbolXIsDeprecated,
+        [El.Name],PosEl);
+    end;
   if hLibrary in El.Hints then
     LogMsg(20170419190426,mtWarning,nSymbolXBelongsToALibrary,sSymbolXBelongsToALibrary,
       [El.Name],PosEl);

packages/fcl-passrc/src/pparser.pp

@@ -3991,8 +3991,6 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
 
 var
   isArray , ok: Boolean;
-  h   : TPasMemberHint;
-
 begin
   Result:=TPasProperty(CreateElement(TPasProperty,AName,Parent,AVisibility));
   if IsClassField then

packages/fcl-passrc/tests/tcresolver.pas

@@ -555,6 +555,7 @@ type
 
     // hints
     Procedure TestHint_ElementHints;
+    Procedure TestHint_ElementHintsMsg;
   end;
 
 function LinesToStr(Args: array of const): string;
@@ -9096,6 +9097,21 @@ begin
   CheckResolverUnexpectedHints;
 end;
 
+procedure TTestResolver.TestHint_ElementHintsMsg;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  TDeprecated = longint deprecated ''foo'';',
+  'var',
+  '  vDeprecated: TDeprecated;',
+  'begin',
+  '']);
+  ParseProgram;
+  CheckResolverHint(mtWarning,nSymbolXIsDeprecatedY,'Symbol "TDeprecated" is deprecated: ''foo''');
+  CheckResolverUnexpectedHints;
+end;
+
 initialization
   RegisterTests([TTestResolver]);
 

packages/fcl-passrc/tests/tctypeparser.pas

@@ -1243,6 +1243,7 @@ end;
 
 procedure TTestRecordTypeParser.AssertConst1(Hints: TPasMemberHints);
 begin
+  if Hints=[] then ;
   AssertEquals('Member 1 type',TPasConst,TObject(TheRecord.Members[0]).ClassType);
   AssertEquals('Const 1 name','x',Const1.Name);
   AssertNotNull('Have 1 const expr',Const1.Expr);

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -95,6 +95,7 @@ type
     procedure TestM_Hint_LocalClassInProgramNotUsed;
     procedure TestM_Hint_LocalMethodInProgramNotUsed;
     procedure TestM_Hint_AssemblerParameterIgnored;
+    procedure TestM_Hint_AssemblerDelphiParameterIgnored;
     procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet;
     procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
     procedure TestM_Hint_FunctionResultRecord;
@@ -1260,6 +1261,32 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_AssemblerDelphiParameterIgnored;
+begin
+  StartProgram(true);
+  Add([
+  '{$mode Delphi}',
+  'procedure DoIt(i: longint);',
+  'type',
+  '  {#tcolor_notused}TColor = longint;',
+  '  {#tflag_notused}TFlag = (red,green);',
+  '  {#tflags_notused}TFlags = set of TFlag;',
+  '  {#tarrint_notused}TArrInt = array of integer;',
+  'const',
+  '  {#a_notused}a = 13;',
+  '  {#b_notused}b: longint = 14;',
+  'var',
+  '  {#c_notused}c: char;',
+  '  {#d_notused}d: longint = 15;',
+  '  procedure {#sub_notused}Sub; begin end;',
+  'asm end;',
+  'begin',
+  '  DoIt(1);',
+  '']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet;
 begin
   StartProgram(true);