paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-13 14:29:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: $warn directive

Browse Source 
git-svn-id: trunk@39315 -
This commit is contained in:
Mattias Gaertner 2018-06-27 14:27:43 +00:00
parent 7d95a993ca
commit 7a6fed75a0
6 changed files with 234 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
packages/fcl-passrc/src/pasresolver.pp
View File

@ -263,7 +263,7 @@ unit PasResolver;
interface
uses
Classes, SysUtils, Math, contnrs,
Classes, SysUtils, Math, Types, contnrs,
PasTree, PScanner, PParser, PasResolveEval;
const
@ -1232,6 +1232,8 @@ type
OnlyScope: TPasScope): TPasProcedure;
protected
procedure SetCurrentParser(AValue: TPasParser); override;
procedure ScannerWarnDirective(Sender: TObject; Identifier: string;
State: TWarnMsgState; var Handled: boolean); virtual;
procedure SetRootElement(const AValue: TPasModule); virtual;
procedure CheckTopScope(ExpectedClass: TPasScopeClass; AllowDescendants: boolean = false);
function AddIdentifier(Scope: TPasIdentifierScope;
@ -1602,6 +1604,8 @@ type
Const Fmt : String; Args : Array of const; PosEl: TPasElement);
procedure LogMsg(const id: int64; MsgType: TMessageType; MsgNumber: integer;
const Fmt: String; Args: Array of const; PosEl: TPasElement); overload;
class function GetWarnIdentifierNumbers(Identifier: string;
out MsgNumbers: TIntegerDynArray): boolean; virtual;
procedure GetIncompatibleTypeDesc(const GotType, ExpType: TPasResolverResult;
out GotDesc, ExpDesc: String); overload;
procedure GetIncompatibleTypeDesc(const GotType, ExpType: TPasType;
@ -4225,7 +4229,23 @@ begin
Clear;
inherited SetCurrentParser(AValue);
if CurrentParser<>nil then
begin
CurrentParser.Options:=CurrentParser.Options+po_Resolver;
if (CurrentParser.Scanner<>nil) and (CurrentParser.Scanner.OnWarnDirective=nil) then
CurrentParser.Scanner.OnWarnDirective:=@ScannerWarnDirective;
end;
end;
procedure TPasResolver.ScannerWarnDirective(Sender: TObject;
Identifier: string; State: TWarnMsgState; var Handled: boolean);
var
MsgNumbers: TIntegerDynArray;
i: Integer;
begin
if not GetWarnIdentifierNumbers(Identifier,MsgNumbers) then exit;
Handled:=true;
for i:=0 to length(MsgNumbers)-1 do
TPascalScanner(Sender).WarnMsgState[MsgNumbers[i]]:=State;
end;
procedure TPasResolver.CheckTopScope(ExpectedClass: TPasScopeClass;
@ -15232,11 +15252,44 @@ end;
procedure TPasResolver.LogMsg(const id: int64; MsgType: TMessageType;
MsgNumber: integer; const Fmt: String; Args: array of const;
PosEl: TPasElement);
var
Scanner: TPascalScanner;
State: TWarnMsgState;
{$IFDEF VerbosePasResolver}
s: String;
{$ENDIF}
begin
Scanner:=CurrentParser.Scanner;
if (Scanner<>nil) then
begin
if (FStep<prsFinishingModule)
and (CurrentParser.Scanner<>nil)
and (CurrentParser.Scanner.IgnoreMsgType(MsgType)) then
and (Scanner.IgnoreMsgType(MsgType)) then
exit; // during parsing consider directives like $Hints on|off
if MsgType>=mtWarning then
begin
State:=Scanner.WarnMsgState[MsgNumber];
case State of
wmsOff:
begin
{$IFDEF VerbosePasResolver}
{AllowWriteln}
write('TPasResolver.LogMsg ignoring ',id,' ',GetElementSourcePosStr(PosEl),' ');
s:='';
str(MsgType,s);
write(s);
writeln(': [',MsgNumber,'] ',SafeFormat(Fmt,Args));
{AllowWriteln-}
{$ENDIF}
exit; // ignore
end;
wmsError:
begin
RaiseMsg(id,MsgNumber,Fmt,Args,PosEl);
exit;
end;
end;
end;
end;
SetLastMsg(id,MsgType,MsgNumber,Fmt,Args,PosEl);
if Assigned(OnLog) then
@ -15245,6 +15298,53 @@ begin
CurrentParser.OnLog(Self,FLastMsg);
end;
class function TPasResolver.GetWarnIdentifierNumbers(Identifier: string; out
MsgNumbers: TIntegerDynArray): boolean;
procedure SetNumber(Number: integer);
begin
{$IF FPC_FULLVERSION>=30101}
MsgNumbers:=[Number];
{$ELSE}
Setlength(MsgNumbers,1);
MsgNumbers[0]:=Number;
{$ENDIF}
end;
begin
if Identifier='' then exit(false);
if Identifier[1] in ['0'..'9'] then exit(false);
Result:=true;
case UpperCase(Identifier) of
// FPC:
'CONSTRUCTING_ABSTRACT': SetNumber(nConstructingClassXWithAbstractMethodY); // Constructing an instance of a class with abstract methods.
//'IMPLICIT_VARIANTS': ; // Implicit use of the variants unit.
// useanalyzer: 'NO_RETVAL': ; // Function result is not set.
'SYMBOL_DEPRECATED': SetNumber(nSymbolXIsDeprecated); // Deprecated symbol.
'SYMBOL_EXPERIMENTAL': SetNumber(nSymbolXIsExperimental); // Experimental symbol
'SYMBOL_LIBRARY': SetNumber(nSymbolXBelongsToALibrary); // Not used.
'SYMBOL_PLATFORM': SetNumber(nSymbolXIsNotPortable); // Platform-dependent symbol.
'SYMBOL_UNIMPLEMENTED': SetNumber(nSymbolXIsNotImplemented); // Unimplemented symbol.
//'UNIT_DEPRECATED': ; // Deprecated unit.
//'UNIT_EXPERIMENTAL': ; // Experimental unit.
//'UNIT_LIBRARY': ; //
//'UNIT_PLATFORM': ; // Platform dependent unit.
//'UNIT_UNIMPLEMENTED': ; // Unimplemented unit.
//'ZERO_NIL_COMPAT': ; // Converting 0 to NIL
//'IMPLICIT_STRING_CAST': ; // Implicit string type conversion
//'IMPLICIT_STRING_CAST_LOSS': ; // Implicit string typecast with potential data loss from ”$1” to ”$2”
//'EXPLICIT_STRING_CAST': ; // Explicit string type conversion
//'EXPLICIT_STRING_CAST_LOSS': ; // Explicit string typecast with potential data loss from ”$1” to ”$2”
//'CVT_NARROWING_STRING_LOST': ; // Unicode constant cast with potential data loss
// Delphi:
'HIDDEN_VIRTUAL': SetNumber(nMethodHidesMethodOfBaseType); // method hides virtual method of ancestor
else
Result:=false;
end;
end;
procedure TPasResolver.GetIncompatibleTypeDesc(const GotType,
ExpType: TPasResolverResult; out GotDesc, ExpDesc: String);
begin

61
packages/fcl-passrc/src/pasuseanalyzer.pas
View File

@ -44,7 +44,7 @@ unit PasUseAnalyzer;
interface
uses
Classes, SysUtils, AVL_Tree,
Classes, SysUtils, Types, AVL_Tree,
PasTree, PScanner, PasResolveEval, PasResolver;
const
@ -247,9 +247,11 @@ type
function IsExport(El: TPasElement): boolean;
function IsIdentifier(El: TPasElement): boolean;
function IsImplBlockEmpty(El: TPasImplBlock): boolean;
procedure EmitMessage(const Id: int64; const MsgType: TMessageType;
procedure EmitMessage(Id: int64; MsgType: TMessageType;
MsgNumber: integer; Fmt: String; const Args: array of const; PosEl: TPasElement);
procedure EmitMessage(Msg: TPAMessage);
class function GetWarnIdentifierNumbers(Identifier: string;
out MsgNumbers: TIntegerDynArray): boolean; virtual;
function GetUsedElements: TFPList; virtual; // list of TPAElement
property OnMessage: TPAMessageEvent read FOnMessage write FOnMessage;
property Options: TPasAnalyzerOptions read FOptions write SetOptions;
@ -2469,19 +2471,21 @@ begin
Result:=false;
end;
procedure TPasAnalyzer.EmitMessage(const Id: int64;
const MsgType: TMessageType; MsgNumber: integer; Fmt: String;
const Args: array of const; PosEl: TPasElement);
procedure TPasAnalyzer.EmitMessage(Id: int64; MsgType: TMessageType;
MsgNumber: integer; Fmt: String; const Args: array of const;
PosEl: TPasElement);
var
Msg: TPAMessage;
El: TPasElement;
ProcScope: TPasProcedureScope;
ModScope: TPasModuleScope;
Scanner: TPascalScanner;
State: TWarnMsgState;
begin
{$IFDEF VerbosePasAnalyzer}
//writeln('TPasAnalyzer.EmitMessage [',Id,'] ',MsgType,': (',MsgNumber,') Fmt={',Fmt,'} PosEl='+GetElModName(PosEl));
{$ENDIF}
if MsgType in [mtHint,mtNote,mtWarning] then
if MsgType>=mtWarning then
begin
El:=PosEl;
while El<>nil do
@ -2510,6 +2514,25 @@ begin
end;
El:=El.Parent;
end;
if (Resolver<>nil) and (Resolver.CurrentParser<>nil) then
begin
Scanner:=Resolver.CurrentParser.Scanner;
if Scanner<>nil then
begin
State:=Scanner.WarnMsgState[MsgNumber];
case State of
wmsOff:
begin
{$IFDEF VerbosePasAnalyzer}
writeln('TPasAnalyzer.EmitMessage ignoring [',Id,'] ',MsgType,': (',MsgNumber,') Fmt={',Fmt,'} PosEl='+GetElModName(PosEl));
{$ENDIF}
exit;
end;
wmsError:
MsgType:=mtError;
end;
end;
end;
end;
Msg:=TPAMessage.Create;
Msg.Id:=Id;
@ -2541,6 +2564,32 @@ begin
end;
end;
class function TPasAnalyzer.GetWarnIdentifierNumbers(Identifier: string; out
MsgNumbers: TIntegerDynArray): boolean;
procedure SetNumber(Number: integer);
begin
{$IF FPC_FULLVERSION>=30101}
MsgNumbers:=[Number];
{$ELSE}
Setlength(MsgNumbers,1);
MsgNumbers[0]:=Number;
{$ENDIF}
end;
begin
if Identifier='' then exit(false);
if Identifier[1] in ['0'..'9'] then exit(false);
Result:=true;
case UpperCase(Identifier) of
// Delphi+FPC
'NO_RETVAL': SetNumber(nPAFunctionResultDoesNotSeemToBeSet); // Function result is not set.
else
Result:=false;
end;
end;
function TPasAnalyzer.GetUsedElements: TFPList;
var
Node: TAVLTreeNode;

80
packages/fcl-passrc/src/pscanner.pp
View File

@ -607,6 +607,7 @@ type
TPScannerDirectiveEvent = procedure(Sender: TObject; Directive, Param: String;
var Handled: boolean) of object;
TPScannerFormatPathEvent = function(const aPath: string): string of object;
TPScannerWarnEvent = procedure(Sender: TObject; Identifier: string; State: TWarnMsgState; var Handled: boolean) of object;
TPascalScanner = class
private
@ -645,6 +646,7 @@ type
FOnEvalFunction: TCEEvalFunctionEvent;
FOnEvalVariable: TCEEvalVarEvent;
FOnFormatPath: TPScannerFormatPathEvent;
FOnWarnDirective: TPScannerWarnEvent;
FOptions: TPOptions;
FLogEvents: TPScannerLogEvents;
FOnLog: TPScannerLogHandler;
@ -716,7 +718,7 @@ type
function HandleMacro(AIndex: integer): TToken; virtual;
procedure HandleInterfaces(const Param: String); virtual;
procedure HandleWarn(Param: String); virtual;
procedure HandleWarnIdentifier(IdentifierLoCase, ValueLoCase: String); virtual;
procedure HandleWarnIdentifier(Identifier, Value: String); virtual;
procedure PushStackItem; virtual;
function DoFetchTextToken: TToken;
function DoFetchToken: TToken;
@ -792,6 +794,7 @@ type
property ConditionEval: TCondDirectiveEvaluator read FConditionEval;
property OnEvalVariable: TCEEvalVarEvent read FOnEvalVariable write FOnEvalVariable;
property OnEvalFunction: TCEEvalFunctionEvent read FOnEvalFunction write FOnEvalFunction;
property OnWarnDirective: TPScannerWarnEvent read FOnWarnDirective write FOnWarnDirective;
property LastMsg: string read FLastMsg write FLastMsg;
property LastMsgNumber: integer read FLastMsgNumber write FLastMsgNumber;
@ -2807,69 +2810,72 @@ var
p, StartPos: Integer;
Identifier, Value: String;
begin
Param:=lowercase(Param);
p:=1;
while (p<=length(Param)) and (Param[p] in [' ',#9]) do inc(p);
StartPos:=p;
while (p<=length(Param)) and (Param[p] in ['a'..'z','0'..'9','_']) do inc(p);
while (p<=length(Param)) and (Param[p] in ['a'..'z','A'..'Z','0'..'9','_']) do inc(p);
Identifier:=copy(Param,StartPos,p-StartPos);
while (p<=length(Param)) and (Param[p] in [' ',#9]) do inc(p);
StartPos:=p;
while (p<=length(Param)) and (Param[p] in ['a'..'z']) do inc(p);
while (p<=length(Param)) and (Param[p] in ['a'..'z','A'..'Z','_']) do inc(p);
Value:=copy(Param,StartPos,p-StartPos);
HandleWarnIdentifier(Identifier,Value);
end;
procedure TPascalScanner.HandleWarnIdentifier(IdentifierLoCase,
ValueLoCase: String);
procedure TPascalScanner.HandleWarnIdentifier(Identifier,
Value: String);
var
Number: LongInt;
State: TWarnMsgState;
Handled: Boolean;
begin
if IdentifierLoCase='' then
if Identifier='' then
Error(nIllegalStateForWarnDirective,SIllegalStateForWarnDirective,['']);
if IdentifierLoCase[1] in ['0'..'9'] then
begin
// fpc number
Number:=StrToIntDef(IdentifierLoCase,-1);
if Number<0 then
begin
DoLog(mtWarning,nIllegalStateForWarnDirective,SIllegalStateForWarnDirective,[IdentifierLoCase]);
exit;
end;
end
else if (IdentifierLoCase[1]='w') and (msDelphi in CurrentModeSwitches) then
begin
// delphi W number
Number:=StrToIntDef(copy(IdentifierLoCase,2,10),-1);
if Number<0 then
begin
DoLog(mtWarning,nIllegalStateForWarnDirective,SIllegalStateForWarnDirective,[IdentifierLoCase]);
exit;
end;
Number:=-1;
end
else
begin
DoLog(mtWarning,nIllegalStateForWarnDirective,SIllegalStateForWarnDirective,[IdentifierLoCase]);
exit;
end;
if ValueLoCase='' then
if Value='' then
begin
DoLog(mtWarning,nIllegalStateForWarnDirective,SIllegalStateForWarnDirective,['']);
exit;
end;
case ValueLoCase of
case lowercase(Value) of
'on': State:=wmsOn;
'off': State:=wmsOff;
'default': State:=wmsDefault;
'error': State:=wmsError;
else
DoLog(mtWarning,nIllegalStateForWarnDirective,SIllegalStateForWarnDirective,[ValueLoCase]);
DoLog(mtWarning,nIllegalStateForWarnDirective,SIllegalStateForWarnDirective,[Value]);
exit;
end;
if Assigned(OnWarnDirective) then
begin
Handled:=false;
OnWarnDirective(Self,Identifier,State,Handled);
if Handled then
exit;
end;
if Identifier[1] in ['0'..'9'] then
begin
// fpc number
Number:=StrToIntDef(Identifier,-1);
if Number<0 then
begin
DoLog(mtWarning,nIllegalStateForWarnDirective,SIllegalStateForWarnDirective,[Identifier]);
exit;
end;
end
else if (Identifier[1] in ['w','W']) and (msDelphi in CurrentModeSwitches) then
begin
// delphi W number
Number:=StrToIntDef(copy(Identifier,2,10),-1);
if Number<0 then
begin
DoLog(mtWarning,nIllegalStateForWarnDirective,SIllegalStateForWarnDirective,[Identifier]);
exit;
end;
Number:=-1;
end;
if Number>=0 then
SetWarnMsgState(Number,State);
end;

7
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -14226,14 +14226,13 @@ end;
procedure TTestResolver.TestHint_ElementHints_WarnOff_SymbolDeprecated;
begin
exit; // ToDo
StartProgram(false);
Add([
'{$warn symbol_deprecated off}',
'type',
' i: byte; deprecated;',
'var',
' i: byte deprecated;',
'begin',
'']);
' if i=3 then ;']);
ParseProgram;
CheckResolverUnexpectedHints(true);
end;

13
packages/fcl-passrc/tests/tcuseanalyzer.pas
View File

@ -91,6 +91,7 @@ type
procedure TestM_Hint_UnitUsed;
procedure TestM_Hint_UnitUsedVarArgs;
procedure TestM_Hint_ParameterNotUsed;
procedure TestM_Hint_ParameterNotUsedOff;
procedure TestM_Hint_ParameterInOverrideNotUsed;
procedure TestM_Hint_ParameterAssignedButNotReadVarParam;
procedure TestM_Hint_ParameterNotUsed_Abstract;
@ -1394,6 +1395,18 @@ begin
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsedOff;
begin
StartProgram(true);
Add('{$warn '+IntToStr(nPAParameterNotUsed)+' off}');
Add('procedure DoIt(i: longint);');
Add('begin end;');
Add('begin');
Add(' DoIt(1);');
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_ParameterInOverrideNotUsed;
begin
StartProgram(true);

15
utils/pas2js/docs/translation.html
View File

@ -2805,6 +2805,21 @@ End.
<li>{$Hint text} : emit a hint</li>
<li>{$Message hint-text} : emit a hint</li>
<li>{$Message hint|note|warn|error|fatal text} : emit a message</li>
<li>{$Warn identifier on|off|default|error} : enable or disable a specific hint.<br>
Note, that some hints like "Parameter %s not used" are currently using the enable state at the end of the module, not the state at the hint source position.<br>
Identifier can be a message number as written by -vq or one of the following case insensitive:<br>
<ul>
<li>CONSTRUCTING_ABSTRACT: Constructing an instance of a class with abstract methods.</li>
<li>IMPLICIT_VARIANTS: Implicit use of the variants unit.</li>
<li>NO_RETVAL: Function result is not set</li>
<li>SYMBOL_DEPRECATED: Deprecated symbol.</li>
<li>SYMBOL_EXPERIMENTAL: Experimental symbol</li>
<li>SYMBOL_LIBRARY</li>
<li>SYMBOL_PLATFORM: Platform-dependent symbol.</li>
<li>SYMBOL_UNIMPLEMENTED: Unimplemented symbol.</li>
<li>HIDDEN_VIRTUAL: method hides virtual method of ancestor</li>
</ul>
</li>
<li>{$M+}, {$TypeInfo on}: switches default visibility for class members from public to published</li>
<li>{$ScopedEnums on|off} disabled(default): propagate enums to global scope, enable: needs fqn e.g. TEnumType.EnumValue.</li>
<li>{$C+} generate code for assertions</li>