Skip to content

Fix coding deleted #47

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

Closed
mppbg wants to merge 2 commits into from
Closed

Fix coding deleted #47

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
4be043d
Add option to process .groupproject intead maped .map file manualçy a…
mppbg Mar 28, 2025
15f53d2
Merge pull request #1 from mppbg/hotfix/suport_group_project_fix_jaco…
mppbg Mar 28, 2025
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
6 changes: 6 additions & 0 deletions Source/BreakpointList.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,7 @@ TBreakPointList = class(TInterfacedObject, IBreakPointList)

function GetBreakPointByAddress(const AAddress: Pointer): IBreakPoint;
property BreakPointByAddress[const AAddress: Pointer]: IBreakPoint read GetBreakPointByAddress;
function HasBreakPointUnitModuleName(const AUnitModuleName: String): Boolean;

constructor Create;
destructor Destroy; override;
Expand Down Expand Up @@ -79,6 +80,11 @@ function TBreakPointList.GetBreakPointByAddress(const AAddress: Pointer): IBreak
Result := IBreakPoint(FBreakPointLst.KeyInterface[IntToHex(Integer(AAddress), 8)]);
end;

function TBreakPointList.HasBreakPointUnitModuleName(const AUnitModuleName: String): Boolean;
begin
Result := FBreakPointLst.IndexOf(AUnitModuleName) > 0;
end;

