Skip to content

+ Read UnitSearchPath from DPROJ #8

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Aug 10, 2021
Merged

+ Read UnitSearchPath from DPROJ #8

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
6ab235f
+ Read UnitSearchPath from DPROJ
Fr0sT-Brutal Aug 3, 2021
88045ae
+ Add test
Fr0sT-Brutal Aug 10, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
62 changes: 50 additions & 12 deletions Source/CoverageConfiguration.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,9 @@ TCoverageConfiguration = class(TInterfacedObject, ICoverageConfiguration)
procedure ParseSwitch(var AParameter: Integer);
procedure ParseBooleanSwitches;
function GetCurrentConfig(const Project: IXMLNode): string;
function GetBasePropertyGroupNode(const Project: IXMLNode): IXMLNode;
function GetExeOutputFromDProj(const Project: IXMLNode; const ProjectName: TFileName): string;
function GetSourceDirsFromDProj(const Project: IXMLNode): string;
procedure ParseDProj(const DProjFilename: TFileName);
function IsPathInExclusionList(const APath: TFileName): Boolean;
procedure ExcludeSourcePaths;
Expand Down Expand Up @@ -896,13 +898,45 @@ function TCoverageConfiguration.GetCurrentConfig(const Project: IXMLNode): strin
end;
end;

function TCoverageConfiguration.GetBasePropertyGroupNode(const Project: IXMLNode): IXMLNode;
var
GroupIndex: Integer;
begin
Assert(Assigned(Project));
for GroupIndex := 0 to Project.ChildNodes.Count - 1 do
begin
Result := Project.ChildNodes.Get(GroupIndex);
if (Result.LocalName = 'PropertyGroup')
and Result.HasAttribute('Condition')
and (
(Result.Attributes['Condition'] = '''$(Base)''!=''''')
or (Result.Attributes['Condition'] = '''$(Basis)''!=''''')
) then
Exit;
end;
Result := nil;
end;

function TCoverageConfiguration.GetSourceDirsFromDProj(const Project: IXMLNode): string;
var
Node: IXMLNode;
begin
Result := '';
Assert(Assigned(Project));

Node := GetBasePropertyGroupNode(Project);
if Node = nil then Exit;
Node := Node.ChildNodes.FindNode('DCC_UnitSearchPath');
if Node = nil then Exit;
Result := StringReplace(Node.Text, '$(DCC_UnitSearchPath)', '', [rfReplaceAll, rfIgnoreCase]);
end;

function TCoverageConfiguration.GetExeOutputFromDProj(const Project: IXMLNode; const ProjectName: TFileName): string;
var
CurrentConfig: string;
CurrentPlatform: string;
DCC_ExeOutputNode: IXMLNode;
DCC_ExeOutput: string;
GroupIndex: Integer;
Node: IXMLNode;
begin
Result := '';
Expand All @@ -915,15 +949,8 @@ function TCoverageConfiguration.GetExeOutputFromDProj(const Project: IXMLNode; c
CurrentPlatform := 'Win32';
{$ENDIF}

for GroupIndex := 0 to Project.ChildNodes.Count - 1 do
begin
Node := Project.ChildNodes.Get(GroupIndex);
if (Node.LocalName = 'PropertyGroup')
and Node.HasAttribute('Condition')
and (
(Node.Attributes['Condition'] = '''$(Base)''!=''''')
or (Node.Attributes['Condition'] = '''$(Basis)''!=''''')
) then
Node := GetBasePropertyGroupNode(Project);
if Node <> nil then
begin
if CurrentConfig <> '' then
begin
Expand All @@ -939,7 +966,6 @@ function TCoverageConfiguration.GetExeOutputFromDProj(const Project: IXMLNode; c
Result := ChangeFileExt(ProjectName, '.exe');
end;
end;
end;
end;

procedure TCoverageConfiguration.ParseDProj(const DProjFilename: TFileName);
Expand All @@ -948,7 +974,7 @@ procedure TCoverageConfiguration.ParseDProj(const DProjFilename: TFileName);
ItemGroup: IXMLNode;
Node: IXMLNode;
Project: IXMLNode;
Unitname: string;
Unitname, Path, SearchPaths: string;
I: Integer;
RootPath: TFileName;
SourcePath: TFileName;
Expand All @@ -969,6 +995,18 @@ procedure TCoverageConfiguration.ParseDProj(const DProjFilename: TFileName);
FMapFileName := ChangeFileExt(FExeFileName, '.map');
end;

SearchPaths := GetSourceDirsFromDProj(Project);
if SearchPaths <> '' then
begin
for Path in SearchPaths.Split([';']) do
if Path <> '' then
begin
SourcePath := TPath.GetFullPath(TPath.Combine(RootPath, Path));
if FSourcePathLst.IndexOf(SourcePath) = -1 then
FSourcePathLst.Add(SourcePath);
end;
end;

ItemGroup := Project.ChildNodes.FindNode('ItemGroup');
if ItemGroup <> nil then
begin
Expand Down
4 changes: 4 additions & 0 deletions Test/CoverageConfigurationTest.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1470,6 +1470,7 @@ procedure TCoverageConfigurationTest.TestDProj;
LCoverageConfiguration : ICoverageConfiguration;
I : Integer;
ExpectedExeName : TFileName;
ExpectedSourcePath : TFileName;
PlatformName : string;
begin
LExeName := RandomFileName();
Expand All @@ -1483,6 +1484,7 @@ procedure TCoverageConfigurationTest.TestDProj;
LDProj.Add('</PropertyGroup>');
LDProj.Add('<PropertyGroup Condition="''$(Base)''!=''''">');
LDProj.Add('<DCC_ExeOutput>..\build\$(PLATFORM)</DCC_ExeOutput>');
LDProj.Add('<DCC_UnitSearchPath>..\src\;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>');
LDProj.Add('</PropertyGroup>');

LTotalUnitList := TStringList.Create;
Expand Down Expand Up @@ -1516,6 +1518,8 @@ procedure TCoverageConfigurationTest.TestDProj;
ExpectedExeName := TPath.GetDirectoryName(GetCurrentDir()) + '\build\' + PlatformName + '\' + LExeName;
CheckEquals(ChangeFileExt(ExpectedExeName, '.exe'), LCoverageConfiguration.ExeFileName, 'Incorrect executable listed');
CheckEquals(ChangeFileExt(ExpectedExeName, '.map'), LCoverageConfiguration.MapFileName, 'Incorrect map file name');
ExpectedSourcePath := TPath.GetFullPath(TPath.Combine(TPath.GetDirectoryName(LDProjName), '..\src\'));
CheckTrue(LCoverageConfiguration.SourcePaths.IndexOf(ExpectedSourcePath) <> -1, 'Incorrect SourcePaths');

for I := 0 to Pred(LTotalUnitList.Count) do
CheckNotEquals(-1, LCoverageConfiguration.Units.IndexOf(LTotalUnitList[I]), 'Missing unit name');
Expand Down