paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-27 15:30:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: pasuseanalyzer: mark library export function result sub elements

Browse Source
This commit is contained in:
mattias 2022-03-06 00:22:14 +01:00
parent 39627cbdfb
commit 6f0f339fc4
2 changed files with 67 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2410,9 +2410,13 @@ begin
end
else if Mode=paumElement then
continue
else if IsModuleInternal(Member) then
else if Member.Visibility in [visPrivate,visStrictPrivate] then
// private or strict private
continue
else if (Member.Visibility in [visProtected,visStrictProtected])
and IsModuleInternal(El) then
// protected or strict protected and
continue
else if (Mode=paumAllPasUsable) and FirstTime then
begin
if Member.ClassType=TPasProperty then
@ -2657,6 +2661,8 @@ procedure TPasAnalyzer.UseExportSymbol(El: TPasExportSymbol);
var
Ref: TResolvedReference;
Decl: TPasElement;
ProcType: TPasProcedureType;
aType: TPasType;
begin
if not MarkElementAsUsed(El) then exit;
if El.CustomData is TResolvedReference then
@ -2664,7 +2670,23 @@ begin
Ref:=TResolvedReference(El.CustomData);
Decl:=Ref.Declaration;
if Decl<>nil then
UseElement(Decl,Ref.Access,false);
begin
UseElement(Decl,Ref.Access,true);
if Decl is TPasProcedure then
begin
ProcType:=TPasProcedure(Decl).ProcType;
if ProcType is TPasFunctionType then
begin
aType:=TPasFunctionType(ProcType).ResultEl.ResultType;
UseType(aType,paumAllPasUsable);
end;
end
else if Decl is TPasVariable then
begin
aType:=TPasVariable(Decl).VarType;
UseType(aType,paumAllPasUsable);
end;
end;
end;
UseExpr(El.NameExpr);
UseExpr(El.ExportName);
@ -3276,11 +3298,18 @@ begin
end;
function TPasAnalyzer.IsModuleInternal(El: TPasElement): boolean;
var
C: TClass;
begin
if El=nil then
exit(true);
if El.ClassType=TInterfaceSection then
exit(false);
C:=El.ClassType;
if C=TInterfaceSection then
exit(false)
else if C=TImplementationSection then
exit(true)
else if (C=TProgramSection) or (C=TLibrarySection) then
exit(true);
if IsExport(El) then exit(false);
case El.Visibility of
visPrivate,visStrictPrivate: exit(true);

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

@ -152,6 +152,7 @@ type
procedure TestWP_UnitFinalization;
procedure TestWP_CallInherited;
procedure TestWP_ProgramPublicDeclarations;
procedure TestWP_LibraryDeclarations;
procedure TestWP_ClassOverride;
procedure TestWP_ClassDefaultProperty;
procedure TestWP_BeforeConstruction;
@ -2651,6 +2652,39 @@ begin
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_LibraryDeclarations;
begin
StartProgram(false);
Add([
'type',
' {#TObject_used}TObject = class',
' end;',
' {#TBird_used}TBird = class',
' private',
' procedure {#TBirdRun_notused}Run;',
' protected',
' procedure {#TBirdTweet_notused}Tweet;',
' public',
' procedure {#TBirdFly_used}Fly;',
' end;',
'procedure TBird.Run;',
'begin',
'end;',
'procedure TBird.Tweet;',
'begin',
'end;',
'procedure TBird.Fly;',
'begin',
'end;',
'function {#GetBird_used}GetBird: TBird;',
'begin',
'end;',
'exports',
' GetBird;',
'begin']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ClassOverride;
begin
StartProgram(false);