fpc/packages/fcl-passrc/tests/tcuseanalyzer.pas
2019-03-16 16:14:40 +00:00

3338 lines
85 KiB
ObjectPascal

{
Examples:
./testpassrc --suite=TTestResolver.TestEmpty
}
unit tcuseanalyzer;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, PasTree, PScanner, PasResolver, tcbaseparser,
testregistry, strutils, tcresolver, PasUseAnalyzer, PasResolveEval;
type
{ TCustomTestUseAnalyzer }
TCustomTestUseAnalyzer = Class(TCustomTestResolver)
private
FAnalyzer: TPasAnalyzer;
FPAMessages: TFPList; // list of TPAMessage
FPAGoodMessages: TFPList;
FProcAnalyzer: TPasAnalyzer;
function GetPAMessages(Index: integer): TPAMessage;
procedure OnAnalyzerMessage(Sender: TObject; Msg: TPAMessage);
protected
procedure SetUp; override;
procedure TearDown; override;
procedure AnalyzeModule; virtual;
procedure AnalyzeProgram; virtual;
procedure AnalyzeUnit; virtual;
procedure AnalyzeWholeProgram; virtual;
procedure CheckUsedMarkers; virtual;
procedure CheckUseAnalyzerHint(MsgType: TMessageType; MsgNumber: integer;
const MsgText: string); virtual;
procedure CheckUseAnalyzerUnexpectedHints; virtual;
procedure CheckUnitUsed(const aFilename: string; Used: boolean); virtual;
procedure CheckScopeReferences(const ScopeName: string;
const RefNames: array of string);
public
property Analyzer: TPasAnalyzer read FAnalyzer;
property ProcAnalyzer: TPasAnalyzer read FProcAnalyzer;
function PAMessageCount: integer;
property PAMessages[Index: integer]: TPAMessage read GetPAMessages;
end;
{ TTestUseAnalyzer }
TTestUseAnalyzer = Class(TCustomTestUseAnalyzer)
published
// single module
procedure TestM_ProgramLocalVar;
procedure TestM_AssignStatement;
procedure TestM_BeginBlock;
procedure TestM_ForLoopStatement;
procedure TestM_AsmStatement;
procedure TestM_CaseOfStatement;
procedure TestM_IfThenElseStatement;
procedure TestM_WhileDoStatement;
procedure TestM_RepeatUntilStatement;
procedure TestM_TryFinallyStatement;
procedure TestM_TypeAlias;
procedure TestM_TypeAliasTypeInfo;
procedure TestM_RangeType;
procedure TestM_Unary;
procedure TestM_Const;
procedure TestM_ResourceString;
procedure TestM_Record;
procedure TestM_PointerTyped_Record;
procedure TestM_Array;
procedure TestM_NestedFuncResult;
procedure TestM_Enums;
procedure TestM_ProcedureType;
procedure TestM_AnonymousProc;
procedure TestM_Params;
procedure TestM_Class;
procedure TestM_ClassForward;
procedure TestM_Class_Property;
procedure TestM_Class_PropertyProtected;
procedure TestM_Class_PropertyOverride;
procedure TestM_Class_MethodOverride;
procedure TestM_Class_MethodOverride2;
procedure TestM_ClassInterface_Corba;
procedure TestM_ClassInterface_NoHintsForMethod;
procedure TestM_ClassInterface_NoHintsForImpl;
procedure TestM_ClassInterface_Delegation;
procedure TestM_ClassInterface_COM;
procedure TestM_TryExceptStatement;
// single module hints
procedure TestM_Hint_UnitNotUsed;
procedure TestM_Hint_UnitNotUsed_No_OnlyExternal;
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;
procedure TestM_Hint_ParameterNotUsedTypecast;
procedure TestM_Hint_OutParam_No_AssignedButNeverUsed;
procedure TestM_Hint_ArgPassed_No_ParameterNotUsed;
procedure TestM_Hint_ArrayArg_No_ParameterNotUsed;
procedure TestM_Hint_ArrayArg_No_ParameterNotUsed2;
procedure TestM_Hint_InheritedWithoutParams;
procedure TestM_Hint_LocalVariableNotUsed;
procedure TestM_HintsOff_LocalVariableNotUsed;
procedure TestM_Hint_ForVar_No_LocalVariableNotUsed;
procedure TestM_Hint_InterfaceUnitVariableUsed;
procedure TestM_Hint_ValueParameterIsAssignedButNeverUsed;
procedure TestM_Hint_LocalVariableIsAssignedButNeverUsed;
procedure TestM_Hint_LocalXYNotUsed;
procedure TestM_Hint_PrivateFieldIsNeverUsed;
procedure TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
procedure TestM_Hint_PrivateFieldExtClassNoIsAssignedButNeverUsed;
procedure TestM_Hint_PrivateMethodIsNeverUsed;
procedure TestM_Hint_LocalDestructor_No_IsNeverUsed;
procedure TestM_Hint_PrivateTypeNeverUsed;
procedure TestM_Hint_PrivateConstNeverUsed;
procedure TestM_Hint_PrivatePropertyNeverUsed;
procedure TestM_Hint_LocalClassInProgramNotUsed;
procedure TestM_Hint_LocalMethodInProgramNotUsed;
procedure TestM_Hint_LocalVarOfNotUsedProc;
procedure TestM_Hint_LocalVarOfNotUsedMethod;
procedure TestM_Hint_AssemblerParameterIgnored;
procedure TestM_Hint_AssemblerDelphiParameterIgnored;
procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet;
procedure TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
procedure TestM_Hint_FunctionResultRecord;
procedure TestM_Hint_FunctionResultPassRecordElement;
procedure TestM_Hint_FunctionResultAssembler;
procedure TestM_Hint_FunctionResultExit;
procedure TestM_Hint_AbsoluteVar;
// whole program optimization
procedure TestWP_LocalVar;
procedure TestWP_UnitUsed;
procedure TestWP_UnitUsed_ResourceString;
procedure TestWP_UnitNotUsed;
procedure TestWP_UnitInitialization;
procedure TestWP_UnitFinalization;
procedure TestWP_CallInherited;
procedure TestWP_ProgramPublicDeclarations;
procedure TestWP_ClassOverride;
procedure TestWP_ClassDefaultProperty;
procedure TestWP_BeforeConstruction;
procedure TestWP_Published;
procedure TestWP_PublishedSetType;
procedure TestWP_PublishedArrayType;
procedure TestWP_PublishedClassOfType;
procedure TestWP_PublishedRecordType;
procedure TestWP_PublishedProcType;
procedure TestWP_PublishedProperty;
procedure TestWP_BuiltInFunctions;
procedure TestWP_TypeInfo;
procedure TestWP_TypeInfo_PropertyEnumType;
procedure TestWP_TypeInfo_Alias;
procedure TestWP_ForInClass;
procedure TestWP_AssertSysUtils;
procedure TestWP_RangeErrorSysUtils;
procedure TestWP_ClassInterface;
procedure TestWP_ClassInterface_OneWayIntfToObj;
procedure TestWP_ClassInterface_Delegation;
procedure TestWP_ClassInterface_COM;
procedure TestWP_ClassInterface_COM_Unit;
procedure TestWP_ClassInterface_Typeinfo;
procedure TestWP_ClassInterface_TGUID;
procedure TestWP_ClassHelper;
procedure TestWP_ClassHelper_ClassConstrucor_Used;
procedure TestWP_Attributes;
procedure TestWP_Attributes_ForwardClass;
procedure TestWP_Attributes_Params;
// scope references
procedure TestSR_Proc_UnitVar;
procedure TestSR_Init_UnitVar;
end;
function dbgs(a: TPSRefAccess) : string;
implementation
function dbgs(a: TPSRefAccess): string;
begin
str(a,Result);
end;
{ TCustomTestUseAnalyzer }
procedure TCustomTestUseAnalyzer.OnAnalyzerMessage(Sender: TObject;
Msg: TPAMessage);
begin
Msg.AddRef;
FPAMessages.Add(Msg);
end;
function TCustomTestUseAnalyzer.GetPAMessages(Index: integer): TPAMessage;
begin
Result:=TPAMessage(FPAMessages[Index]);
end;
procedure TCustomTestUseAnalyzer.SetUp;
begin
inherited SetUp;
FPAMessages:=TFPList.Create;
FPAGoodMessages:=TFPList.Create;
FAnalyzer:=TPasAnalyzer.Create;
FAnalyzer.Resolver:=ResolverEngine;
Analyzer.OnMessage:=@OnAnalyzerMessage;
end;
procedure TCustomTestUseAnalyzer.TearDown;
var
i: Integer;
begin
FreeAndNil(FPAGoodMessages);
for i:=0 to FPAMessages.Count-1 do
TPAMessage(FPAMessages[i]).Release;
FreeAndNil(FPAMessages);
FreeAndNil(FAnalyzer);
FreeAndNil(FProcAnalyzer);
inherited TearDown;
end;
procedure TCustomTestUseAnalyzer.AnalyzeModule;
begin
Analyzer.AnalyzeModule(Module);
Analyzer.EmitModuleHints(Module);
CheckUsedMarkers;
end;
procedure TCustomTestUseAnalyzer.AnalyzeProgram;
begin
ParseProgram;
AnalyzeModule;
end;
procedure TCustomTestUseAnalyzer.AnalyzeUnit;
begin
ParseUnit;
AnalyzeModule;
end;
procedure TCustomTestUseAnalyzer.AnalyzeWholeProgram;
begin
ParseProgram;
Analyzer.AnalyzeWholeProgram(Module as TPasProgram);
CheckUsedMarkers;
end;
procedure TCustomTestUseAnalyzer.CheckUsedMarkers;
type
TUsed = (
uUsed,
uNotUsed,
uTypeInfo,
uNoTypeinfo
);
var
aMarker: PSrcMarker;
p: SizeInt;
Postfix: String;
Elements: TFPList;
i: Integer;
El, FoundEl: TPasElement;
ExpectedUsed: TUsed;
begin
aMarker:=FirstSrcMarker;
while aMarker<>nil do
begin
writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' Line=',aMarker^.Row,' StartCol=',aMarker^.StartCol,' EndCol=',aMarker^.EndCol);
p:=RPos('_',aMarker^.Identifier);
if p>1 then
begin
Postfix:=copy(aMarker^.Identifier,p+1);
if Postfix='used' then
ExpectedUsed:=uUsed
else if Postfix='notused' then
ExpectedUsed:=uNotUsed
else if Postfix='typeinfo' then
ExpectedUsed:=uTypeInfo
else if Postfix='notypeinfo' then
ExpectedUsed:=uNoTypeInfo
else
RaiseErrorAtSrcMarker('TCustomTestUseAnalyzer.CheckUsedMarkers unknown postfix "'+Postfix+'"',aMarker);
Elements:=FindElementsAt(aMarker);
try
FoundEl:=nil;
for i:=0 to Elements.Count-1 do
begin
El:=TPasElement(Elements[i]);
writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData));
case ExpectedUsed of
uUsed,uNotUsed:
if Analyzer.IsUsed(El) then
begin
FoundEl:=El;
break;
end;
uTypeInfo,uNoTypeinfo:
if Analyzer.IsTypeInfoUsed(El) then
begin
FoundEl:=El;
break;
end;
end;
end;
if FoundEl<>nil then
case ExpectedUsed of
uNotUsed:
RaiseErrorAtSrcMarker('expected element to be *not* used, but it is marked',aMarker);
uNoTypeinfo:
RaiseErrorAtSrcMarker('expected element to have *no* typeinfo, but it is marked',aMarker);
end
else
case ExpectedUsed of
uUsed:
RaiseErrorAtSrcMarker('expected element to be used, but it is not marked',aMarker);
uTypeInfo:
RaiseErrorAtSrcMarker('expected element to have typeinfo, but it is not marked',aMarker);
end;
finally
Elements.Free;
end;
end;
aMarker:=aMarker^.Next;
end;
end;
procedure TCustomTestUseAnalyzer.CheckUseAnalyzerHint(MsgType: TMessageType;
MsgNumber: integer; const MsgText: string);
var
i: Integer;
Msg: TPAMessage;
s: string;
begin
i:=PAMessageCount-1;
while i>=0 do
begin
Msg:=PAMessages[i];
if (Msg.MsgNumber=MsgNumber) then
begin
if (Msg.MsgType=MsgType) and (Msg.MsgText=MsgText) then
begin
FPAGoodMessages.Add(Msg);
exit;
end;
end;
dec(i);
end;
// mismatch
writeln('TCustomTestUseAnalyzer.CheckHasHint: ');
for i:=0 to PAMessageCount-1 do
begin
Msg:=PAMessages[i];
writeln(' ',i,'/',PAMessageCount,': [',Msg.Id,'] ',Msg.MsgType,': (',Msg.MsgNumber,') {',Msg.MsgText,'}');
end;
s:='';
str(MsgType,s);
Fail('Analyzer Message not found: '+s+': ('+IntToStr(MsgNumber)+') {'+MsgText+'}');
end;
procedure TCustomTestUseAnalyzer.CheckUseAnalyzerUnexpectedHints;
var
i: Integer;
Msg: TPAMessage;
s: String;
begin
for i:=0 to PAMessageCount-1 do
begin
Msg:=PAMessages[i];
if FPAGoodMessages.IndexOf(Msg)>=0 then continue;
s:='';
str(Msg.MsgType,s);
Fail('Unexpected analyzer message found ['+IntToStr(Msg.Id)+'] '+s+': ('+IntToStr(Msg.MsgNumber)+') {'+Msg.MsgText+'}');
end;
end;
procedure TCustomTestUseAnalyzer.CheckUnitUsed(const aFilename: string;
Used: boolean);
var
aResolver: TTestEnginePasResolver;
PAEl: TPAElement;
begin
aResolver:=FindModuleWithFilename(aFilename);
AssertNotNull('unit not found "'+aFilename+'"',aResolver);
AssertNotNull('unit module not found "'+aFilename+'"',aResolver.Module);
PAEl:=Analyzer.FindElement(aResolver.Module);
if PAEl<>nil then
begin
// unit is used
if not Used then
Fail('expected unit "'+aFilename+'" not used, but it is used');
end
else
begin
// unit is not used
if Used then
Fail('expected unit "'+aFilename+'" used, but it is not used');
end;
end;
procedure TCustomTestUseAnalyzer.CheckScopeReferences(
const ScopeName: string; const RefNames: array of string);
type
TEntry = record
Name: string;
Access: TPSRefAccess;
end;
var
Entries: array of TEntry;
procedure CheckRefs(ScopeRefs: TPasScopeReferences; const Prefix: string);
procedure DumpRefsAndFail(Refs: TFPList; const Msg: string);
var
i: Integer;
Ref: TPasScopeReference;
begin
{$IFDEF VerbosePasAnalyzer}
if Refs.Count=0 then
writeln('DumpRefsAndFail ',Prefix,' NO REFS');
{$ENDIF}
for i:=0 to Refs.Count-1 do
begin
Ref:=TPasScopeReference(Refs[i]);
if Ref=nil then break;
{$IFDEF VerbosePasAnalyzer}
writeln('DumpRefsAndFail ',Prefix,' ',i,' ',GetObjName(Ref.Element),' ',Ref.Access);
{$ENDIF}
end;
Fail(Prefix+': '+Msg);
end;
var
Refs: TFPList;
j, i: Integer;
o: TObject;
Ref: TPasScopeReference;
begin
if ScopeRefs=nil then
Refs:=TFPList.Create
else
Refs:=ScopeRefs.GetList;
try
// check that Refs only contains TPasProcScopeReference
for i:=0 to Refs.Count-1 do
begin
o:=TObject(Refs[i]);
if not (o is TPasScopeReference) then
Fail(Prefix+': Refs['+IntToStr(i)+'] '+GetObjName(o));
end;
// check that all Entries are referenced
for i:=0 to length(Entries)-1 do
begin
j:=Refs.Count-1;
while (j>=0)
and (CompareText(Entries[i].Name,TPasScopeReference(Refs[j]).Element.Name)<>0) do
dec(j);
if j<0 then
DumpRefsAndFail(Refs,'Missing reference "'+Entries[i].Name+'"');
Ref:=TPasScopeReference(Refs[j]);
if (Entries[i].Access<>psraNone) and (Ref.Access<>Entries[i].Access) then
DumpRefsAndFail(Refs,'Wrong reference access "'+Entries[i].Name+'",'
+' expected '+dbgs(Entries[i].Access)+', but got '+dbgs(Ref.Access));
end;
// check that no other references are in Refs
for i:=0 to Refs.Count-1 do
begin
Ref:=TPasScopeReference(Refs[i]);
j:=length(Entries)-1;
while (j>=0)
and (CompareText(Ref.Element.Name,Entries[j].Name)<>0) do
dec(j);
if j<0 then
DumpRefsAndFail(Refs,'Unneeded reference "'+GetObjName(Ref.Element)+'"');
end;
finally
Refs.Free;
end;
end;
function FindProc(Section: TPasSection): boolean;
var
i: Integer;
El: TPasElement;
Proc: TPasProcedure;
Scope: TPasProcedureScope;
begin
for i:=0 to Section.Declarations.Count-1 do
begin
El:=TPasElement(Section.Declarations[i]);
if CompareText(El.Name,ScopeName)<>0 then continue;
if not (El is TPasProcedure) then
Fail('El is not proc '+GetObjName(El));
Proc:=TPasProcedure(El);
Scope:=Proc.CustomData as TPasProcedureScope;
if Scope.DeclarationProc<>nil then continue;
// check references created by AnalyzeModule
CheckRefs(Scope.References,'AnalyzeModule');
exit(true);
end;
Result:=false;
end;
procedure CheckInitialFinalization(El: TPasImplBlock);
var
Scope: TPasInitialFinalizationScope;
begin
Scope:=El.CustomData as TPasInitialFinalizationScope;
CheckRefs(Scope.References,'AnalyzeModule');
end;
var
i: Integer;
begin
Entries:=nil;
SetLength(Entries,High(RefNames)-low(RefNames)+1);
for i:=low(RefNames) to high(RefNames) do
begin
Entries[i].Name:=RefNames[i];
Entries[i].Access:=psraNone;
end;
if Module is TPasProgram then
begin
if CompareText(ScopeName,'begin')=0 then
begin
// check begin-block references created by AnalyzeModule
CheckInitialFinalization(Module.InitializationSection);
exit;
end
else if FindProc(TPasProgram(Module).ProgramSection) then
exit;
end
else if Module is TPasLibrary then
begin
if CompareText(ScopeName,'begin')=0 then
begin
// check begin-block references created by AnalyzeModule
CheckInitialFinalization(Module.InitializationSection);
exit;
end
else if FindProc(TPasLibrary(Module).LibrarySection) then
exit;
end
else if Module.ClassType=TPasModule then
begin
if CompareText(ScopeName,'initialization')=0 then
begin
// check initialization references created by AnalyzeModule
CheckInitialFinalization(Module.InitializationSection);
exit;
end
else if CompareText(ScopeName,'finalization')=0 then
begin
// check finalization references created by AnalyzeModule
CheckInitialFinalization(Module.FinalizationSection);
exit;
end
else if FindProc(Module.InterfaceSection) then
exit
else if FindProc(Module.ImplementationSection) then
exit;
end;
Fail('missing proc '+ScopeName);
end;
function TCustomTestUseAnalyzer.PAMessageCount: integer;
begin
Result:=FPAMessages.Count;
end;
{ TTestUseAnalyzer }
procedure TTestUseAnalyzer.TestM_ProgramLocalVar;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('var {#l_notused}l: longint;');
Add('begin');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_AssignStatement;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('var');
Add(' {#a_notused}a: longint;');
Add(' {#b_used}b: longint;');
Add(' {#c_used}c: longint;');
Add('begin');
Add(' b:=c;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_BeginBlock;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('var');
Add(' {#a_used}a: longint;');
Add('begin');
Add(' begin');
Add(' a:=1;');
Add(' end;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_ForLoopStatement;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('var');
Add(' {#a_used}a: longint;');
Add(' {#b_used}b: longint;');
Add(' {#c_used}c: longint;');
Add(' {#d_used}d: longint;');
Add('begin');
Add(' for a:=b to c do d:=a;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_AsmStatement;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('begin');
Add(' asm end;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_CaseOfStatement;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('const');
Add(' {#a_used}a = 1;');
Add(' {#b_used}b = 2;');
Add('var');
Add(' {#c_used}c: longint;');
Add(' {#d_used}d: longint;');
Add('begin');
Add(' case a of');
Add(' b: c:=1;');
Add(' else');
Add(' d:=2;');
Add(' end;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_IfThenElseStatement;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('var');
Add(' {#a_used}a: longint;');
Add(' {#b_used}b: longint;');
Add(' {#c_used}c: longint;');
Add('begin');
Add(' if a=0 then b:=1 else c:=2;');
Add(' if a=0 then else ;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_WhileDoStatement;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('var');
Add(' {#a_used}a: longint;');
Add(' {#b_used}b: longint;');
Add('begin');
Add(' while a>0 do b:=1;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_RepeatUntilStatement;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('var');
Add(' {#a_used}a: longint;');
Add(' {#b_used}b: longint;');
Add('begin');
Add(' repeat a:=1; until b>1;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_TryFinallyStatement;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('var');
Add(' {#a_used}a: longint;');
Add(' {#b_used}b: longint;');
Add('begin');
Add(' try');
Add(' a:=1;');
Add(' finally');
Add(' b:=2;');
Add(' end;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_TypeAlias;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('type');
Add(' {#integer_used}integer = longint;');
Add('var');
Add(' {#a_used}a: integer;');
Add(' {#b_used}b: integer;');
Add(' {#c_notused}c: integer;');
Add('begin');
Add(' a:=b;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_TypeAliasTypeInfo;
begin
StartUnit(false);
Add([
'interface',
'type',
' {#integer_typeinfo}integer = type longint;',
' {tobject_used}TObject = class',
' private',
' type {#tcolor_notypeinfo}tcolor = type longint;',
' protected',
' type {#tsize_typeinfo}tsize = type longint;',
' end;',
'implementation',
'']);
AnalyzeUnit;
end;
procedure TTestUseAnalyzer.TestM_RangeType;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('const');
Add(' {#neg1_used}Neg1 = -1;');
Add(' {#pos1_used}Pos1 = +1;');
Add('type');
Add(' {#trg_used}TRg = Neg1..Pos1;');
Add('var');
Add(' {#a_used}a: trg;');
Add('begin');
Add(' a:=0;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_Unary;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('var');
Add(' {#a_used}a: longint;');
Add(' {#b_used}b: longint;');
Add(' {#c_used}c: longint;');
Add(' {#d_used}d: longint;');
Add('begin');
Add(' a:=+b;');
Add(' a:=c+d;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_Const;
begin
StartProgram(false);
Add([
'procedure {#DoIt_used}DoIt;',
'var',
' {#a_used}a: longint;',
' {#b_used}b: boolean;',
' {#c_used}c: array of longint;',
' {#d_used}d: string;',
'begin',
' a:=+1;',
' b:=true;',
' c:=nil;',
' d:=''foo'';',
'end;',
'begin',
' DoIt;']);
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_ResourceString;
begin
StartProgram(false);
Add([
'resourcestring',
'resourcestring',
' {#a_used}a = ''txt'';',
' {#b_used}b = ''foo'';',
'procedure {#DoIt_used}DoIt(s: string);',
'var',
' {#d_used}d: string;',
'begin',
' d:=b;',
'end;',
'begin',
' DoIt(a);']);
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_Record;
begin
StartProgram(false);
Add([
'procedure {#DoIt_used}DoIt;',
'type',
' {#integer_used}integer = longint;',
' {#trec_used}TRec = record',
' {#a_used}a: integer;',
' {#b_notused}b: integer;',
' {#c_used}c: integer;',
' end;',
'var',
' {#r_used}r: TRec;',
'const',
' ci = 2;',
' cr: TRec = (a:0;b:ci;c:2);',
'begin',
' r.a:=3;',
' with r do c:=4;',
' r:=cr;',
'end;',
'begin',
' DoIt;']);
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_PointerTyped_Record;
begin
StartProgram(false);
Add([
'procedure {#DoIt_used}DoIt;',
'type',
' {#prec_used}PRec = ^TRec;',
' {#trec_used}TRec = record',
' {#a_used}a: longint;',
' {#b_notused}b: longint;',
' {#c_used}c: longint;',
' {#d_used}d: longint;',
' {#e_used}e: longint;',
' end;',
'var',
' r: TRec;',
' p: PRec;',
' i: longint;',
'begin',
' p:=@r;',
' i:=p^.a;',
' p^.c:=i;',
' if i=p^.d then;',
' if p^.e=i then;',
'end;',
'begin',
' DoIt;']);
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "b" not used');
CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
'Local variable "c" is assigned but never used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Array;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('type');
Add(' {#integer_used}integer = longint;');
Add(' {#tarrayint_used}TArrayInt = array of integer;');
Add('var');
Add(' {#a_used}a: TArrayInt;');
Add(' {#b_used}b: integer;');
Add(' {#c_used}c: TArrayInt;');
Add(' {#d_used}d: integer;');
Add(' {#e_used}e: TArrayInt;');
Add(' {#f_used}f: integer;');
Add(' {#g_used}g: TArrayInt;');
Add(' {#h_used}h: TArrayInt;');
Add(' {#i_used}i: TArrayInt;');
Add('begin');
Add(' a[b]:=c[d];');
Add(' SetLength(e,f);');
Add(' if low(g)=high(h)+length(i) then');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_NestedFuncResult;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('type');
Add(' {#integer_used}integer = longint;');
Add(' {#tarrayint_used}TArrayInt = array of integer;');
Add(' function {#nestedfunc_used}NestedFunc({#b_notused}b: longint): TArrayInt;');
Add(' begin');
Add(' end;');
Add('var');
Add(' {#d_used}d: longint;');
Add('begin');
Add(' NestedFunc(d);');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_Enums;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt(const o);');
Add('type');
Add(' {#TEnum_used}TEnum = (red,blue);');
Add(' {#TEnums_used}TEnums = set of TEnum;');
Add('var');
Add(' {#a_used}a: TEnum;');
Add(' {#b_used}b: TEnums;');
Add(' {#c_used}c: TEnum;');
Add(' {#d_used}d: TEnums;');
Add(' {#e_used}e: TEnums;');
Add(' {#f_used}f: TEnums;');
Add(' {#g_used}g: TEnum;');
Add(' {#h_used}h: TEnum;');
Add('begin');
Add(' b:=[a];');
Add(' if c in d then;');
Add(' if low(e)=high(f) then;');
Add(' if pred(g)=succ(h) then;');
Add('end;');
Add('var {#s_used}s: string;');
Add('begin');
Add(' DoIt(s);');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_ProcedureType;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt;');
Add('type');
Add(' {#TProc_used}TProc = procedure;');
Add(' {#TFunc_used}TFunc = function(): longint;');
Add('var');
Add(' {#p_used}p: TProc;');
Add(' {#f_used}f: TFunc;');
Add('begin');
Add(' p:=nil;');
Add(' f:=nil;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_AnonymousProc;
begin
StartProgram(false);
Add([
'type',
' {#TProc_used}TProc = reference to procedure;',
'procedure {#DoIt_used}DoIt;',
'var',
' {#p_used}p: TProc;',
' {#i_used}i: longint;',
'begin',
' p:=procedure',
' begin',
' i:=3;',
' end;',
'end;',
'begin',
' DoIt;']);
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_Params;
begin
StartProgram(false);
Add('procedure {#DoIt_used}DoIt(const o);');
Add('type');
Add(' {#TEnum_used}TEnum = (red,blue);');
Add('var');
Add(' {#a_used}a: longint;');
Add(' {#b_used}b: string;');
Add(' {#c_used}c: longint;');
Add(' {#d_used}d: TEnum;');
Add('begin');
Add(' DoIt(a);');
Add(' DoIt(b[c]);');
Add(' DoIt([d]);');
Add(' DoIt(red);');
Add('end;');
Add('var {#s_used}s: string;');
Add('begin');
Add(' DoIt(s);');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_Class;
begin
StartProgram(false);
Add('type');
Add(' {#integer_used}integer = longint;');
Add(' {tobject_used}TObject = class');
Add(' {#a_used}a: integer;');
Add(' end;');
Add('var Obj: TObject;');
Add('begin');
Add(' Obj.a:=3;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_ClassForward;
begin
StartProgram(false);
Add('type');
Add(' {#integer_notused}integer = longint;');
Add(' {#TObject_used}TObject = class end;');
Add(' TFelidae = class;');
Add(' {#TCheetah_used}TCheetah = class');
Add(' public');
Add(' {#i_notused}i: integer;');
Add(' {#f_used}f: TFelidae;');
Add(' end;');
Add(' {TFelidae_used}TFelidae = class');
Add(' end;');
Add('var {#c_used}c: TCheetah;');
Add('begin');
Add(' c.f:=nil;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_Class_Property;
begin
StartProgram(false);
Add('type');
Add(' {#integer_used}integer = longint;');
Add(' {tobject_used}TObject = class');
Add(' {#fa_used}Fa: integer;');
Add(' {#fb_used}Fb: integer;');
Add(' {#fc_used}Fc: integer;');
Add(' {#fd_used}Fd: integer;');
Add(' {#fe_notused}Fe: integer;');
Add(' function {#getfc_used}GetFC: integer;');
Add(' procedure {#setfd_used}SetFD({#setfd_value_used}Value: integer);');
Add(' property {#A_used}A: integer read Fa write Fb;');
Add(' property {#C_used}C: integer read GetFC write SetFD;');
Add(' end;');
Add('function TObject.GetFC: integer;');
Add('begin');
Add(' Result:=Fc;');
Add('end;');
Add('procedure TObject.SetFD({#setfd_value_impl_notused}Value: integer);');
Add('begin');
Add(' Fd:=Value;');
Add('end;');
Add('var Obj: TObject;');
Add('begin');
Add(' Obj.A:=Obj.A;');
Add(' Obj.C:=Obj.C;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_Class_PropertyProtected;
begin
StartUnit(false);
Add([
'interface',
'type',
' {#integer_used}integer = longint;',
' {tobject_used}TObject = class',
' private',
' {#fb_used}Fb: integer;',
' {#fc_used}Fc: integer;',
' {#fd_used}Fd: integer;',
' {#fe_notused}Fe: integer;',
' function {#iscstored_used}IsCStored: boolean;',
' protected',
' property {#C_used}C: integer read FC write FD stored IsCStored;',
' end;',
'implementation',
'function TObject.IsCStored: boolean;',
'begin',
' Result:=Fb<>0;',
'end;']);
AnalyzeUnit;
end;
procedure TTestUseAnalyzer.TestM_Class_PropertyOverride;
begin
StartProgram(false);
Add('type');
Add(' {#integer_used}integer = longint;');
Add(' {tobject_used}TObject = class');
Add(' {#fa_used}FA: integer;');
Add(' {#fb_notused}FB: integer;');
Add(' property {#obj_a_notused}A: integer read FA write FB;');
Add(' end;');
Add(' {tmobile_used}TMobile = class(TObject)');
Add(' {#fc_used}FC: integer;');
Add(' property {#mob_a_used}A write FC;');
Add(' end;');
Add('var {#m_used}M: TMobile;');
Add('begin');
Add(' M.A:=M.A;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_Class_MethodOverride;
begin
StartProgram(false);
Add('type');
Add(' {tobject_used}TObject = class');
Add(' procedure {#obj_doa_used}DoA; virtual; abstract;');
Add(' procedure {#obj_dob_notused}DoB; virtual; abstract;');
Add(' end;');
Add(' {tmobile_used}TMobile = class(TObject)');
Add(' constructor {#mob_create_used}Create;');
Add(' procedure {#mob_doa_used}DoA; override;');
Add(' procedure {#mob_dob_used}DoB; override;');
Add(' end;');
Add('constructor TMobile.Create; begin end;');
Add('procedure TMobile.DoA; begin end;');
Add('procedure TMobile.DoB; begin end;');
Add('var {#o_used}o: TObject;');
Add('begin');
Add(' o:=TMobile.Create;'); // use TMobile before o.DoA
Add(' o.DoA;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_Class_MethodOverride2;
begin
StartProgram(false);
Add('type');
Add(' {#tobject_used}TObject = class');
Add(' procedure {#obj_doa_used}DoA; virtual; abstract;');
Add(' end;');
Add(' {#tmobile_used}TMobile = class(TObject)');
Add(' constructor {#mob_create_used}Create;');
Add(' procedure {#mob_doa_used}DoA; override;');
Add(' end;');
Add('constructor TMobile.Create; begin end;');
Add('procedure TMobile.DoA; begin end;');
Add('var {#o_used}o: TObject;');
Add('begin');
Add(' o.DoA;');
Add(' o:=TMobile.Create;'); // use TMobile after o.DoA
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_ClassInterface_Corba;
begin
StartProgram(false);
Add([
'{$interfaces corba}',
'type',
' {#iunknown_used}IUnknown = interface',
' procedure {#iunknown_run_used}Run;',
' procedure {#iunknown_walk_notused}Walk;',
' end;',
' {#tobject_used}TObject = class',
' end;',
' {#tbird_used}TBird = class(TObject,IUnknown)',
' strict private',
' procedure IUnknown.Run = Fly;',
' procedure {#tbird_fly_used}Fly; virtual; abstract;',
' procedure {#tbird_walk_used}Walk; virtual; abstract;',
' end;',
' {#teagle_used}TEagle = class(TBird)',
' strict private',
' procedure {#teagle_fly_used}Fly; override;',
' procedure {#teagle_walk_used}Walk; override;',
' end;',
'procedure TEagle.Fly; begin end;',
'procedure TEagle.Walk; begin end;',
'var',
' e: TEagle;',
' i: IUnknown;',
'begin',
' i:=e;',
' i.Run;',
'']);
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_ClassInterface_NoHintsForMethod;
begin
StartUnit(false);
Add([
'{$interfaces corba}',
'interface',
'type',
' {#iunknown_used}IUnknown = interface',
' procedure {#iunknown_run_used}Run(i: longint);',
' function {#iunknown_walk_used}Walk: boolean;',
' end;',
'implementation',
'']);
AnalyzeUnit;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_ClassInterface_NoHintsForImpl;
begin
AddModuleWithIntfImplSrc('unit2.pp',
LinesToStr([
'{$interfaces corba}',
'type',
' IBird = interface',
' procedure DoIt;',
' end;',
'']),
LinesToStr([
'']));
StartUnit(true);
Add([
'{$interfaces corba}',
'interface',
'uses unit2;',
'type',
' {#tobject_used}TObject = class(IBird)',
' strict private',
' procedure {#tobject_doit_used}DoIt;',
' end;',
'implementation',
'procedure TObject.DoIt; begin end;',
'']);
AnalyzeUnit;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_ClassInterface_Delegation;
begin
StartProgram(false);
Add([
'{$interfaces corba}',
'type',
' {#iunknown_used}IUnknown = interface',
' procedure {#iunknown_run_used}Run;',
' procedure {#iunknown_walk_notused}Walk;',
' end;',
' {#tobject_used}TObject = class',
' end;',
' {#tbird_used}TBird = class(TObject,IUnknown)',
' strict private',
' procedure IUnknown.Run = Fly;',
' procedure {#tbird_fly_used}Fly;',
' procedure {#tbird_walk_used}Walk;',
' end;',
' {#teagle_used}TEagle = class(TObject,IUnknown)',
' strict private',
' {#teagle_fbird_used}FBird: TBird;',
' property {#teagle_bird_used}Bird: TBird read FBird implements IUnknown;',
' end;',
'procedure TBird.Fly; begin end;',
'procedure TBird.Walk; begin end;',
'var',
' e: TEagle;',
' i: IUnknown;',
'begin',
' i:=e;',
' i.Run;',
'']);
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_ClassInterface_COM;
begin
StartProgram(false);
Add([
'{$interfaces com}',
'type',
' {#tguid_used}TGuid = string;',
' {#integer_used}integer = longint;',
' {#iunknown_used}IUnknown = interface',
' function {#iunknown_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
' function {#iunknown_addref_used}_AddRef: Integer;',
' function {#iunknown_release_used}_Release: Integer;',
' procedure {#iunknown_doit_notused}DoIt;',
' end;',
' {#tobject_used}TObject = class',
' end;',
' {#tbird_used}TBird = class(TObject,IUnknown)',
' strict private',
' function {#tbird_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
' function {#tbird_addref_used}_AddRef: Integer;',
' function {#tbird_release_used}_Release: Integer;',
' procedure {#tbird_doit_used}DoIt;',
' end;',
' {#teagle_used}TEagle = class(TBird)',
' end;',
'function TBird.QueryInterface(const iid: TGuid; out obj): Integer;',
'begin',
' if iid='''' then obj:=nil;',
' Result:=0;',
'end;',
'function TBird._AddRef: Integer; begin Result:=1; end;',
'function TBird._Release: Integer; begin Result:=2; end;',
'procedure TBird.DoIt; begin end;',
'var',
' e: TEagle;',
' i: IUnknown;',
'begin',
' i:=e;',
' if i=nil then ;',
'']);
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local procedure "DoIt" not used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_TryExceptStatement;
begin
StartProgram(false);
Add('type');
Add(' {tobject_used}TObject = class');
Add(' constructor Create; external name ''create'';');
Add(' end;');
Add(' {texception_used}Exception = class(TObject);');
Add(' {tdivbyzero_used}EDivByZero = class(Exception);');
Add('procedure {#DoIt_used}DoIt;');
Add('var');
Add(' {#a_used}a: Exception;');
Add(' {#b_used}b: Exception;');
Add(' {#c_used}c: Exception;');
Add(' {#d_used}d: Exception;');
Add(' {#f_used}f: Exception;');
Add('begin');
Add(' try');
Add(' a:=nil;');
Add(' except');
Add(' raise b;');
Add(' end;');
Add(' try');
Add(' if Assigned(c) then ;');
Add(' except');
Add(' on {#e1_used}E1: Exception do raise;');
Add(' on {#e2_notused}E2: EDivByZero do raise d;');
Add(' else f:=nil;');
Add(' end;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
end;
procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed;
begin
AddModuleWithIntfImplSrc('unit2.pp',
LinesToStr([
'var i: longint;',
'procedure DoIt;',
'']),
LinesToStr([
'procedure DoIt; begin end;']));
StartProgram(true);
Add('uses unit2;');
Add('begin');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPAUnitNotUsed,'Unit "unit2" not used in afile');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_UnitNotUsed_No_OnlyExternal;
begin
AddModuleWithIntfImplSrc('unit2.pp',
LinesToStr([
'var State: longint; external name ''state'';',
'procedure DoIt; external name ''doing'';',
'']),
LinesToStr([
]));
StartProgram(true);
Add('uses unit2;');
Add('begin');
Add(' State:=3;');
Add(' DoIt;');
AnalyzeProgram;
// unit hints: no hint, even though no code is actually used
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_UnitUsed;
begin
AddModuleWithIntfImplSrc('unit2.pp',
LinesToStr([
'var i: longint;',
'']),
LinesToStr(['']));
StartProgram(true);
Add('uses unit2;');
Add('begin');
Add(' i:=3;');
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_UnitUsedVarArgs;
begin
AddModuleWithIntfImplSrc('unit2.pp',
LinesToStr([
'var i: longint;',
'']),
LinesToStr(['']));
StartProgram(true);
Add('uses unit2;');
Add('procedure Writeln(); varargs;');
Add('begin end;');
Add('begin');
Add(' writeln(i);');
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed;
begin
StartProgram(true);
Add('procedure DoIt(i: longint);');
Add('begin end;');
Add('begin');
Add(' DoIt(1);');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPAParameterNotUsed,'Parameter "i" not used');
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);
Add([
'type',
' TObject = class',
' procedure DoIt(i: longint); virtual;',
' end;',
' TBird = class',
' procedure DoIt(j: longint); override;',
' end;',
'procedure TObject.DoIt(i: longint);',
'begin',
'end;',
'procedure TBird.DoIt(j: longint);',
'begin',
'end;',
'var b: TBird;',
'begin',
' TObject(b).DoIt(1);']);
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPAParameterInOverrideNotUsed,'Parameter "i" not used');
CheckUseAnalyzerHint(mtHint,nPAParameterInOverrideNotUsed,'Parameter "j" not used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_ParameterAssignedButNotReadVarParam;
begin
StartUnit(false);
Add([
'interface',
'procedure DoIt(i: longint);',
'implementation',
'procedure DoIt(i: longint);',
'begin',
'{$Hints off}',
'end;',
'begin',
' DoIt(3);']);
AnalyzeUnit;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsed_Abstract;
begin
StartProgram(true);
Add('type');
Add(' TObject = class');
Add(' class procedure DoIt(i: longint); virtual; abstract;');
Add(' end;');
Add('begin');
Add(' TObject.DoIt(3);');
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_ParameterNotUsedTypecast;
begin
StartProgram(true);
Add('type');
Add(' TObject = class end;');
Add(' TSortCompare = function(a,b: Pointer): integer;');
Add(' TObjCompare = function(a,b: TObject): integer;');
Add('procedure Sort(const Compare: TSortCompare);');
Add('begin');
Add(' Compare(nil,nil);');
Add('end;');
Add('procedure DoIt(const Compare: TObjCompare);');
Add('begin');
Add(' Sort(TSortCompare(Compare));');
Add('end;');
Add('begin');
Add(' DoIt(nil);');
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_OutParam_No_AssignedButNeverUsed;
begin
StartProgram(true);
Add('procedure DoIt(out x: longint);');
Add('begin');
Add(' x:=3;');
Add('end;');
Add('var i: longint;');
Add('begin');
Add(' DoIt(i);');
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_ArgPassed_No_ParameterNotUsed;
begin
StartProgram(false);
Add([
'procedure AssertTrue(b: boolean);',
'begin',
' if b then ;',
'end;',
'procedure AssertFalse(b: boolean);',
'begin',
' AssertTrue(not b);',
'end;',
'begin',
' AssertFalse(true);',
'']);
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_ArrayArg_No_ParameterNotUsed;
begin
StartProgram(false);
Add([
'type TArr = array of boolean;',
'procedure Fly(a: TArr);',
'begin',
' a[1]:=true;',
'end;',
'begin',
' Fly(nil);',
'']);
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_ArrayArg_No_ParameterNotUsed2;
begin
StartProgram(false);
Add([
'type {#Tarr_used}TArr = array of boolean;',
'procedure {#Run_used}Run({#b_used}b: boolean);',
'begin',
' if b then ;',
'end;',
'procedure {#Fly_used}Fly({#a_used}a: TArr);',
'begin',
' Run(a[1]);',
'end;',
'begin',
' Fly(nil);',
'']);
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_InheritedWithoutParams;
begin
StartProgram(false);
Add([
'type',
' TObject = class',
' constructor Create(i: longint); virtual;',
' end;',
' TBird = class',
' constructor Create(i: longint); override;',
' end;',
'constructor TObject.Create(i: longint);',
'begin',
' if i=0 then ;',
'end;',
'constructor TBird.Create(i: longint);',
'begin',
' inherited;',
'end;',
'begin',
' TBird.Create(3);']);
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_LocalVariableNotUsed;
begin
StartProgram(true);
Add([
'procedure DoIt;',
'const',
' a = 13;',
' b: longint = 14;',
'var',
' c: char;',
' d: longint = 15;',
'begin',
'end;',
'begin',
' DoIt;']);
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "a" not used');
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "b" not used');
CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "c" not used');
CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "d" not used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_HintsOff_LocalVariableNotUsed;
begin
StartProgram(true);
Add([
'procedure DoIt;',
'const',
' a = 13;',
' b: longint = 14;',
'var',
' c: char;',
' d: longint = 15;',
'begin',
'{$Hints off}',
'end;',
'begin',
' DoIt;']);
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_ForVar_No_LocalVariableNotUsed;
begin
StartProgram(false);
Add([
'procedure DoIt;',
'var i: longint;',
'begin',
' for i:=1 to 2 do ;',
'end;',
'begin',
' DoIt;',
'']);
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_InterfaceUnitVariableUsed;
begin
StartUnit(true);
Add('interface');
Add('const {#a_used}a = 1;');
Add('const {#b_used}b: longint = 2;');
Add('var {#c_used}c: longint = 3;');
Add('type');
Add(' {#TColor_used}TColor = longint;');
Add(' {#TFlag_used}TFlag = (red,green);');
Add(' {#TFlags_used}TFlags = set of TFlag;');
Add(' {#TArrInt_used}TArrInt = array of integer;');
Add('implementation');
Add('const {#d_notused}d = 1;');
Add('const {#e_notused}e: longint = 2;');
Add('var {#f_notused}f: longint = 3;');
Add('type');
Add(' {#ImpTColor_notused}ImpTColor = longint;');
Add(' {#ImpTFlag_notused}ImpTFlag = (red,green);');
Add(' {#ImpTFlags_notused}ImpTFlags = set of TFlag;');
Add(' {#ImpTArrInt_notused}ImpTArrInt = array of integer;');
AnalyzeUnit;
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "d" not used');
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constant "e" not used');
CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "f" not used');
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local alias type "ImpTColor" not used');
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "ImpTFlag" not used');
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local set type "ImpTFlags" not used');
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local array type "ImpTArrInt" not used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_ValueParameterIsAssignedButNeverUsed;
begin
StartProgram(true);
Add('procedure DoIt(i: longint);');
Add('begin');
Add(' i:=3;');
Add('end;');
Add('begin');
Add(' DoIt(1);');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPAValueParameterIsAssignedButNeverUsed,
'Value parameter "i" is assigned but never used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_LocalVariableIsAssignedButNeverUsed;
begin
StartProgram(true);
Add('procedure DoIt;');
Add('const');
Add(' a: longint = 14;');
Add('var');
Add(' b: char;');
Add(' c: longint = 15;');
Add('begin');
Add(' a:=16;');
Add(' b:=#65;');
Add(' c:=17;');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
'Local variable "a" is assigned but never used');
CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
'Local variable "b" is assigned but never used');
CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
'Local variable "c" is assigned but never used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_LocalXYNotUsed;
begin
StartProgram(true);
Add('procedure DoIt;');
Add('type');
Add(' TColor = longint;');
Add(' TFlag = (red,green);');
Add(' TFlags = set of TFlag;');
Add(' TArrInt = array of integer;');
Add(' procedure Sub; begin end;');
Add('begin');
Add('end;');
Add('begin');
Add(' DoIt;');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local alias type "TColor" not used');
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local enumeration type "TFlag" not used');
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local set type "TFlags" not used');
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local array type "TArrInt" not used');
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local procedure "Sub" not used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsNeverUsed;
begin
StartProgram(true,[supTObject]);
Add('type');
Add(' TMobile = class');
Add(' private');
Add(' a: longint;');
Add(' end;');
Add('var m: TMobile;');
Add('begin');
Add(' m:=nil;');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsNeverUsed,
'Private field "TMobile.a" is never used');
CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
'Local variable "m" is assigned but never used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_PrivateFieldIsAssignedButNeverUsed;
begin
StartProgram(true,[supTObject]);
Add('type');
Add(' TMobile = class');
Add(' private');
Add(' a: longint;');
Add(' public');
Add(' constructor Create;');
Add(' end;');
Add('constructor TMobile.Create;');
Add('begin');
Add(' a:=3;');
Add('end;');
Add('begin');
Add(' TMobile.Create;');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsAssignedButNeverUsed,
'Private field "TMobile.a" is assigned but never used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.
TestM_Hint_PrivateFieldExtClassNoIsAssignedButNeverUsed;
begin
StartProgram(false,[]);
Add([
'{$modeswitch externalclass}',
'type',
' TMobile = class external name ''foo''',
' private',
' FA: longint;',
' public',
' property A: longint write FA;',
' end;',
'var m: TMobile;',
'begin',
' m.A:=3;',
'']);
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_PrivateMethodIsNeverUsed;
begin
StartProgram(true,[supTObject]);
Add('type');
Add(' TMobile = class');
Add(' private');
Add(' procedure DoSome; external name ''foo'';');
Add(' public');
Add(' constructor Create;');
Add(' end;');
Add('constructor TMobile.Create;');
Add('begin');
Add('end;');
Add('begin');
Add(' TMobile.Create;');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPAPrivateMethodIsNeverUsed,
'Private method "TMobile.DoSome" is never used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_LocalDestructor_No_IsNeverUsed;
begin
StartProgram(true,[supTObject]);
Add('type');
Add(' TMobile = class');
Add(' private');
Add(' public');
Add(' constructor Create;');
Add(' destructor Destroy; override;');
Add(' end;');
Add('var DestroyCount: longint = 0;');
Add('constructor TMobile.Create;');
Add('begin');
Add('end;');
Add('destructor TMobile.Destroy;');
Add('begin');
Add(' inc(DestroyCount);');
Add(' inherited;');
Add('end;');
Add('var o: TObject;');
Add('begin');
Add(' o:=TMobile.Create;');
Add(' o.Destroy;');
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_PrivateTypeNeverUsed;
begin
StartProgram(true,[supTObject]);
Add('type');
Add(' TMobile = class');
Add(' private');
Add(' type t = longint;');
Add(' public');
Add(' constructor Create;');
Add(' end;');
Add('constructor TMobile.Create;');
Add('begin');
Add('end;');
Add('begin');
Add(' TMobile.Create;');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPAPrivateTypeXNeverUsed,
'Private type "TMobile.t" never used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_PrivateConstNeverUsed;
begin
StartProgram(true,[supTObject]);
Add('type');
Add(' TMobile = class');
Add(' private');
Add(' const c = 3;');
Add(' public');
Add(' constructor Create;');
Add(' end;');
Add('constructor TMobile.Create;');
Add('begin');
Add('end;');
Add('begin');
Add(' TMobile.Create;');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPAPrivateConstXNeverUsed,
'Private const "TMobile.c" never used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_PrivatePropertyNeverUsed;
begin
StartProgram(true,[supTObject]);
Add('type');
Add(' TMobile = class');
Add(' private');
Add(' FA: longint;');
Add(' property A: longint read FA;');
Add(' public');
Add(' constructor Create;');
Add(' end;');
Add('constructor TMobile.Create;');
Add('begin');
Add('end;');
Add('begin');
Add(' TMobile.Create;');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPAPrivatePropertyXNeverUsed,
'Private property "TMobile.A" never used');
CheckUseAnalyzerHint(mtHint,nPAPrivateFieldIsNeverUsed,
'Private field "TMobile.FA" is never used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_LocalClassInProgramNotUsed;
begin
StartProgram(true,[supTObject]);
Add('type');
Add(' TMobile = class');
Add(' public');
Add(' constructor Create;');
Add(' end;');
Add('constructor TMobile.Create;');
Add('begin');
Add('end;');
Add('var');
Add(' m: TMobile;');
Add('begin');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local class "TMobile" not used');
CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "m" not used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_LocalMethodInProgramNotUsed;
begin
StartProgram(true,[supTObject]);
Add('type');
Add(' TMobile = class');
Add(' public');
Add(' constructor Create;');
Add(' end;');
Add('constructor TMobile.Create;');
Add('begin');
Add('end;');
Add('var');
Add(' m: TMobile;');
Add('begin');
Add(' if m=nil then ;');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local constructor "Create" not used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_LocalVarOfNotUsedProc;
begin
StartProgram(true,[]);
Add('type');
Add('procedure DoIt;');
Add('var i: longint;');
Add('begin');
Add('end;');
Add('begin');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPALocalXYNotUsed,'Local procedure "DoIt" not used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_LocalVarOfNotUsedMethod;
begin
StartProgram(true,[supTObject]);
Add('type');
Add(' TMobile = class');
Add(' private');
Add(' procedure DoIt;');
Add(' end;');
Add('procedure TMobile.DoIt;');
Add('var i: longint;');
Add('begin');
Add('end;');
Add('var');
Add(' m: TMobile;');
Add('begin');
Add(' if m=nil then ;');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPAPrivateMethodIsNeverUsed,'Private method "TMobile.DoIt" is never used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_AssemblerParameterIgnored;
begin
StartProgram(true);
Add('procedure DoIt(i: longint); assembler;');
Add('type');
Add(' {#tcolor_notused}TColor = longint;');
Add(' {#tflag_notused}TFlag = (red,green);');
Add(' {#tflags_notused}TFlags = set of TFlag;');
Add(' {#tarrint_notused}TArrInt = array of integer;');
Add('const');
Add(' {#a_notused}a = 13;');
Add(' {#b_notused}b: longint = 14;');
Add('var');
Add(' {#c_notused}c: char;');
Add(' {#d_notused}d: longint = 15;');
Add(' procedure {#sub_notused}Sub; begin end;');
Add('asm end;');
Add('begin');
Add(' DoIt(1);');
AnalyzeProgram;
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);
Add('function DoIt: longint;');
Add('begin end;');
Add('begin');
Add(' DoIt();');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPAFunctionResultDoesNotSeemToBeSet,
sPAFunctionResultDoesNotSeemToBeSet);
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_FunctionResultDoesNotSeemToBeSet_Abstract;
begin
StartProgram(true);
Add('type');
Add(' TObject = class');
Add(' class function DoIt: longint; virtual; abstract;');
Add(' end;');
Add('begin');
Add(' TObject.DoIt;');
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_FunctionResultRecord;
begin
StartProgram(true);
Add('type');
Add(' TPoint = record X,Y:longint; end;');
Add('function Point(Left: longint): TPoint;');
Add('begin');
Add(' Result.X:=Left;');
Add('end;');
Add('begin');
Add(' Point(1);');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPALocalVariableIsAssignedButNeverUsed,
'Local variable "X" is assigned but never used');
CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_FunctionResultPassRecordElement;
begin
StartProgram(true);
Add('type');
Add(' TPoint = record X,Y:longint; end;');
Add('procedure Three(out x: longint);');
Add('begin');
Add(' x:=3;');
Add('end;');
Add('function Point(): TPoint;');
Add('begin');
Add(' Three(Result.X)');
Add('end;');
Add('begin');
Add(' Point();');
AnalyzeProgram;
CheckUseAnalyzerHint(mtHint,nPALocalVariableNotUsed,'Local variable "Y" not used');
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_FunctionResultAssembler;
begin
StartProgram(false);
Add([
'function GetIt: longint; assembler;',
'asm',
'end;',
'begin',
' GetIt;']);
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_FunctionResultExit;
begin
StartProgram(false);
Add([
'function GetIt: longint;',
'begin',
' exit(3);',
'end;',
'begin',
' GetIt;']);
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_Hint_AbsoluteVar;
begin
StartProgram(false);
Add([
'procedure {#DoIt_used}DoIt({#p_used}p: pointer);',
'var',
' {#i_used}i: longint absolute p;',
' {#j_used}j: longint absolute i;',
'begin',
' if j=3 then ;',
'end;',
'begin',
' DoIt(nil);']);
AnalyzeProgram;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestWP_LocalVar;
begin
StartProgram(false);
Add('var {#a_notused}a: longint;');
Add('var {#b_used}b: longint;');
Add('var {#c_used}c: longint;');
Add('begin');
Add(' b:=2;');
Add(' afile.c:=3;');
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_UnitUsed;
begin
AddModuleWithIntfImplSrc('unit2.pp',
LinesToStr([
'var i: longint;',
'procedure DoIt;',
'']),
LinesToStr([
'procedure DoIt; begin end;']));
StartProgram(true);
Add('uses unit2;');
Add('begin');
Add(' i:=3;');
AnalyzeWholeProgram;
CheckUnitUsed('unit2.pp',true);
end;
procedure TTestUseAnalyzer.TestWP_UnitUsed_ResourceString;
begin
AddModuleWithIntfImplSrc('unit2.pp',
LinesToStr([
'resourcestring rs = ''txt'';',
'procedure DoIt;',
'']),
LinesToStr([
'procedure DoIt; begin end;']));
StartProgram(true);
Add('uses unit2;');
Add('begin');
Add(' if rs='''' then ;');
AnalyzeWholeProgram;
CheckUnitUsed('unit2.pp',true);
end;
procedure TTestUseAnalyzer.TestWP_UnitNotUsed;
begin
AddModuleWithIntfImplSrc('unit2.pp',
LinesToStr([
'var i: longint;',
'procedure DoIt;',
'']),
LinesToStr([
'procedure DoIt; begin end;']));
StartProgram(true);
Add('uses');
Add(' unit2;');
Add('begin');
AnalyzeWholeProgram;
CheckUnitUsed('unit2.pp',false);
end;
procedure TTestUseAnalyzer.TestWP_UnitInitialization;
begin
AddModuleWithIntfImplSrc('unit2.pp',
LinesToStr([
'var i: longint;',
'']),
LinesToStr([
'']));
AddModuleWithIntfImplSrc('unit1.pp',
LinesToStr([
'uses unit2;',
'']),
LinesToStr([
'initialization',
'i:=2;']));
StartProgram(true);
Add('uses unit1;');
Add('begin');
AnalyzeWholeProgram;
CheckUnitUsed('unit1.pp',true);
CheckUnitUsed('unit2.pp',true);
end;
procedure TTestUseAnalyzer.TestWP_UnitFinalization;
begin
AddModuleWithIntfImplSrc('unit1.pp',
LinesToStr([
'uses unit2;',
'']),
LinesToStr([
'finalization',
'i:=2;']));
AddModuleWithIntfImplSrc('unit2.pp',
LinesToStr([
'var i: longint;',
'']),
LinesToStr([
'']));
StartProgram(true);
Add('uses unit1;');
Add('begin');
AnalyzeWholeProgram;
CheckUnitUsed('unit1.pp',true);
CheckUnitUsed('unit2.pp',true);
end;
procedure TTestUseAnalyzer.TestWP_CallInherited;
begin
StartProgram(false);
Add('type');
Add(' {#TObject_used}TObject = class');
Add(' procedure {#TObjectDoA_used}DoA;');
Add(' procedure {#TObjectDoB_used}DoB;');
Add(' end;');
Add(' {#TMobile_used}TMobile = class');
Add(' procedure {#TMobileDoA_used}DoA;');
Add(' procedure {#TMobileDoC_used}DoC;');
Add(' end;');
Add('procedure TObject.DoA; begin end;');
Add('procedure TObject.DoB; begin end;');
Add('procedure TMobile.DoA;');
Add('begin');
Add(' inherited;');
Add('end;');
Add('procedure TMobile.DoC;');
Add('begin');
Add(' inherited DoB;');
Add('end;');
Add('var o: TMobile;');
Add('begin');
Add(' o.DoA;');
Add(' o.DoC;');
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ProgramPublicDeclarations;
begin
StartProgram(false);
Add('var');
Add(' {#vPublic_used}vPublic: longint; public;');
Add(' {#vPrivate_notused}vPrivate: longint;');
Add('procedure {#DoPublic_used}DoPublic; public; begin end;');
Add('procedure {#DoPrivate_notused}DoPrivate; begin end;');
Add('begin');
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassOverride;
begin
StartProgram(false);
Add([
'type',
' {#TObject_used}TObject = class',
' protected',
' function {#TObject_getcount_used}GetCount: longint; virtual; abstract;',
' public',
' property {#TObject_count_used}Count: longint read GetCount;',
' end;',
'',
' {#tb_used}TB = class(TObject)',
' private',
' {#tb_fcount_used}FCount: longint;',
' protected',
' function {#tb_getcount_used}GetCount: longint; override;',
' end;',
'',
'function TB.GetCount: longint;',
'begin',
' Result:=FCount;',
'end;',
'',
'procedure {#doit_used}DoIt;',
'var',
' {#l_used}l: TB;',
'begin',
' if l.count=3 then ;',
'end;',
'',
'begin',
' DoIt;']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassDefaultProperty;
begin
StartProgram(false);
Add('type');
Add(' {#tobject_used}TObject = class');
Add(' function {#getitems_notused}Getitems(Index: longint): string;');
Add(' procedure {#setitems_used}Setitems(Index: longint; Value: String);');
Add(' property {#items_used}Items[Index: longint]: string read GetItems write SetItems; default;');
Add(' end;');
Add('function TObject.Getitems(Index: longint): string; begin end;');
Add('procedure TObject.Setitems(Index: longint; Value: String); begin end;');
Add('var');
Add(' {#l_used}L: TObject;');
Add('begin');
Add(' L[0]:=''birdy'';');
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_BeforeConstruction;
begin
StartProgram(false);
Add([
'type',
' {#tobject_used}TObject = class',
' procedure {#oAfter_used}AfterConstruction; virtual;',
' procedure {#oBefore_used}BeforeDestruction; virtual;',
' procedure {#oFree_used}Free;',
' constructor {#oCreate_used}Create;',
' destructor {#oDestroy_used}Destroy; virtual;',
' procedure {#oDoIt_notused}DoIt; virtual; abstract;',
' end;',
' TBird = class',
' procedure {#bAfter_used}AfterConstruction; override;',
' procedure {#bBefore_used}BeforeDestruction; override;',
' end;',
'procedure TObject.AfterConstruction; begin end;',
'procedure TObject.BeforeDestruction; begin end;',
'procedure TObject.Free; begin Destroy; end;',
'constructor TObject.Create; begin end;',
'destructor TObject.Destroy; begin end;',
'procedure TBird.AfterConstruction; begin end;',
'procedure TBird.BeforeDestruction; begin end;',
'var',
' {#b_used}b: TBird;',
'begin',
' b:=TBird.Create;',
' b.Free;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_Published;
begin
StartProgram(false);
Add('type');
Add(' {#tobject_used}TObject = class');
Add(' private');
Add(' {#fcol_used}FCol: string;');
Add(' {#fbird_notused}FBird: string;');
Add(' published');
Add(' {#fielda_used}FieldA: longint;');
Add(' procedure {#doit_used}ProcA; virtual; abstract;');
Add(' property {#col_used}Col: string read FCol;');
Add(' end;');
Add('var');
Add(' {#o_used}o: TObject;');
Add('begin');
Add(' o:=nil;');
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_PublishedSetType;
begin
StartProgram(false);
Add('type');
Add(' {#tflag_used}TFlag = (red, green);');
Add(' {#tflags_used}TFlags = set of TFlag;');
Add(' {#tobject_used}TObject = class');
Add(' published');
Add(' {#fielda_used}FieldA: TFlag;');
Add(' {#fieldb_used}FieldB: TFlags;');
Add(' end;');
Add('var');
Add(' {#o_used}o: TObject;');
Add('begin');
Add(' o:=nil;');
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_PublishedArrayType;
begin
StartProgram(false);
Add('type');
Add(' {#tdynarr_used}TDynArr = array of longint;');
Add(' {#tstatarr_used}TStatArr = array[boolean] of longint;');
Add(' {#tobject_used}TObject = class');
Add(' published');
Add(' {#fielda_used}FieldA: TDynArr;');
Add(' {#fieldb_used}FieldB: TStatArr;');
Add(' end;');
Add('var');
Add(' {#o_used}o: TObject;');
Add('begin');
Add(' o:=nil;');
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_PublishedClassOfType;
begin
StartProgram(false);
Add('type');
Add(' {#tobjectclass_used}TObjectClass = class of TObject;');
Add(' {#tobject_used}TObject = class');
Add(' published');
Add(' {#fielda_used}FieldA: TObjectClass;');
Add(' end;');
Add(' {#tclass_used}TClass = class of TObject;');
Add('var');
Add(' {#c_used}c: TClass;');
Add('begin');
Add(' c:=nil;');
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_PublishedRecordType;
begin
StartProgram(false);
Add([
'type',
' {#trec_used}TRec = record',
' {treci_used}i: longint;',
' end;',
'const c: TRec = (i:1);',
'type',
' {#tobject_used}TObject = class',
' published',
' {#fielda_used}FieldA: TRec;',
' end;',
'var',
' {#o_used}o: TObject;',
'begin',
' o:=nil;']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_PublishedProcType;
begin
StartProgram(false);
Add('type');
Add(' {#ta_used}ta = array of longint;');
Add(' {#tb_used}tb = array of longint;');
Add(' {#tproca_used}TProcA = procedure;');
Add(' {#tfunca_used}TFuncA = function: ta;');
Add(' {#tprocb_used}TProcB = procedure(a: tb);');
Add(' {#tobject_used}TObject = class');
Add(' published');
Add(' {#fielda_used}FieldA: TProcA;');
Add(' {#fieldb_used}FieldB: TFuncA;');
Add(' {#fieldc_used}FieldC: TProcB;');
Add(' end;');
Add('var');
Add(' {#o_used}o: TObject;');
Add('begin');
Add(' o:=nil;');
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_PublishedProperty;
begin
StartProgram(false);
Add('const');
Add(' {#defcol_used}DefCol = 3;');
Add(' {#defsize_notused}DefSize = 43;');
Add('type');
Add(' {#tobject_used}TObject = class');
Add(' private');
Add(' {#fcol_used}FCol: longint;');
Add(' {#fsize_used}FSize: longint;');
Add(' {#fbird_notused}FBird: string;');
Add(' {#fcolstored_used}FColStored: boolean;');
Add(' {#fsizestored_notused}FSizeStored: boolean;');
Add(' public');
Add(' property {#size_used}Size: longint read FSize stored FSizeStored default DefSize;');
Add(' published');
Add(' property {#col_used}Col: longint read FCol stored FColStored default DefCol;');
Add(' end;');
Add('var');
Add(' {#o_used}o: TObject;');
Add('begin');
Add(' if o.Size=13 then ;');
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_BuiltInFunctions;
begin
StartProgram(false);
Add([
'type',
' {#tordenum_used}TOrdEnum = (ordenum1,ordenum2);',
'begin',
' if ord(ordenum1)=1 then ;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_TypeInfo;
begin
StartProgram(false);
Add([
'type',
' {#integer_used}integer = longint;',
' {#trec_used}TRec = record',
' {#trecv_used}v: integer;',
' end;',
' {#tclass_used}TClass = class of TObject;',
' {#tobject_used}TObject = class',
' class function {#tobject_classtype_used}ClassType: TClass; virtual; abstract;',
' end;',
' {#tbirds_used}TBirds = class of TBird;',
' {#tbird_used}TBird = class',
' end;',
'function {#getbirdclass_used}GetBirdClass: TBirds;',
'begin',
' Result:=nil;',
'end;',
'var',
' {#i_used}i: integer;',
' {#s_used}s: string;',
' {#p_used}p: pointer;',
' {#r_used}r: TRec;',
' {#o_used}o: TObject;',
' {#c_used}c: TClass;',
'begin',
' p:=typeinfo(integer);',
' p:=typeinfo(longint);',
' p:=typeinfo(i);',
' p:=typeinfo(s);',
' p:=typeinfo(p);',
' p:=typeinfo(r.v);',
' p:=typeinfo(TObject.ClassType);',
' p:=typeinfo(o.ClassType);',
' p:=typeinfo(o);',
' p:=typeinfo(c);',
' p:=typeinfo(c.ClassType);',
' p:=typeinfo(GetBirdClass);',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_TypeInfo_PropertyEnumType;
begin
StartProgram(false);
Add([
'type',
' TObject = class end;',
' {#talign_typeinfo}TAlign = (alLeft,alRight);',
' {$M+}',
' TPersistent = class',
' private',
' FAlign: TAlign;',
' public',
' property {#tpersistent_align_notypeinfo}Align: TAlign read FAlign write FAlign;',
' end;',
' {$M-}',
' {#tbutton_typeinfo}TButton = class(TPersistent)',
' published',
' property {#tbutton_align_typeinfo}Align;',
' end;',
'var',
' {#p_notypeinfo}p: pointer;',
'begin',
' p:=typeinfo(TButton);',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_TypeInfo_Alias;
begin
AddModuleWithIntfImplSrc('mysystem.pp',
LinesToStr([
'type',
' integer = longint;',
' PTypeInfo = pointer;',
' {#tdatetime_typeinfo}TDateTime = type double;',
'']),
'');
AddModuleWithIntfImplSrc('unit1.pp',
LinesToStr([
'uses mysystem;',
'type',
' {#ttime_typeinfo}TTime = type TDateTime;',
' TDate = TDateTime;',
'var',
' dt: TDateTime;',
' t: TTime;',
' d: TDate;',
' TI: PTypeInfo;',
'']),'');
AddModuleWithIntfImplSrc('unit2.pp',
LinesToStr([
'uses unit1;',
'']),
LinesToStr([
'initialization',
' dt:=1.0;',
' t:=2.0;',
' d:=3.0;',
' ti:=typeinfo(dt);',
' ti:=typeinfo(t);',
' ti:=typeinfo(d);',
'']));
StartProgram(true);
Add([
'uses mysystem, unit2;',
'var',
' PInfo: PTypeInfo;',
'begin',
' PInfo:=typeinfo(TDateTime);',
'end.']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ForInClass;
begin
StartProgram(false);
Add([
'type',
' TObject = class',
' end;',
' {#tenumerator_used}TEnumerator = class',
' strict private',
' {#fcurrent_used}FCurrent: longint;',
' public',
' {#v_notused}v: string;',
' function {#movenext_used}MoveNext: boolean;',
' property {#current_used}Current: longint read FCurrent;',
' end;',
' {#tbird_used}TBird = class',
' function {#getenumerator_used}GetEnumerator: TEnumerator;',
' end;',
'function TEnumerator.MoveNext: boolean;',
'begin',
'end;',
'function TBird.GetEnumerator: TEnumerator;',
'begin',
'end;',
'var',
' {#b_used}b: TBird;',
' {#i_used}i: longint;',
'begin',
' for i in b do ;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_AssertSysUtils;
begin
AddModuleWithIntfImplSrc('SysUtils.pas',
LinesToStr([
'type',
' TObject = class',
' constructor {#a_used}Create;',
' end;',
' {#e_used}EAssertionFailed = class',
' constructor {#b_used}Create(s: string);',
' end;',
'']),
LinesToStr([
'constructor TObject.Create;',
'begin end;',
'constructor EAssertionFailed.Create(s: string);',
'begin end;',
'']) );
StartProgram(true);
Add([
'uses sysutils;',
'procedure DoIt;',
'var',
' b: boolean;',
' s: string;',
'begin',
' {$Assertions on}',
' Assert(b);',
' Assert(b,s);',
'end;',
'begin',
' DoIt;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_RangeErrorSysUtils;
begin
AddModuleWithIntfImplSrc('SysUtils.pas',
LinesToStr([
'type',
' TObject = class',
' constructor {#a_used}Create;',
' end;',
' {#e_used}ERangeError = class',
' end;',
'']),
LinesToStr([
'constructor TObject.Create;',
'begin end;',
'']) );
StartProgram(true);
Add([
'uses sysutils;',
'procedure DoIt;',
'var',
' b: byte;',
'begin',
' {$R+}',
' b:=1;',
'end;',
'begin',
' DoIt;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassInterface;
begin
StartProgram(false);
Add([
'{$interfaces corba}',
'type',
' {#iunknown_used}IUnknown = interface',
' procedure {#iunknown_run_used}Run;',
' procedure {#iunknown_walk_notused}Walk;',
' end;',
' {#tobject_used}TObject = class',
' end;',
' {#tbird_used}TBird = class(TObject,IUnknown)',
' strict private',
' procedure IUnknown.Run = Fly;',
' procedure {#tbird_fly_used}Fly; virtual; abstract;',
' procedure {#tbird_walk_notused}Walk; virtual; abstract;',
' end;',
' {#teagle_used}TEagle = class(TBird)',
' strict private',
' procedure {#teagle_fly_used}Fly; override;',
' procedure {#teagle_walk_notused}Walk; override;',
' end;',
'procedure TEagle.Fly; begin end;',
'procedure TEagle.Walk; begin end;',
'var',
' e: TEagle;',
' i: IUnknown;',
'begin',
' i:=e;',
' i.Run;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassInterface_OneWayIntfToObj;
begin
StartProgram(false);
Add([
'{$interfaces corba}',
'type',
' {#iunknown_used}IUnknown = interface',
' procedure {#iunknown_run_used}Run;',
' procedure {#iunknown_walk_notused}Walk;',// not used
' end;',
' {#tobject_used}TObject = class',
' end;',
' {#tbird_used}TBird = class(TObject,IUnknown)',
' strict private',
' procedure IUnknown.Run = Fly;',
' procedure {#tbird_fly_used}Fly; virtual; abstract;',
' procedure {#tbird_walk_notused}Walk; virtual; abstract;', // used
' end;',
' {#teagle_used}TEagle = class(TBird)',
' private',
' procedure {#teagle_fly_used}Fly; override;',
' procedure {#teagle_walk_used}Walk; override;',
' end;',
'procedure TEagle.Fly; begin end;',
'procedure TEagle.Walk; begin end;',
'var',
' e: TEagle;',
' i: IUnknown;',
'begin',
' i:=e;',
' i.Run;', // using IUnknown.Walk must mark TEagle.Walk
' e.Walk;', // using TEagle.Walk must not mark IUnknown.Walk
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassInterface_Delegation;
begin
StartProgram(false);
Add([
'{$interfaces corba}',
'type',
' {#iunknown_used}IUnknown = interface',
' procedure {#iunknown_run_used}Run;',
' procedure {#iunknown_walk_notused}Walk;',
' end;',
' {#tobject_used}TObject = class',
' end;',
' {#tbird_used}TBird = class(TObject,IUnknown)',
' strict private',
' procedure IUnknown.Run = Fly;',
' procedure {#tbird_fly_used}Fly;',
' procedure {#tbird_walk_notused}Walk;',
' end;',
' {#teagle_used}TEagle = class(TObject,IUnknown)',
' strict private',
' {#teagle_fbird_used}FBird: TBird;',
' property {#teagle_bird_used}Bird: TBird read FBird implements IUnknown;',
' end;',
'procedure TBird.Fly; begin end;',
'procedure TBird.Walk; begin end;',
'var',
' e: TEagle;',
' i: IUnknown;',
'begin',
' i:=e;',
' i.Run;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassInterface_COM;
begin
StartProgram(false);
Add([
'{$interfaces com}',
'type',
' {#tguid_used}TGuid = string;',
' {#integer_used}integer = longint;',
' {#iunknown_used}IUnknown = interface',
' function {#iunknown_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
' function {#iunknown_addref_used}_AddRef: Integer;',
' function {#iunknown_release_used}_Release: Integer;',
' procedure {#iunknown_doit_notused}DoIt;',
' end;',
' {#tobject_used}TObject = class',
' end;',
' {#tbird_used}TBird = class(TObject,IUnknown)',
' strict private',
' function {#tbird_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
' function {#tbird_addref_used}_AddRef: Integer;',
' function {#tbird_release_used}_Release: Integer;',
' procedure {#tbird_doit_notused}DoIt;',
' end;',
' {#teagle_used}TEagle = class(TBird)',
' end;',
'function TBird.QueryInterface(const iid: TGuid; out obj): Integer;',
'begin',
' if iid='''' then obj:=nil;',
' Result:=0;',
'end;',
'function TBird._AddRef: Integer; begin Result:=1; end;',
'function TBird._Release: Integer; begin Result:=2; end;',
'procedure TBird.DoIt; begin end;',
'var',
' e: TEagle;',
' i: IUnknown;',
'begin',
' i:=e;',
' if i=nil then ;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassInterface_COM_Unit;
begin
AddModuleWithIntfImplSrc('SysUtils.pas',
LinesToStr([
'{$interfaces com}',
'type',
' {#tguid_used}TGuid = string;',
' {#integer_used}integer = longint;',
' {#iunknown_used}IUnknown = interface',
' function {#iunknown_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
' function {#iunknown_addref_used}_AddRef: Integer;',
' function {#iunknown_release_used}_Release: Integer;',
' procedure {#iunknown_doit_notused}DoIt;',
' end;',
' IBird = interface(IUnknown)',
' procedure {#ibird_fly_used}Fly;',
' end;',
' {#tobject_used}TObject = class',
' end;',
' {#tbird_used}TBird = class(TObject,IBird)',
' strict private',
' function {#tbird_queryintf_used}QueryInterface(const iid: TGuid; out obj): Integer;',
' function {#tbird_addref_used}_AddRef: Integer;',
' function {#tbird_release_used}_Release: Integer;',
' procedure {#tbird_doit_notused}DoIt;',
' procedure {#tbird_fly_used}Fly;',
' end;',
'']),
LinesToStr([
'function TBird.QueryInterface(const iid: TGuid; out obj): Integer;',
'begin',
' if iid='''' then obj:=nil;',
' Result:=0;',
'end;',
'function TBird._AddRef: Integer; begin Result:=1; end;',
'function TBird._Release: Integer; begin Result:=2; end;',
'procedure TBird.DoIt; begin end;',
'procedure TBird.Fly; begin end;',
'']) );
StartProgram(true);
Add([
'uses sysutils;',
'type',
' {#teagle_used}TEagle = class(TBird)',
' end;',
'var',
' e: TEagle;',
' i: IBird;',
'begin',
' i:=e;',
' if i=nil then ;',
' i.Fly;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassInterface_Typeinfo;
begin
StartProgram(false);
Add([
'{$interfaces corba}',
'type',
' {#iunknown_typeinfo}IUnknown = interface',
' function {#iunknown_getflag_typeinfo}GetFlag: boolean;',
' procedure {#iunknown_setflag_typeinfo}SetFlag(Value: boolean);',
' procedure {#iunknown_doit_notypeinfo}DoIt;',
' property {#iunknown_flag_typeinfo}Flag: boolean read GetFlag write SetFlag;',
' end;',
' {#ibird_notused}IBird = interface(IUnknown)',
' end;',
'var',
' t: pointer;',
' i: IUnknown;',
'begin',
' t:=typeinfo(IUnknown);',
' if i.Flag then ;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassInterface_TGUID;
begin
StartProgram(false);
Add([
'{$interfaces corba}',
'type',
' TGuid = record',
' {#d1_used}D1: longword;',
' {#d2_used}D2: word;',
' {#d3_used}D3: word;',
' {#d4_used}D4: array[0..7] of byte;',
' end;',
'var g,h: TGuid;',
'begin',
' if g=h then ;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassHelper;
begin
StartProgram(false);
Add([
'type',
' {#TObject_used}TObject = class',
' end;',
' {#TBird_used}TBird = class',
' {#TBird_A_notused}A: word;',
' end;',
' {#TAnt_used}TAnt = class',
' {#TAnt_B_notused}B: word;',
' type',
' {#TMouth_used}TMouth = class',
' {#TMouth_C_notused}C: word;',
' type',
' {#TBirdHelper_used}TBirdHelper = class helper for TBird',
' procedure {#TBirdHelper_Fly_used}Fly;',
' end;',
' end;',
' end;',
'procedure TAnt.TMouth.TBirdHelper.Fly;',
'begin',
'end;',
'var b: TBird;',
'begin',
' b.Fly;;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassHelper_ClassConstrucor_Used;
begin
StartProgram(false);
Add([
'type',
' {#TObject_used}TObject = class',
' class constructor {#TObject_Init_used}Init;',
' class destructor {#TObject_Done_used}Done;',
' end;',
' {#TBird_used}TBird = class',
' {#TBird_A_notused}A: word;',
' class constructor {#TBird_Init_used}Init;',
' class destructor {#TBird_Done_used}Done;',
' end;',
' {#TBirdHelper_used}TBirdHelper = class helper for TBird',
' procedure {#TBirdHelper_Fly_used}Fly;',
' class constructor {#TBirdHelper_Init_used}Init;',
' class destructor {#TBirdHelper_Done_used}Done;',
' end;',
' TAnt = class',
' class constructor {#TAnt_Init_notused}Init;',
' class destructor {#TAnt_Done_notused}Done;',
' end;',
'class constructor TObject.Init;',
'begin',
'end;',
'class destructor TObject.Done;',
'begin',
'end;',
'class constructor TBird.Init;',
'begin',
'end;',
'class destructor TBird.Done;',
'begin',
'end;',
'procedure TBirdHelper.Fly;',
'begin',
'end;',
'class constructor TBirdHelper.Init;',
'begin',
'end;',
'class destructor TBirdHelper.Done;',
'begin',
'end;',
'class constructor TAnt.Init;',
'begin',
'end;',
'class destructor TAnt.Done;',
'begin',
'end;',
'var b: TBird;',
'begin',
' b.Fly;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_Attributes;
begin
StartProgram(false);
Add([
'{$modeswitch prefixedattributes}',
'type',
' TObject = class',
' constructor {#TObject_Create_notused}Create;',
' end;',
' {#TCustomAttribute_used}TCustomAttribute = class',
' end;',
' {#RedAttribute_used}RedAttribute = class(TCustomAttribute)',
' constructor {#Red_A_used}Create(Id: word = 3; Deep: boolean = false); overload;',
' constructor {#Red_B_notused}Create(Size: double); overload;',
' end;',
' {#Red_notused}Red = word;',
'constructor TObject.Create; begin end;',
'constructor RedAttribute.Create(Id: word; Deep: boolean); begin end;',
'constructor RedAttribute.Create(Size: double); begin end;',
'var',
' [NotExisting]',
' [Red]',
' o: TObject;',
'begin',
' if typeinfo(o)=nil then ;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_Attributes_ForwardClass;
begin
StartProgram(false);
Add([
'{$modeswitch prefixedattributes}',
'type',
' TObject = class',
' constructor {#TObject_Create_used}Create;',
' end;',
' {#TCustomAttribute_used}TCustomAttribute = class',
' end;',
' [TCustom]',
' TBird = class;',
' TMyInt = word;',
' TBird = class end;',
'constructor TObject.Create; begin end;',
'begin',
' if typeinfo(TBird)=nil then ;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_Attributes_Params;
begin
StartProgram(false);
Add([
'{$modeswitch prefixedattributes}',
'type',
' TObject = class',
' constructor {#TObject_Create_notused}Create;',
' destructor {#TObject_Destroy_used}Destroy; virtual;',
' end;',
' {#TCustomAttribute_used}TCustomAttribute = class',
' end;',
' {#BigAttribute_used}BigAttribute = class(TCustomAttribute)',
' constructor {#Big_A_used}Create(Id: word = 3); overload;',
' destructor {#Big_B_used}Destroy; override;',
' end;',
'constructor TObject.Create; begin end;',
'destructor TObject.Destroy; begin end;',
'constructor BigAttribute.Create(Id: word); begin end;',
'destructor BigAttribute.Destroy; begin end;',
'var',
' [Big(3)]',
' o: TObject;',
' a: TCustomAttribute;',
'begin',
' if typeinfo(o)=nil then ;',
' a.Destroy;',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestSR_Proc_UnitVar;
begin
StartUnit(false);
Add([
'interface',
'type',
' TColor = longint;',
' TIntColor = TColor;',
'var',
' i: longint;',
' j: longint;',
'procedure DoIt;',
'implementation',
'procedure DoIt;',
'type',
' TSubColor = TIntColor;',
'var',
' b: TSubColor;',
'begin',
' b:=i;',
'end;',
'']);
Analyzer.Options:=Analyzer.Options+[paoImplReferences];
AnalyzeUnit;
CheckScopeReferences('DoIt',['i','tintcolor']);
end;
procedure TTestUseAnalyzer.TestSR_Init_UnitVar;
begin
StartUnit(false);
Add([
'interface',
'type',
' TColor = longint;',
' TIntColor = TColor;',
'var',
' i: longint;',
' j: longint;',
'implementation',
'type',
' TSubColor = TIntColor;',
'var',
' b: TSubColor;',
'initialization',
' b:=i;',
'finalization',
' b:=j;',
'end.',
'']);
Analyzer.Options:=Analyzer.Options+[paoImplReferences];
AnalyzeUnit;
CheckScopeReferences('initialization',['b','i']);
CheckScopeReferences('finalization',['b','j']);
end;
initialization
RegisterTests([TTestUseAnalyzer]);
end.