DelphiCodeCoverage · Fr0sT-Brutal · Aug 3, 2021 · Aug 3, 2021 · Aug 10, 2021 · Aug 10, 2021
diff --git a/Source/CoverageConfiguration.pas b/Source/CoverageConfiguration.pas
@@ -52,14 +52,18 @@   TCoverageConfiguration = class(TInterfacedObject, ICoverageConfiguration)
     FModuleNameSpaces: TModuleNameSpaceList;
     FUnitNameSpaces: TUnitNameSpaceList;
     FLineCountLimit: Integer;
+    FCodePage: Integer;
     FLogManager: ILogManager;
 
     procedure ReadSourcePathFile(const ASourceFileName: string);
     function ParseParameter(const AParameter: Integer): string;
     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;
+    function GetCodePageFromDProj(const Project: IXMLNode): Integer;
     procedure ParseDProj(const DProjFilename: TFileName);
     function IsPathInExclusionList(const APath: TFileName): Boolean;
     procedure ExcludeSourcePaths;
@@ -88,6 +92,7 @@   TCoverageConfiguration = class(TInterfacedObject, ICoverageConfiguration)
     procedure ParseModuleNameSpaceSwitch(var AParameter: Integer);
     procedure ParseUnitNameSpaceSwitch(var AParameter: Integer);
     procedure ParseLineCountSwitch(var AParameter: Integer);
+    procedure ParseCodePageSwitch(var AParameter: Integer);
   public
     constructor Create(const AParameterProvider: IParameterProvider);
     destructor Destroy; override;
@@ -115,6 +120,7 @@   TCoverageConfiguration = class(TInterfacedObject, ICoverageConfiguration)
     function TestExeExitCode: Boolean;
     function UseTestExePathAsWorkingDir: Boolean;
     function LineCountLimit: Integer;
+    function CodePage: Integer;
 
     function ModuleNameSpace(const AModuleName: string): TModuleNameSpace;
     function UnitNameSpace(const AModuleName: string): TUnitNameSpace;
@@ -211,6 +217,11 @@ function TCoverageConfiguration.LineCountLimit: integer;
   Result := FLineCountLimit;
 end;
 
+function TCoverageConfiguration.CodePage: Integer;
+begin
+  Result := FCodePage;
+end;
+
 function TCoverageConfiguration.IsComplete(var AReason: string): Boolean;
 begin
   if FSourcePathLst.Count = 0 then
@@ -572,6 +583,8 @@ procedure TCoverageConfiguration.ParseSwitch(var AParameter: Integer);
     FStripFileExtension := False
   else if (SwitchItem = I_CoverageConfiguration.cPARAMETER_LINE_COUNT) then
     ParseLineCountSwitch(AParameter)
+  else if (SwitchItem = I_CoverageConfiguration.cPARAMETER_CODE_PAGE) then
+    ParseCodePageSwitch(AParameter)
   else if (SwitchItem = I_CoverageConfiguration.cPARAMETER_EMMA_OUTPUT)
   or (SwitchItem = I_CoverageConfiguration.cPARAMETER_EMMA21_OUTPUT)
   or (SwitchItem = I_CoverageConfiguration.cPARAMETER_EMMA_SEPARATE_META)
@@ -896,13 +909,59 @@ 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.GetCodePageFromDProj(const Project: IXMLNode): Integer;
+var
+  Node: IXMLNode;
+begin
+  Result := 0;
+  Assert(Assigned(Project));
+
+  Node := GetBasePropertyGroupNode(Project);
+  if Node = nil then Exit;
+  Node := Node.ChildNodes.FindNode('DCC_CodePage');
+  if Node = nil then Exit;
+  Result := StrToIntDef(Node.Text, 0);
+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 := '';
@@ -915,15 +974,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
@@ -939,7 +991,6 @@ function TCoverageConfiguration.GetExeOutputFromDProj(const Project: IXMLNode; c
           Result := ChangeFileExt(ProjectName, '.exe');
       end;
     end;
-  end;
 end;
 
 procedure TCoverageConfiguration.ParseDProj(const DProjFilename: TFileName);
@@ -948,7 +999,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;
@@ -969,6 +1020,20 @@ 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;
+
+    FCodePage := GetCodePageFromDProj(Project);
+
     ItemGroup := Project.ChildNodes.FindNode('ItemGroup');
     if ItemGroup <> nil then
     begin
@@ -1101,5 +1166,21 @@ procedure TCoverageConfiguration.ParseLineCountSwitch(var AParameter: Integer);
   end;
 end;
 
+procedure TCoverageConfiguration.ParseCodePageSwitch(var AParameter: Integer);
+var
+  ParsedParameter: string;
+begin
+  Inc(AParameter);
+  ParsedParameter := ParseParameter(AParameter);
+  if ParsedParameter.StartsWith('-') then // This is a switch, not a number
+  begin
+    Dec(AParameter);
+  end
+  else
+  begin
+    FCodePage := StrToIntDef(ParsedParameter, 0);
+  end;
+end;
+
 end.
 
diff --git a/Source/Debugger.pas b/Source/Debugger.pas
@@ -265,6 +265,8 @@ procedure TDebugger.PrintUsage;
       ' dll_or_exe unitname [unitname2]   -- Create a separate namespace (the namespace name will be the name of the module without extension) *ONLY* for the listed units within the module.');
   ConsoleOutput(I_CoverageConfiguration.cPARAMETER_LINE_COUNT +
     ' [number]       -- Count number of times a line is executed up to the specified limit (default 0 - disabled)');