procedure TBreakPointList.SetCapacity(const AValue: Integer);
begin
FBreakPointLst.Capacity := AValue;
Expand Down
4 changes: 2 additions & 2 deletions Source/ClassInfoUnit.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -304,7 +304,7 @@ class function TModuleList.GetProcedureName(const AModuleName: String; const AQu
var
QualifiedNameParts: TArray<String>;
begin
QualifiedNameParts := SplitString(GetClassProcedureName(AModuleName, AQualifiedProcName), '.');
QualifiedNameParts := GetClassProcedureName(AModuleName, AQualifiedProcName).Split(['.']);
if Length(QualifiedNameParts) > 0 then
begin
Result := SplitString(QualifiedNameParts[Length(QualifiedNameParts) - 1], '$')[0];
Expand All @@ -316,7 +316,7 @@ class function TModuleList.GetClassName(const AModuleName: String; const AQualif
QualifiedNameParts: TArray<String>;
I: Integer;
begin
QualifiedNameParts := SplitString(GetClassProcedureName(AModuleName, AQualifiedProcName), '.');
QualifiedNameParts := GetClassProcedureName(AModuleName, AQualifiedProcName).Split(['.']);
if Length(QualifiedNameParts) > 2 then
begin
Result := '';
Expand Down
2 changes: 1 addition & 1 deletion Source/CodeCoverage.dproj
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{27E66171-9D6A-4E9D-84EE-13E81C1D1915}</ProjectGuid>
<ProjectVersion>19.5</ProjectVersion>
Expand Down
148 changes: 112 additions & 36 deletions Source/CoverageConfiguration.pas
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -20,13 +20,15 @@ interface
I_ParameterProvider,
I_LogManager,
ModuleNameSpaceUnit,
uConsoleOutput;
uConsoleOutput,
System.Generics.Collections;

type
TCoverageConfiguration = class(TInterfacedObject, ICoverageConfiguration)
strict private
FExeFileName: string;
FMapFileName: string;
FMapFileNames: TList<String>;
FSourceDir: string;
FOutputDir: string;
FDebugLogFileName: string;
Expand All @@ -50,7 +52,6 @@ TCoverageConfiguration = class(TInterfacedObject, ICoverageConfiguration)
FTestExeExitCode: Boolean;
FUseTestExePathAsWorkingDir: Boolean;
FExcludeSourceMaskLst: TStrings;
FIncludeSourceMaskLst: TStrings;
FLoadingFromDProj: Boolean;
FModuleNameSpaces: TModuleNameSpaceList;
FUnitNameSpaces: TUnitNameSpaceList;
Expand All @@ -67,6 +68,7 @@ TCoverageConfiguration = class(TInterfacedObject, ICoverageConfiguration)
function GetExeOutputFromDProj(const Project: IXMLNode; const ProjectName: TFileName): string;
function GetSourceDirsFromDProj(const Project: IXMLNode): string;
function GetCodePageFromDProj(const Project: IXMLNode): Integer;
procedure ParseDGroupProj(const DGroupProjFilename: TFileName);
procedure ParseDProj(const DProjFilename: TFileName);
function IsPathInExclusionList(const APath: TFileName): Boolean;
procedure ExcludeSourcePaths;
Expand All @@ -92,12 +94,15 @@ TCoverageConfiguration = class(TInterfacedObject, ICoverageConfiguration)
procedure ParseOutputDirectorySwitch(var AParameter: Integer);
procedure ParseLoggingTextSwitch(var AParameter: Integer);
procedure ParseWinApiLoggingSwitch(var AParameter: Integer);
procedure ParseDgroupProjSwitch(var AParameter: Integer);
procedure ParseDprojSwitch(var AParameter: Integer);
procedure ParseSourceMaskSwitch(var AParameter: Integer; out AMaskLst: TStrings);
procedure ParseExcludeSourceMaskSwitch(var AParameter: Integer);
procedure ParseModuleNameSpaceSwitch(var AParameter: Integer);
procedure ParseUnitNameSpaceSwitch(var AParameter: Integer);
procedure ParseLineCountSwitch(var AParameter: Integer);
procedure ParseCodePageSwitch(var AParameter: Integer);
private
function GetMainSource(const Project: IXMLNode): string;
public
constructor Create(const AParameterProvider: IParameterProvider);
destructor Destroy; override;
Expand All @@ -107,6 +112,7 @@ TCoverageConfiguration = class(TInterfacedObject, ICoverageConfiguration)
function ApplicationParameters: string;
function ExeFileName: string;
function MapFileName: string;
function MapFileNames: TList<String>;
function OutputDir: string;
function SourceDir: string;
function DebugLogFile: string;
Expand Down Expand Up @@ -169,6 +175,8 @@ constructor TCoverageConfiguration.Create(const AParameterProvider: IParameterPr
begin
inherited Create;

FMapFileNames := TList<String>.Create;

FLogManager := nil;

FParameterProvider := AParameterProvider;
Expand Down Expand Up @@ -206,7 +214,6 @@ constructor TCoverageConfiguration.Create(const AParameterProvider: IParameterPr
FXmlOutput := False;
FXmlLines := False;
FExcludeSourceMaskLst := TStringList.Create;
FIncludeSourceMaskLst := TStringList.Create;
FModuleNameSpaces := TModuleNameSpaceList.Create;
FUnitNameSpaces := TUnitNameSpaceList.Create;
FLineCountLimit := 0;
Expand All @@ -223,7 +230,6 @@ destructor TCoverageConfiguration.Destroy;
FExeParamsStrLst.Free;
FSourcePathLst.Free;
FExcludeSourceMaskLst.Free;
FIncludeSourceMaskLst.Free;
FModuleNameSpaces.Free;
FUnitNameSpaces.free;
inherited;
Expand Down Expand Up @@ -312,6 +318,11 @@ function TCoverageConfiguration.MapFileName: string;
Result := FMapFileName;
end;

function TCoverageConfiguration.MapFileNames: TList<String>;
begin
Result := FMapFileNames;
end;

function TCoverageConfiguration.ExeFileName: string;
begin
Result := FExeFileName;
Expand Down Expand Up @@ -405,21 +416,8 @@ function TCoverageConfiguration.UseTestExePathAsWorkingDir: Boolean;
function TCoverageConfiguration.IsPathInExclusionList(const APath: TFileName): Boolean;
var
Mask: string;
IsIncluded: boolean;
begin
Result := False;
// if inclusion list is empty, everything is included
IsIncluded := true;
// first check if present in inclusion list
for Mask in FIncludeSourceMaskLst do
begin
IsIncluded := MatchesMask(APath, Mask);
if IsIncluded then
break;
end;
if not IsIncluded then
Exit(True);

for Mask in FExcludeSourceMaskLst do
begin
if MatchesMask(APath, Mask) then
Expand Down Expand Up @@ -644,12 +642,12 @@ procedure TCoverageConfiguration.ParseSwitch(var AParameter: Integer);
begin
// do nothing, because its already parsed
end
else if SwitchItem = I_CoverageConfiguration.cPARAMETER_DGROUPPROJ then
ParseDgroupProjSwitch(AParameter)
else if SwitchItem = I_CoverageConfiguration.cPARAMETER_DPROJ then
ParseDprojSwitch(AParameter)
else if SwitchItem = I_CoverageConfiguration.cPARAMETER_EXCLUDE_SOURCE_MASK then
ParseSourceMaskSwitch(AParameter, {out} FExcludeSourceMaskLst)
else if SwitchItem = I_CoverageConfiguration.cPARAMETER_INCLUDE_SOURCE_MASK then
ParseSourceMaskSwitch(AParameter, {out} FIncludeSourceMaskLst)
ParseExcludeSourceMaskSwitch(AParameter)
else if SwitchItem = I_CoverageConfiguration.cPARAMETER_MODULE_NAMESPACE then
ParseModuleNameSpaceSwitch(AParameter)
else if SwitchItem = I_CoverageConfiguration.cPARAMETER_UNIT_NAMESPACE then
Expand Down Expand Up @@ -889,7 +887,7 @@ procedure TCoverageConfiguration.ParseSourcePathsFileSwitch(var AParameter: Inte
procedure TCoverageConfiguration.ReadSourcePathFile(const ASourceFileName: string);
var
InputFile: TextFile;
SourcePathLine: string;
SourcePathLine,FullSourceDir: string;
begin
OpenInputFileForReading(ASourceFileName, InputFile);
try
Expand All @@ -899,7 +897,7 @@ procedure TCoverageConfiguration.ReadSourcePathFile(const ASourceFileName: strin

if (FSourceDir <> '') and TPath.IsRelativePath(SourcePathLine) then
begin
var FullSourceDir := TPath.Combine(FSourceDir, SourcePathLine);
FullSourceDir := TPath.Combine(FSourceDir, SourcePathLine);
if TDirectory.Exists(FullSourceDir) then
begin
FSourcePathLst.Add(FullSourceDir);
Expand Down Expand Up @@ -998,6 +996,22 @@ function TCoverageConfiguration.GetCurrentConfig(const Project: IXMLNode): strin
end;
end;

function TCoverageConfiguration.GetMainSource(const Project: IXMLNode): string;
var
Node: IXMLNode;
MainSourceNode: IXMLNode;
begin
Assert(Assigned(Project));
Result := '';
Node := Project.ChildNodes.Get(0);
if (Node.LocalName = 'PropertyGroup') then
begin
MainSourceNode := Node.ChildNodes.FindNode('MainSource');
if MainSourceNode <> nil then
Result := MainSourceNode.Text;
end;
end;

function TCoverageConfiguration.GetBasePropertyGroupNode(const Project: IXMLNode): IXMLNode;
var
GroupIndex: Integer;
Expand Down Expand Up @@ -1049,12 +1063,15 @@ function TCoverageConfiguration.GetExeOutputFromDProj(const Project: IXMLNode; c
var
CurrentConfig: string;
CurrentPlatform: string;
DCC_ExeOutputNode: IXMLNode;
MainSource: string;
DCC_OutputNode: IXMLNode;
DCC_ExeOutput: string;
DCC_ExtensionOutput: string;
Node: IXMLNode;
begin
Result := '';
Assert(Assigned(Project));
MainSource := GetMainSource(Project);
CurrentConfig := GetCurrentConfig(Project);

{$IFDEF WIN64}
Expand All @@ -1068,20 +1085,80 @@ function TCoverageConfiguration.GetExeOutputFromDProj(const Project: IXMLNode; c
begin
if CurrentConfig <> '' then
begin
DCC_ExeOutputNode := Node.ChildNodes.FindNode('DCC_ExeOutput');
if DCC_ExeOutputNode <> nil then
if ExtractFileExt(MainSource) = '.dpk' then
Begin
DCC_OutputNode := Node.ChildNodes.FindNode('DCC_BplOutput');
DCC_ExtensionOutput := '.bpl';
End
else
BEgin
DCC_OutputNode := Node.ChildNodes.FindNode('DCC_ExeOutput');
DCC_ExtensionOutput := '.exe';
End;

if DCC_OutputNode <> nil then
begin
DCC_ExeOutput := DCC_ExeOutputNode.Text;
DCC_ExeOutput := DCC_OutputNode.Text;
DCC_ExeOutput := StringReplace(DCC_ExeOutput, '$(Platform)', CurrentPlatform, [rfReplaceAll, rfIgnoreCase]);
DCC_ExeOutput := StringReplace(DCC_ExeOutput, '$(Config)', CurrentConfig, [rfReplaceAll, rfIgnoreCase]);
Result := IncludeTrailingPathDelimiter(DCC_ExeOutput) + ChangeFileExt(ExtractFileName(ProjectName), '.exe');
Result := IncludeTrailingPathDelimiter(DCC_ExeOutput) + ChangeFileExt(ExtractFileName(ProjectName), DCC_ExtensionOutput);
end
else
Result := ChangeFileExt(ProjectName, '.exe');
Result := ChangeFileExt(ProjectName,DCC_ExtensionOutput);
end;
end;
end;

procedure TCoverageConfiguration.ParseDGroupProj(const DGroupProjFilename: TFileName);
var
Document: IXMLDocument;
ItemGroup: IXMLNode;
Node: IXMLNode;
Project: IXMLNode;
ProjectName, Path, SearchPaths: string;
I: Integer;
RootPath: TFileName;
SourcePath: TFileName;
ExeFileName: TFileName;
begin
RootPath := ExtractFilePath(TPath.GetFullPath(DGroupProjFilename));
Document := TXMLDocument.Create(nil);
Document.LoadFromFile(DGroupProjFilename);
Project := Document.ChildNodes.FindNode('Project');
if Project <> nil then
begin
ItemGroup := Project.ChildNodes.FindNode('ItemGroup');
if ItemGroup <> nil then
begin
FLoadingFromDProj := True;
for I := 0 to ItemGroup.ChildNodes.Count - 1 do
begin
Node := ItemGroup.ChildNodes.Get(I);
if Node.LocalName = 'Projects' then
begin
ProjectName := TPath.GetFullPath(TPath.Combine(RootPath, Node.Attributes['Include']));
ParseDProj(ProjectName);
end;
end;
end;
end;
end;

procedure TCoverageConfiguration.ParseDgroupProjSwitch(var AParameter: Integer);
var
DGroupProjPath: TFileName;
begin
Inc(AParameter);
try
DGroupProjPath := ParseParameter(AParameter);
ParseDGroupProj(DGroupProjPath);
except
on EParameterIndexException do
raise EConfigurationException.Create('Expected parameter for project file');
end;

end;

procedure TCoverageConfiguration.ParseDProj(const DProjFilename: TFileName);
var
Document: IXMLDocument;
Expand All @@ -1105,8 +1182,7 @@ procedure TCoverageConfiguration.ParseDProj(const DProjFilename: TFileName);
begin
if FExeFileName = '' then
FExeFileName := TPath.GetFullPath(TPath.Combine(RootPath, ExeFileName));
if FMapFileName = '' then
FMapFileName := ChangeFileExt(FExeFileName, '.map');
FMapFileNames.Add(TPath.GetFullPath(TPath.Combine(RootPath, ChangeFileExt(ExeFileName, '.map'))));
end;

SearchPaths := GetSourceDirsFromDProj(Project);
Expand Down Expand Up @@ -1145,7 +1221,7 @@ procedure TCoverageConfiguration.ParseDProj(const DProjFilename: TFileName);
end;
end;

procedure TCoverageConfiguration.ParseSourceMaskSwitch(var AParameter: Integer; out AMaskLst: TStrings);
procedure TCoverageConfiguration.ParseExcludeSourceMaskSwitch(var AParameter: Integer);
var
SourcePathString: string;
begin
Expand All @@ -1154,18 +1230,18 @@ procedure TCoverageConfiguration.ParseSourceMaskSwitch(var AParameter: Integer;
SourcePathString := ParseParameter(AParameter);
while SourcePathString <> '' do
begin
AMaskLst.Add(ReplaceStr(SourcePathString, '/', TPath.DirectorySeparatorChar));
FExcludeSourceMaskLst.Add(ReplaceStr(SourcePathString, '/', TPath.DirectorySeparatorChar));
Inc(AParameter);
SourcePathString := ParseParameter(AParameter);
end;

if AMaskLst.Count = 0 then
raise EConfigurationException.Create('Expected at least one source mask');
if FExcludeSourceMaskLst.Count = 0 then
raise EConfigurationException.Create('Expected at least one exclude source mask');

Dec(AParameter);
except
on EParameterIndexException do
raise EConfigurationException.Create('Expected at least one source mask');
raise EConfigurationException.Create('Expected at least one exclude source mask');
end;
end;

Expand Down
Loading