diff --git a/Source/BreakpointList.pas b/Source/BreakpointList.pas index 1814282..2645fbf 100644 --- a/Source/BreakpointList.pas +++ b/Source/BreakpointList.pas @@ -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; @@ -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; diff --git a/Source/ClassInfoUnit.pas b/Source/ClassInfoUnit.pas index e45ab82..7e0d2c5 100644 --- a/Source/ClassInfoUnit.pas +++ b/Source/ClassInfoUnit.pas @@ -304,7 +304,7 @@ class function TModuleList.GetProcedureName(const AModuleName: String; const AQu var QualifiedNameParts: TArray; begin - QualifiedNameParts := SplitString(GetClassProcedureName(AModuleName, AQualifiedProcName), '.'); + QualifiedNameParts := GetClassProcedureName(AModuleName, AQualifiedProcName).Split(['.']); if Length(QualifiedNameParts) > 0 then begin Result := SplitString(QualifiedNameParts[Length(QualifiedNameParts) - 1], '$')[0]; @@ -316,7 +316,7 @@ class function TModuleList.GetClassName(const AModuleName: String; const AQualif QualifiedNameParts: TArray; I: Integer; begin - QualifiedNameParts := SplitString(GetClassProcedureName(AModuleName, AQualifiedProcName), '.'); + QualifiedNameParts := GetClassProcedureName(AModuleName, AQualifiedProcName).Split(['.']); if Length(QualifiedNameParts) > 2 then begin Result := ''; diff --git a/Source/CodeCoverage.dproj b/Source/CodeCoverage.dproj index 775bf25..1325019 100644 --- a/Source/CodeCoverage.dproj +++ b/Source/CodeCoverage.dproj @@ -1,4 +1,4 @@ - + {27E66171-9D6A-4E9D-84EE-13E81C1D1915} 19.5 diff --git a/Source/CoverageConfiguration.pas b/Source/CoverageConfiguration.pas index 860f34d..c84993b 100644 --- a/Source/CoverageConfiguration.pas +++ b/Source/CoverageConfiguration.pas @@ -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; FSourceDir: string; FOutputDir: string; FDebugLogFileName: string; @@ -50,7 +52,6 @@ TCoverageConfiguration = class(TInterfacedObject, ICoverageConfiguration) FTestExeExitCode: Boolean; FUseTestExePathAsWorkingDir: Boolean; FExcludeSourceMaskLst: TStrings; - FIncludeSourceMaskLst: TStrings; FLoadingFromDProj: Boolean; FModuleNameSpaces: TModuleNameSpaceList; FUnitNameSpaces: TUnitNameSpaceList; @@ -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; @@ -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; @@ -107,6 +112,7 @@ TCoverageConfiguration = class(TInterfacedObject, ICoverageConfiguration) function ApplicationParameters: string; function ExeFileName: string; function MapFileName: string; + function MapFileNames: TList; function OutputDir: string; function SourceDir: string; function DebugLogFile: string; @@ -169,6 +175,8 @@ constructor TCoverageConfiguration.Create(const AParameterProvider: IParameterPr begin inherited Create; + FMapFileNames := TList.Create; + FLogManager := nil; FParameterProvider := AParameterProvider; @@ -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; @@ -223,7 +230,6 @@ destructor TCoverageConfiguration.Destroy; FExeParamsStrLst.Free; FSourcePathLst.Free; FExcludeSourceMaskLst.Free; - FIncludeSourceMaskLst.Free; FModuleNameSpaces.Free; FUnitNameSpaces.free; inherited; @@ -312,6 +318,11 @@ function TCoverageConfiguration.MapFileName: string; Result := FMapFileName; end; +function TCoverageConfiguration.MapFileNames: TList; +begin + Result := FMapFileNames; +end; + function TCoverageConfiguration.ExeFileName: string; begin Result := FExeFileName; @@ -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 @@ -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 @@ -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 @@ -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); @@ -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; @@ -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} @@ -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; @@ -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); @@ -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 @@ -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; diff --git a/Source/Debugger.pas b/Source/Debugger.pas index 285da9d..ed5d62d 100644 --- a/Source/Debugger.pas +++ b/Source/Debugger.pas @@ -31,7 +31,8 @@ interface ModuleNameSpaceUnit, uConsoleOutput, JclPEImage, - JwaPsApi; + JwaPsApi, + System.Generics.Collections; type TDebugger = class(TInterfacedObject, IDebugger) @@ -70,6 +71,7 @@ TDebugger = class(TInterfacedObject, IDebugger) function StartProcessToDebug: Boolean; procedure ProcessDebugEvents; + procedure ProcessDebugEventsWinthoutTest(AMapFileNames: TList); procedure HandleExceptionDebug( const ADebugEvent: DEBUG_EVENT; @@ -90,6 +92,7 @@ TDebugger = class(TInterfacedObject, IDebugger) procedure GenerateReport; + procedure PrintUsage; procedure PrintSummary; public @@ -136,20 +139,23 @@ function GetApplicationVersion: string; VersionSegmentSize: DWORD; VersionValue: PChar; BufferSize: DWORD; + ApplicationName: String; + VersionBuffer: PChar; + VersionType : String; begin Result := ''; - var ApplicationName := ParamStr(0); + ApplicationName := ParamStr(0); BufferSize := GetFileVersionInfoSize(PChar(ApplicationName), BufferSize); if BufferSize > 0 then begin - var VersionBuffer: PChar := AllocMem(BufferSize); + VersionBuffer := AllocMem(BufferSize); try GetFileVersionInfo(PChar(ApplicationName), 0, BufferSize, VersionBuffer); VersionValue := nil; VerQueryValue(VersionBuffer, PChar('\VarFileInfo\Translation'), Pointer(VersionValue), VersionSegmentSize); - var VersionType := IntToHex(LoWord(PLongInt(VersionValue)^), 4) + + VersionType := IntToHex(LoWord(PLongInt(VersionValue)^), 4) + IntToHex(HiWord(PLongInt(VersionValue)^), 4)+ '\ProductVersion'; if VerQueryValue(VersionBuffer, PChar('\StringFileInfo\' + VersionType), @@ -209,6 +215,9 @@ procedure TDebugger.PrintUsage; ConsoleOutput(I_CoverageConfiguration.cPARAMETER_EXECUTABLE + ' executable.exe -- the executable to run'); ConsoleOutput('or'); + ConsoleOutput(I_CoverageConfiguration.cPARAMETER_DGROUPPROJ + + ' Project.dgroupProj -- Delphi group project file'); + ConsoleOutput(I_CoverageConfiguration.cPARAMETER_DPROJ + ' Project.dproj -- Delphi project file'); ConsoleOutput(''); @@ -502,6 +511,7 @@ procedure TDebugger.Debug; VerboseOutput('Started successfully'); ProcessDebugEvents; VerboseOutput('Finished processing debug events'); + ProcessDebugEventsWinthoutTest(FCoverageConfiguration.MapFileNames); GenerateReport; VerboseOutput('Finished generating reports'); PrintSummary; @@ -621,6 +631,36 @@ procedure TDebugger.ProcessDebugEvents; end; end; +procedure TDebugger.ProcessDebugEventsWinthoutTest(AMapFileNames: TList); + var MapFileName, ProcessName: String; +begin + + for MapFileName in FCoverageConfiguration.MapFileNames do + begin + try + ProcessName := PathRemoveExtension(MapFileName) + '.bpl'; + AddBreakPoints( + FCoverageConfiguration.Units(), + FCoverageConfiguration.ExcludedUnits(), + FCoverageConfiguration.ExcludedClassPrefixes(), + FDebugProcess, + TJCLMapScanner.Create(MapFileName), + FCoverageConfiguration.ModuleNameSpace(ExtractFileName(ProcessName)), + FCoverageConfiguration.UnitNameSpace(ExtractFileName(ProcessName))); + + except + on E: Exception do + begin + FLogManager.Log( + 'Exception during add breakpoints:' + E.Message + ' ' + E.ToString()); + end; + end; + end; + + + +end; + procedure TDebugger.AddBreakPoints( const AModuleList: TStrings; const AExcludedModuleList: TStrings; @@ -687,7 +727,7 @@ procedure TDebugger.AddBreakPoints( MapLineNumber := AMapScanner.LineNumberByIndex[LineIndex]; // RINGN:Segment 2 are .itext (ICODE). - if (MapLineNumber.Segment in [1, 2]) then + if (MapLineNumber.Segment in [1]) then begin ModuleName := AMapScanner.MapStringToStr(MapLineNumber.UnitName); ModuleNameFromAddr := AMapScanner.ModuleNameFromAddr(MapLineNumber.VA); diff --git a/Source/HTMLCoverageReport.pas b/Source/HTMLCoverageReport.pas index 99c467a..36298a3 100644 --- a/Source/HTMLCoverageReport.pas +++ b/Source/HTMLCoverageReport.pas @@ -628,7 +628,7 @@ procedure THTMLCoverageReport.GenerateCoverageTable( AOutputFile.WriteLine( '' ); diff --git a/Source/I_CoverageConfiguration.pas b/Source/I_CoverageConfiguration.pas index b276084..8687019 100644 --- a/Source/I_CoverageConfiguration.pas +++ b/Source/I_CoverageConfiguration.pas @@ -15,7 +15,8 @@ interface uses System.Classes, ModuleNameSpaceUnit, - I_LogManager; + I_LogManager, + System.Generics.Collections; type ICoverageConfiguration = interface @@ -24,6 +25,7 @@ interface function ApplicationParameters: string; function ExeFileName: string; function MapFileName: string; + function MapFileNames: TList; function OutputDir: string; function SourceDir: string; function SourcePaths: TStrings; @@ -74,6 +76,7 @@ interface cPARAMETER_XML_LINES_MERGE_GENERICS = '-xmlgenerics'; cPARAMETER_HTML_OUTPUT = '-html'; cPARAMETER_DPROJ = '-dproj'; + cPARAMETER_DGROUPPROJ = '-dgroupproj'; cPARAMETER_EXCLUDE_SOURCE_MASK = '-esm'; cPARAMETER_INCLUDE_SOURCE_MASK = '-ism'; cPARAMETER_MODULE_NAMESPACE = '-mns'; diff --git a/Source/JacocoCoverageFileUnit.pas b/Source/JacocoCoverageFileUnit.pas index da241c5..3be7681 100644 --- a/Source/JacocoCoverageFileUnit.pas +++ b/Source/JacocoCoverageFileUnit.pas @@ -1,12 +1,12 @@ -(***********************************************************************) -(* Delphi Code Coverage *) -(* *) -(* A quick hack of a Code Coverage Tool for Delphi *) -(* by Christer Fahlgren and Nick Ring *) -(* *) +(* ********************************************************************* *) +(* Delphi Code Coverage *) +(* *) +(* A quick hack of a Code Coverage Tool for Delphi *) +(* by Christer Fahlgren and Nick Ring *) +(* *) (* This Source Code Form is subject to the terms of the Mozilla Public *) (* License, v. 2.0. If a copy of the MPL was not distributed with this *) -(* file, You can obtain one at http://mozilla.org/MPL/2.0/. *) +(* file, You can obtain one at http://mozilla.org/MPL/2.0/. *) unit JacocoCoverageFileUnit; @@ -16,6 +16,7 @@ interface I_Report, I_CoverageStats, JclSimpleXml, + JclStreams, I_CoverageConfiguration, ClassInfoUnit, I_LogManager; @@ -25,33 +26,25 @@ TJacocoCoverageReport = class(TInterfacedObject, IReport) strict private FCoverageConfiguration: ICoverageConfiguration; - procedure AddModuleInfo( - AAllElement: TJclSimpleXMLElem; - const AModuleInfo: TModuleInfo); - procedure AddClassInfo( - ASourceFileElement: TJclSimpleXMLElem; - const AClassInfo: TClassInfo); - procedure AddClassStats( - const ARootElement: TJclSimpleXMLElem; - const AClass: TClassInfo); - procedure AddMethodInfo( - AClassElement: TJclSimpleXMLElem; - const AMethod: TProcedureInfo); - procedure AddMethodStats( - const ARootElement: TJclSimpleXMLElem; - const AMethod: TProcedureInfo); - procedure AddSourceStats( - const ARootElement: TJclSimpleXMLElem; + procedure AddModuleInfo(AAllElement: TJclSimpleXMLElem; const AModuleInfo: TModuleInfo; + const ACoverage: ICoverageStats); + procedure AddLineCodeStats(ARootElement: TJclSimpleXMLElem; const ACoverage: ICoverageStats; const AModule: TModuleInfo); - - procedure AddCoverageElement(const RootElement: TJclSimpleXMLElem; - const AType: string; const TotalCoveredCount, TotalUncoveredCount: Integer); + procedure AddModuleLineHits(ALineHitsElement: TJclSimpleXMLElem; const ACoverage: ICoverageStats); + procedure AddModuleStats(const RootElement: TJclSimpleXMLElem; const AModule: TModuleInfo); + procedure AddClassInfo(ASourceFileElement: TJclSimpleXMLElem; const AModule: TModuleInfo); + procedure AddClassStats(const ARootElement: TJclSimpleXMLElem; const AClass: TClassInfo); + procedure AddMethodInfo(AClassElement: TJclSimpleXMLElem; const AMethod: TProcedureInfo); + procedure AddMethodStats(const ARootElement: TJclSimpleXMLElem; const AMethod: TProcedureInfo); + procedure AddSourceStats(const ARootElement: TJclSimpleXMLElem; const AModule: TModuleInfo); + + procedure AddCoverageElement(const RootElement: TJclSimpleXMLElem; const AType: string; + const TotalCoveredCount, TotalUncoveredCount: Integer); + function GetCoverageStringValue(const ACovered, ATotal: Integer): string; public constructor Create(const ACoverageConfiguration: ICoverageConfiguration); - procedure Generate( - const ACoverage: ICoverageStats; - const AModuleInfoList: TModuleList; + procedure Generate(const ACoverage: ICoverageStats; const AModuleInfoList: TModuleList; const ALogManager: ILogManager); end; @@ -67,18 +60,15 @@ implementation System.SysUtils, System.Math, JclFileUtils, - CoverageStats; + Generics.Collections, CoverageStats; -constructor TJacocoCoverageReport.Create( - const ACoverageConfiguration: ICoverageConfiguration); +constructor TJacocoCoverageReport.Create(const ACoverageConfiguration: ICoverageConfiguration); begin inherited Create; FCoverageConfiguration := ACoverageConfiguration; end; -procedure TJacocoCoverageReport.Generate( - const ACoverage: ICoverageStats; - const AModuleInfoList: TModuleList; +procedure TJacocoCoverageReport.Generate(const ACoverage: ICoverageStats; const AModuleInfoList: TModuleList; const ALogManager: ILogManager); var @@ -86,9 +76,7 @@ procedure TJacocoCoverageReport.Generate( procedure AddValueElement(const AElementName: string; const AValue: Integer); begin - StatsElement.Items - .Add(AElementName) - .Properties.Add('value', AValue); + StatsElement.Items.Add(AElementName).Properties.Add('value', AValue); end; procedure AddElement(AElement: TJclSimpleXMLElem; const APropertyName: string; const AValue: Integer); overload; @@ -108,195 +96,232 @@ procedure TJacocoCoverageReport.Generate( ModuleInfo: TModuleInfo; XML: TJclSimpleXML; SessionElement: TJclSimpleXMLElem; + DataElement: TJclSimpleXMLElem; + LineHitsElement: TJclSimpleXMLElem; + CoverageIndex: Integer; + FileIndex: Integer; + ModuleCoverage: ICoverageStats; + XmlLinesCoverage: ICoverageStats; begin ALogManager.Log('Generating jacoco xml report'); XML := TJclSimpleXML.Create; try + // Prolog doesn't seem to get written properly (with carriage returns) XML.Prolog.AddDocType('report PUBLIC "-//JACOCO//DTD Report 1.0//EN" "report.dtd"'); XML.Prolog.Standalone := true; - XML.Root.Name := 'report'; - AddElement(XML.Root, 'name', 'debug'); // For now + AddElement(XML.Root, 'name', 'debug'); // For now SessionElement := XML.Root.Items.Add('session'); Result := CreateGuid(Uid); if Result = S_OK then - SessionElement.Properties.Add('id', GuidToString(Uid)); { TODO: Not sure of the format } + SessionElement.Properties.Add('id', GuidToString(Uid)); { TODO: Not sure of the format } SessionElement.Properties.Add('start', DateTimeToUnix(now)); { TODO: Should be a start time } SessionElement.Properties.Add('dump', DateTimeToUnix(now)); for ModuleInfo in AModuleInfoList do begin - AddModuleInfo(XML.Root, ModuleInfo); + AddModuleInfo(XML.Root, ModuleInfo, ACoverage); end; + (* + if FCoverageConfiguration.XmlLines then + begin + if FCoverageConfiguration.XmlMergeGenerics then begin + ALogManager.Log('Merging units for generics.'); + XmlLinesCoverage := MergeCoverageStatsForGenerics(ACoverage); + end else + XmlLinesCoverage := ACoverage; + + LineHitsElement := DataElement.Items.Add('linehits'); + for CoverageIndex := 0 to XmlLinesCoverage.Count - 1 do + begin + ModuleCoverage := XmlLinesCoverage.CoverageReport[CoverageIndex]; + ALogManager.Log('Coverage for module: ' + ModuleCoverage.Name); + for FileIndex := 0 to ModuleCoverage.Count - 1 do + begin + AddModuleLineHits(LineHitsElement, ModuleCoverage[FileIndex]); + end; + end; + end; + *) - XML.SaveToFile( - PathAppend(FCoverageConfiguration.OutputDir, 'jacoco.xml') - ); + XML.SaveToFile(PathAppend(FCoverageConfiguration.OutputDir, 'jacoco.xml'), seUTF8); finally XML.Free; end; end; - -procedure TJacocoCoverageReport.AddModuleInfo( - AAllElement: TJclSimpleXMLElem; - const AModuleInfo: TModuleInfo); +procedure TJacocoCoverageReport.AddModuleInfo(AAllElement: TJclSimpleXMLElem; const AModuleInfo: TModuleInfo; + const ACoverage: ICoverageStats); var PackageElement: TJclSimpleXMLElem; SourceFileElement: TJclSimpleXMLElem; - ClassInfo: TClassInfo; begin PackageElement := AAllElement.Items.Add('package'); - PackageElement.Properties.Add('name', AModuleInfo.ModuleName.Replace('.','/')); + PackageElement.Properties.Add('name', AModuleInfo.ModuleName.Replace('.', '/')); - for ClassInfo in AModuleInfo do - begin - AddClassInfo(PackageElement, ClassInfo); - end; + AddClassInfo(PackageElement, AModuleInfo); SourceFileElement := PackageElement.Items.Add('sourcefile'); SourceFileElement.Properties.Add('name', AModuleInfo.ModuleFileName); + AddLineCodeStats(SourceFileElement, ACoverage, AModuleInfo); + { TODO: Lines } AddSourceStats(SourceFileElement, AModuleInfo); + +end; + +procedure TJacocoCoverageReport.AddModuleLineHits(ALineHitsElement: TJclSimpleXMLElem; const ACoverage: ICoverageStats); +var + Line: Integer; + FileElement: TJclSimpleXMLElem; + StringBuilder: TStringBuilder; + CoverageLine: TCoverageLine; +begin + if FCoverageConfiguration.ExcludedUnits.IndexOf(StringReplace(ExtractFileName(ACoverage.Name), + ExtractFileExt(ACoverage.Name), '', [rfReplaceAll, rfIgnoreCase])) < 0 then + begin + FileElement := ALineHitsElement.Items.Add('file'); + FileElement.Properties.Add('name', ACoverage.Name); + StringBuilder := TStringBuilder.Create; + try + for Line := 0 to ACoverage.GetCoverageLineCount - 1 do + begin + CoverageLine := ACoverage.CoverageLine[Line]; + StringBuilder.Append(IfThen(Line = 0, '', ';')).Append(CoverageLine.LineNumber).Append('=') + .Append(CoverageLine.LineCount); + end; + FileElement.Value := StringBuilder.ToString; + finally + StringBuilder.Free; + end; + end; end; -procedure TJacocoCoverageReport.AddSourceStats( - const ARootElement: TJclSimpleXMLElem; const AModule: TModuleInfo); +procedure TJacocoCoverageReport.AddModuleStats(const RootElement: TJclSimpleXMLElem; const AModule: TModuleInfo); begin - AddCoverageElement(ARootElement, - 'LINE', - AModule.CoveredLineCount, - AModule.LineCount - AModule.CoveredLineCount); - - AddCoverageElement(ARootElement, - 'METHOD', - AModule.CoveredMethodCount, - AModule.MethodCount - AModule.CoveredMethodCount); - - AddCoverageElement(ARootElement, - 'CLASS', - AModule.CoveredClassCount, - AModule.ClassCount - AModule.CoveredClassCount); + AddCoverageElement(RootElement, 'class, %', AModule.CoveredClassCount, AModule.ClassCount); + + AddCoverageElement(RootElement, 'method, %', AModule.CoveredMethodCount, AModule.MethodCount); + + AddCoverageElement(RootElement, 'block, %', AModule.CoveredLineCount, AModule.LineCount); + + AddCoverageElement(RootElement, 'line, %', AModule.CoveredLineCount, AModule.LineCount); end; -procedure TJacocoCoverageReport.AddClassInfo( - ASourceFileElement: TJclSimpleXMLElem; - const AClassInfo: TClassInfo); +procedure TJacocoCoverageReport.AddSourceStats(const ARootElement: TJclSimpleXMLElem; const AModule: TModuleInfo); +begin + AddCoverageElement(ARootElement, 'LINE', AModule.CoveredLineCount, AModule.LineCount - AModule.CoveredLineCount); + + AddCoverageElement(ARootElement, 'METHOD', AModule.CoveredMethodCount, + AModule.MethodCount - AModule.CoveredMethodCount); + + AddCoverageElement(ARootElement, 'CLASS', AModule.CoveredClassCount, AModule.ClassCount - AModule.CoveredClassCount); +end; + +procedure TJacocoCoverageReport.AddClassInfo(ASourceFileElement: TJclSimpleXMLElem; const AModule: TModuleInfo); var Method: TProcedureInfo; ClassElement: TJclSimpleXMLElem; + ClassInfo: TClassInfo; begin - ClassElement := ASourceFileElement.Items.Add('class'); - { TODO: Check whether this is enough } - ClassElement.Properties.Add('name', AClassInfo.Module.Replace('.','/') + '/' + AClassInfo.TheClassName); + for ClassInfo in AModule do + begin + ClassElement := ASourceFileElement.Items.Add('class'); + { TODO: Check whether this is enough } + ClassElement.Properties.Add('name', ClassInfo.Module.Replace('.', '/') + '/' + ClassInfo.TheClassName); + ClassElement.Properties.Add('sourcefilename', AModule.ModuleFileName); - for Method in AClassInfo do - AddMethodInfo(ClassElement, Method); + for Method in ClassInfo do + AddMethodInfo(ClassElement, Method); - AddClassStats(ClassElement, AClassInfo); + AddClassStats(ClassElement, ClassInfo); + end; end; -procedure TJacocoCoverageReport.AddClassStats( - const ARootElement: TJclSimpleXMLElem; - const AClass: TClassInfo); +procedure TJacocoCoverageReport.AddClassStats(const ARootElement: TJclSimpleXMLElem; const AClass: TClassInfo); begin - AddCoverageElement(ARootElement, - 'LINE', - AClass.CoveredLineCount, - AClass.LineCount - AClass.CoveredLineCount); - - AddCoverageElement(ARootElement, - 'METHOD', - AClass.CoveredProcedureCount, - AClass.ProcedureCount - AClass.CoveredProcedureCount); - -// AddCoverageElement(ARootElement, -// 'CLASS', -// AClass., -// 100 - AClass.PercentCovered); + AddCoverageElement(ARootElement, 'LINE', AClass.CoveredLineCount, AClass.LineCount - AClass.CoveredLineCount); + + AddCoverageElement(ARootElement, 'METHOD', AClass.CoveredProcedureCount, + AClass.ProcedureCount - AClass.CoveredProcedureCount); + + // AddCoverageElement(ARootElement, + // 'CLASS', + // AClass., + // 100 - AClass.PercentCovered); end; -procedure TJacocoCoverageReport.AddMethodInfo( - AClassElement: TJclSimpleXMLElem; - const AMethod: TProcedureInfo); +procedure TJacocoCoverageReport.AddMethodInfo(AClassElement: TJclSimpleXMLElem; const AMethod: TProcedureInfo); var MethodElement: TJclSimpleXMLElem; begin MethodElement := AClassElement.Items.Add('method'); MethodElement.Properties.Add('name', AMethod.Name); - MethodElement.Properties.Add('desc', '()'); {TODO: Not sure we can pull this out } + MethodElement.Properties.Add('desc', '()'); { TODO: Not sure we can pull this out } AddMethodStats(MethodElement, AMethod); end; -procedure TJacocoCoverageReport.AddMethodStats( - const ARootElement: TJclSimpleXMLElem; - const AMethod: TProcedureInfo); -//var -// IsCovered: Integer; +procedure TJacocoCoverageReport.AddMethodStats(const ARootElement: TJclSimpleXMLElem; const AMethod: TProcedureInfo); +// var +// IsCovered: Integer; begin -// IsCovered := IfThen(AMethod.PercentCovered > 0, 1, 0); + // IsCovered := IfThen(AMethod.PercentCovered > 0, 1, 0); { TODO: Not sure about these either! } // INSTRUCTION { TODO: Is this the same as LINE? } -// AddCoverageElement(ARootElement, -// 'counter', -// 'INSTRUCTION', -// AMethod.CoveredLineCount, -// AMethod.LineCount - AMethod.CoveredLineCount); + // AddCoverageElement(ARootElement, + // 'counter', + // 'INSTRUCTION', + // AMethod.CoveredLineCount, + // AMethod.LineCount - AMethod.CoveredLineCount); // LINE - AddCoverageElement(ARootElement, - 'LINE', - AMethod.CoveredLineCount, - AMethod.LineCount - AMethod.CoveredLineCount); - -// AddCoverageElement(ARootElement, -// 'METHOD', -// AMethod.PercentCovered, -// 100 - AMethod.PercentCovered); + AddCoverageElement(ARootElement, 'LINE', AMethod.CoveredLineCount, AMethod.LineCount - AMethod.CoveredLineCount); -// AddCoverageElement(ARootElement, -// 'counter', -// 'INSTRUCTION', -// AMethod.CoveredLineCount, -// AMethod.LineCount - AMethod.CoveredLineCount); + // AddCoverageElement(ARootElement, + // 'METHOD', + // AMethod.PercentCovered, + // 100 - AMethod.PercentCovered); -// AddCoverageElement(ARootElement, -// 'counter', -// 'COMPLEXITY', -// AMethod.CoveredLineCount, -// AMethod.LineCount - AMethod.CoveredLineCount); + // AddCoverageElement(ARootElement, + // 'counter', + // 'INSTRUCTION', + // AMethod.CoveredLineCount, + // AMethod.LineCount - AMethod.CoveredLineCount); + // AddCoverageElement(ARootElement, + // 'counter', + // 'COMPLEXITY', + // AMethod.CoveredLineCount, + // AMethod.LineCount - AMethod.CoveredLineCount); (* - AddCoverageElement( + AddCoverageElement( ARootElement, 'counter', AMethod.CoveredLineCount, AMethod.LineCount - ); + ); - AddCoverageElement( + AddCoverageElement( ARootElement, 'counter', AMethod.CoveredLineCount, AMethod.LineCount - ); + ); - AddCoverageElement( + AddCoverageElement( ARootElement, 'counter', AMethod.CoveredLineCount, AMethod.LineCount - ); + ); *) end; -procedure TJacocoCoverageReport.AddCoverageElement( - const RootElement: TJclSimpleXMLElem; - const AType: string; +procedure TJacocoCoverageReport.AddCoverageElement(const RootElement: TJclSimpleXMLElem; const AType: string; const TotalCoveredCount, TotalUncoveredCount: Integer); var CoverageElement: TJclSimpleXMLElem; @@ -308,25 +333,64 @@ procedure TJacocoCoverageReport.AddCoverageElement( end; +procedure TJacocoCoverageReport.AddLineCodeStats(ARootElement: TJclSimpleXMLElem; const ACoverage: ICoverageStats; + const AModule: TModuleInfo); +var + LineCount: Integer; + LineCoverage: TCoverageLine; + CoverageUnit: ICoverageStats; + CoverageLineElement: TJclSimpleXMLElem; +begin + LineCount := 0; + + CoverageUnit := ACoverage.CoverageReportByName[AModule.ModuleName].CoverageReportByName[AModule.ModuleFileName]; -{$REGION 'TJacocoCoverageReportMerger'} + for LineCount := 0 to Pred(CoverageUnit.LineCount) do + begin + LineCoverage := CoverageUnit.CoverageLine[LineCount]; -class function TJacocoCoverageReportMerger.MergeCoverageStatsForGenerics( - const ACoverageStatsIn: ICoverageStats): ICoverageStats; + CoverageLineElement := ARootElement.Items.Add('line'); + CoverageLineElement.Properties.Add('nr', LineCoverage.LineNumber); + + CoverageLineElement.Properties.Add('mi', IfThen(LineCoverage.IsCovered, 0, 1)); + CoverageLineElement.Properties.Add('ci', IfThen(LineCoverage.IsCovered, 1, 0)); + CoverageLineElement.Properties.Add('mb', 0); + CoverageLineElement.Properties.Add('cb', 0); + end; +end; + +function TJacocoCoverageReport.GetCoverageStringValue(const ACovered, ATotal: Integer): string; var - i, j, line: Integer; + Percent: Integer; +begin + if ATotal = 0 then + Percent := 0 + else + Percent := Round(ACovered * 100 / ATotal); + + Result := IntToStr(Percent) + '% (' + IntToStr(ACovered) + '/' + IntToStr(ATotal) + ')'; +end; + +{ TJacocoCoverageReportMerger } + +class function TJacocoCoverageReportMerger.MergeCoverageStatsForGenerics(const ACoverageStatsIn: ICoverageStats) + : ICoverageStats; +var + i, j, Line: Integer; LModuleStats, LUnitStats, LResultStats: ICoverageStats; FResultModuleName, FResultUnitName: String; LCoverageLine: TCoverageLine; begin Result := TCoverageStats.Create(ACoverageStatsIn.Name, ACoverageStatsIn.Parent); - //Loop all modules - for i := 0 to ACoverageStatsIn.Count - 1 do begin + // Loop all modules + for i := 0 to ACoverageStatsIn.Count - 1 do + begin LModuleStats := ACoverageStatsIn.CoverageReport[i]; - //Loop all units - for j := 0 to LModuleStats.Count - 1 do begin + // Loop all units + for j := 0 to LModuleStats.Count - 1 do + begin LUnitStats := LModuleStats.CoverageReport[j]; FResultModuleName := LUnitStats.Name.Substring(0, LUnitStats.Name.LastIndexOf('.')); @@ -334,9 +398,10 @@ class function TJacocoCoverageReportMerger.MergeCoverageStatsForGenerics( LResultStats := Result.CoverageReportByName[FResultModuleName].CoverageReportByName[FResultUnitName]; - //Add all coverage lines - for line := 0 to ACoverageStatsIn.CoverageReport[i].CoverageReport[j].GetCoverageLineCount - 1 do begin - LCoverageLine := ACoverageStatsIn.CoverageReport[i].CoverageReport[j].CoverageLine[line]; + // Add all coverage lines + for Line := 0 to ACoverageStatsIn.CoverageReport[i].CoverageReport[j].GetCoverageLineCount - 1 do + begin + LCoverageLine := ACoverageStatsIn.CoverageReport[i].CoverageReport[j].CoverageLine[Line]; LResultStats.AddLineCoverage(LCoverageLine.LineNumber, LCoverageLine.LineCount); end; end; @@ -345,6 +410,4 @@ class function TJacocoCoverageReportMerger.MergeCoverageStatsForGenerics( Result.Calculate; end; -{$REGION} - end.