+  ConsoleOutput(I_CoverageConfiguration.cPARAMETER_CODE_PAGE +
+    ' [number]        -- Code page of source files');
   ConsoleOutput(I_CoverageConfiguration.cPARAMETER_TESTEXE_EXIT_CODE +
     '                -- Passthrough the exitcode of the application');
   ConsoleOutput(I_CoverageConfiguration.cPARAMETER_USE_TESTEXE_WORKING_DIR +

diff --git a/Source/HTMLCoverageReport.pas b/Source/HTMLCoverageReport.pas
@@ -201,6 +201,7 @@ function THTMLCoverageReport.GenerateUnitReport(
   OutputFile: TTextWriter;
   SourceFileName: string;
   OutputFileName: string;
+  Encoding: TEncoding;
 begin
   Result.HasFile:= False;
   Result.LinkFileName:= ACoverageUnit.ReportFileName + '.html';
@@ -211,7 +212,11 @@ function THTMLCoverageReport.GenerateUnitReport(
     SourceFileName := FindSourceFile(ACoverageUnit, Result);
 
     try
-      InputFile := TStreamReader.Create(SourceFileName, TEncoding.ANSI, True);
+      if FCoverageConfiguration.CodePage <> 0 then
+        Encoding := TEncoding.GetEncoding(FCoverageConfiguration.CodePage)
+      else
+        Encoding := TEncoding.ANSI;
+      InputFile := TStreamReader.Create(SourceFileName, Encoding, True);
     except
       on E: EFileStreamError do
       begin

diff --git a/Source/I_CoverageConfiguration.pas b/Source/I_CoverageConfiguration.pas
@@ -44,6 +44,7 @@ interface
     function ModuleNameSpace(const AModuleName: string): TModuleNameSpace;
     function UnitNameSpace(const AModuleName: string): TUnitNameSpace;
     function LineCountLimit: Integer;
+    function CodePage: Integer;
   end;
 
 const
@@ -77,6 +78,7 @@ interface
   cPARAMETER_TESTEXE_EXIT_CODE = '-tec';
   cPARAMETER_USE_TESTEXE_WORKING_DIR = '-twd';
   cPARAMETER_LINE_COUNT = '-lcl';
+  cPARAMETER_CODE_PAGE = '-cp';
 
   cIGNORE_UNIT_PREFIX = '!';
 implementation

diff --git a/Test/CoverageConfigurationTest.pas b/Test/CoverageConfigurationTest.pas
@@ -31,6 +31,7 @@   TCoverageConfigurationTest = class(TTestCase)
     procedure TestInvalidParameter;
 
     procedure TestEnableApiLogging;
+    procedure TestSetCodepage;
 
     procedure TestEnableFileLoggingDefaultFile;
     procedure TestEnableFileLoggingSpecifiedFile;
@@ -115,6 +116,7 @@ implementation
   cUNIT_PARAMETER                   : array [0 .. 0] of string = (I_CoverageConfiguration.cPARAMETER_UNIT);
   cMAP_FILE_PARAMETER               : array [0 .. 0] of string = (I_CoverageConfiguration.cPARAMETER_MAP_FILE);
   cEXECUTABLE_PARAMETER             : array [0 .. 0] of string = (I_CoverageConfiguration.cPARAMETER_EXECUTABLE);
+  cCODE_PAGE                        : array [0 .. 1] of string = (I_CoverageConfiguration.cPARAMETER_CODE_PAGE, '1250');
   cSOME_EXTENSION = '.someExt';
   cEXCLUDE_FILES_PREFIX = 'exclude';
 //==============================================================================
@@ -231,6 +233,16 @@ procedure TCoverageConfigurationTest.TestEnableApiLogging;
   CheckTrue(LCoverageConfiguration.UseApiDebug, 'API Logging was not turned on.');
 end;
 
+//==============================================================================
+procedure TCoverageConfigurationTest.TestSetCodepage;
+var
+  LCoverageConfiguration: ICoverageConfiguration;
+begin
+  LCoverageConfiguration := TCoverageConfiguration.Create(TMockCommandLineProvider.Create(cCODE_PAGE));
+  LCoverageConfiguration.ParseCommandLine;
+  CheckEquals(StrToInt(cCODE_PAGE[1]), LCoverageConfiguration.CodePage, 'Code page was not set.');
+end;
+
 //==============================================================================
 procedure TCoverageConfigurationTest.TestEnableFileLoggingDefaultFile;
 var
@@ -1470,6 +1482,7 @@ procedure TCoverageConfigurationTest.TestDProj;
   LCoverageConfiguration  : ICoverageConfiguration;
   I                       : Integer;
   ExpectedExeName         : TFileName;
+  ExpectedSourcePath      : TFileName;
   PlatformName            : string;
 begin
   LExeName := RandomFileName();
@@ -1483,6 +1496,8 @@ 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('<DCC_CodePage>65001</DCC_CodePage>');
     LDProj.Add('</PropertyGroup>');
 
     LTotalUnitList := TStringList.Create;
@@ -1516,6 +1531,9 @@ 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');
+      CheckEquals(65001, LCoverageConfiguration.CodePage, 'Incorrect code page');
 
       for I := 0 to Pred(LTotalUnitList.Count) do
         CheckNotEquals(-1, LCoverageConfiguration.Units.IndexOf(LTotalUnitList[I]), 'Missing unit name');