diff --git a/tools/gnatcov/instrument-ada_unit.adb b/tools/gnatcov/instrument-ada_unit.adb index 6a3f37000..bd43a44cb 100644 --- a/tools/gnatcov/instrument-ada_unit.adb +++ b/tools/gnatcov/instrument-ada_unit.adb @@ -7799,10 +7799,10 @@ package body Instrument.Ada_Unit is ------------------------------------ overriding procedure Replace_Manual_Dump_Indication - (Self : in out Ada_Instrumenter_Type; - Done : in out Boolean; - Prj : in out Prj_Desc; - Source : GNATCOLL.Projects.File_Info) + (Self : in out Ada_Instrumenter_Type; + Prj : in out Prj_Desc; + Source : GNATCOLL.Projects.File_Info; + Has_Manual_Indication : out Boolean) is Instrumented_Filename : constant String := +(Prj.Output_Dir & "/" & GNATCOLL.VFS."+" (Source.File.Base_Name)); @@ -7853,7 +7853,7 @@ package body Instrument.Ada_Unit is -- The pragma statement to be replaced by the actual call -- to Dump_Buffers has been found. - if not Done then + if not Has_Manual_Indication then Start_Rewriting (Rewriter, Self, Prj, File_To_Search); end if; @@ -7870,7 +7870,7 @@ package body Instrument.Ada_Unit is begin -- Add the with clause only once in the file - if not Done then + if not Has_Manual_Indication then Insert_Last (Handle (Unit.Root.As_Compilation_Unit.F_Prelude), Create_From_Template @@ -7891,7 +7891,7 @@ package body Instrument.Ada_Unit is Rule => Call_Stmt_Rule)); end; - Done := True; + Has_Manual_Indication := True; return Over; end if; end; @@ -7913,11 +7913,12 @@ package body Instrument.Ada_Unit is -- initialized which will lead to finalization issues. To avoid this, -- make sure it is set to No_Rewriting_Handle. + Has_Manual_Indication := False; Rewriter.Handle := No_Rewriting_Handle; Unit.Root.Traverse (Find_And_Replace_Pragma'Access); - if Done then + if Has_Manual_Indication then Create_Directory_If_Not_Exists (GNATCOLL.VFS."+" (Source.Project.Object_Dir.Base_Dir_Name)); Create_Directory_If_Not_Exists (+Prj.Output_Dir); diff --git a/tools/gnatcov/instrument-ada_unit.ads b/tools/gnatcov/instrument-ada_unit.ads index 686b337af..3f8edeb49 100644 --- a/tools/gnatcov/instrument-ada_unit.ads +++ b/tools/gnatcov/instrument-ada_unit.ads @@ -86,10 +86,10 @@ package Instrument.Ada_Unit is Prj : Prj_Desc); overriding procedure Replace_Manual_Dump_Indication - (Self : in out Ada_Instrumenter_Type; - Done : in out Boolean; - Prj : in out Prj_Desc; - Source : GNATCOLL.Projects.File_Info); + (Self : in out Ada_Instrumenter_Type; + Prj : in out Prj_Desc; + Source : GNATCOLL.Projects.File_Info; + Has_Manual_Indication : out Boolean); -- Once the instrumentation has finished, if the dump trigger is "manual" -- we expect the user to have indicated the place where a call to the -- manual dump buffers procedure should be inserted by the pragma diff --git a/tools/gnatcov/instrument-c.adb b/tools/gnatcov/instrument-c.adb index de1a18deb..9541e1308 100644 --- a/tools/gnatcov/instrument-c.adb +++ b/tools/gnatcov/instrument-c.adb @@ -17,7 +17,6 @@ ------------------------------------------------------------------------------ with Ada.Characters.Handling; -with Ada.Characters.Latin_1; with Ada.Containers; use Ada.Containers; with Ada.Directories; use Ada.Directories; with Ada.Text_IO; use Ada.Text_IO; @@ -30,6 +29,7 @@ with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.Regpat; use GNAT.Regpat; with GNATCOLL.VFS; +with GNATCOLL.Mmap; with Interfaces; use Interfaces; with Interfaces.C; use Interfaces.C; @@ -3838,10 +3838,10 @@ package body Instrument.C is ------------------------------------ overriding procedure Replace_Manual_Dump_Indication - (Self : in out C_Family_Instrumenter_Type; - Done : in out Boolean; - Prj : in out Prj_Desc; - Source : GNATCOLL.Projects.File_Info) + (Self : in out C_Family_Instrumenter_Type; + Prj : in out Prj_Desc; + Source : GNATCOLL.Projects.File_Info; + Has_Manual_Indication : out Boolean) is use GNATCOLL.VFS; Orig_Filename : constant String := +Source.File.Full_Name; @@ -3851,16 +3851,15 @@ package body Instrument.C is declare Options : Analysis_Options; PP_Filename : Unbounded_String; - File : Ada.Text_IO.File_Type; Dummy_Main : Compilation_Unit_Part; Dump_Pat : constant Pattern_Matcher := - Compile ("^[\t ]*\/\* GNATCOV_DUMP_BUFFERS \*\/[ \t]*"); + Compile + ("^[\t ]*\/\* GNATCOV_DUMP_BUFFERS \*\/[ \t]*", + Flags => Multiple_Lines); Matches : Match_Array (0 .. 1); Dump_Procedure : constant String := Dump_Procedure_Symbol (Main => Dummy_Main, Manual => True, Prj_Name => +Prj.Prj_Name); - Contents : Unbounded_String := - +("extern void " & Dump_Procedure & " (void);"); begin -- Preprocess the source, keeping the comment to look for the manual -- dump indication later. @@ -3887,47 +3886,84 @@ package body Instrument.C is end loop; end; - -- Look for the manual dump indication in the preprocessed file + -- Look for the manual dump indication in the preprocessed file. Use + -- the GNATCOLL.Mmap API to map the file contents in memory, as we + -- may need to rewrite it to the source file, with the manual dump + -- indication replaced by an actual call to the dump buffers + -- function. - Ada.Text_IO.Open - (File => File, - Mode => In_File, - Name => (+PP_Filename)); - - while not Ada.Text_IO.End_Of_File (File) loop - declare - Line : constant String := Get_Line (File); - begin - Match (Dump_Pat, Line, Matches); + declare + use GNATCOLL.Mmap; + File : Mapped_File := Open_Read (To_String (PP_Filename)); + Region : Mapped_Region := Read (File); + Raw_Str : constant Str_Access := Data (Region); + Raw_Str_Last : constant Natural := Last (Region); + Str : String renames Raw_Str (1 .. Raw_Str_Last); + + Tmp_Filename : constant String := +PP_Filename & ".tmp"; + Output_File : Ada.Text_IO.File_Type; + -- Temporary file containing the new version of the original file, + -- with inserted calls to dump buffers. The original file is then + -- overwritten by this temporary file. + + Index : Positive := 1; + -- Starting index, or last index of the previous match in the + -- original file. - if Matches (0) /= No_Match then - Contents := Contents & Dump_Procedure & "();"; - Done := True; - else - Contents := Contents & Line; + begin + Has_Manual_Indication := False; + while Index in Str'Range loop + Match (Dump_Pat, Str (Index .. Str'Last), Matches); + exit when Matches (0) = No_Match; + + -- Open the output file if this is the first match we find, + -- then forward the source code that appear before the match + -- unchanged. + + if not Has_Manual_Indication then + Create (Output_File, Out_File, Tmp_Filename); + Has_Manual_Indication := True; end if; + Put (Output_File, Str (Index .. Matches (0).First)); - Contents := Contents & Ada.Characters.Latin_1.LF; - end; - end loop; + -- Replace the match with the call to the dump procedure + + Put (Output_File, Dump_Procedure & "();"); + Index := Matches (0).Last + 1; + end loop; - Ada.Text_IO.Close (File); + -- If we had a manual indication, and thus wrote a modified source + -- file, overwrite the original source file with it. - if Done then - -- Content now holds the text of the original file with calls to - -- the manual dump procedure where the indications and its extern - -- declaration were. Replace the original content of the file with - -- Content. + if Has_Manual_Indication then + declare + Tmp_File : constant Virtual_File := Create (+Tmp_Filename); + Success : Boolean; + begin + -- Flush the rest of the file contents - Ada.Text_IO.Open - (File => File, - Mode => Out_File, - Name => (+PP_Filename)); + Ada.Text_IO.Put (Output_File, Str (Index .. Str'Last)); + Ada.Text_IO.Close (Output_File); - Ada.Text_IO.Put_Line (File, (+Contents)); + Free (Region); + Close (File); - Ada.Text_IO.Close (File); - end if; + -- Overwrite the original file with its newer version + + Tmp_File.Rename + (Full_Name => Create (+(+PP_Filename)), + Success => Success); + if not Success then + Outputs.Fatal_Error + ("Failed to replace manual dump indication for Source " + & (+Source.File.Full_Name)); + end if; + end; + else + Free (Region); + Close (File); + end if; + end; end; end Replace_Manual_Dump_Indication; diff --git a/tools/gnatcov/instrument-c.ads b/tools/gnatcov/instrument-c.ads index ee8a78dc9..cbf5164f0 100644 --- a/tools/gnatcov/instrument-c.ads +++ b/tools/gnatcov/instrument-c.ads @@ -54,10 +54,10 @@ package Instrument.C is Prj : Prj_Desc); overriding procedure Replace_Manual_Dump_Indication - (Self : in out C_Family_Instrumenter_Type; - Done : in out Boolean; - Prj : in out Prj_Desc; - Source : GNATCOLL.Projects.File_Info); + (Self : in out C_Family_Instrumenter_Type; + Prj : in out Prj_Desc; + Source : GNATCOLL.Projects.File_Info; + Has_Manual_Indication : out Boolean); -- Preprocess Source and look through the text content of the preprocessed -- file looking for manual dump indications. The C-like languages, the -- expected indication is the comment alone on its line: diff --git a/tools/gnatcov/instrument-common.ads b/tools/gnatcov/instrument-common.ads index eca9c9f0a..f184c16a7 100644 --- a/tools/gnatcov/instrument-common.ads +++ b/tools/gnatcov/instrument-common.ads @@ -486,14 +486,17 @@ package Instrument.Common is -- the instrumented source files. procedure Replace_Manual_Dump_Indication - (Self : in out Language_Instrumenter; - Done : in out Boolean; - Prj : in out Prj_Desc; - Source : GNATCOLL.Projects.File_Info) is null; + (Self : in out Language_Instrumenter; + Prj : in out Prj_Desc; + Source : GNATCOLL.Projects.File_Info; + Has_Manual_Indication : out Boolean) is null; -- Look for the pragma (for Ada) or comment (for C family languages) -- indicating where the user wishes to the buffers to be dumped in Source. -- When found, replace it with a call to the buffers dump procedure defined -- in the dump helper unit. + -- + -- Has_Manual_Indication indicates whether a manual dump indication was + -- found - and replaced with a call to dump buffers - in the given source. function New_File (Prj : Prj_Desc; Name : String) return String; diff --git a/tools/gnatcov/instrument-projects.adb b/tools/gnatcov/instrument-projects.adb index 59d6e7680..69e897488 100644 --- a/tools/gnatcov/instrument-projects.adb +++ b/tools/gnatcov/instrument-projects.adb @@ -865,9 +865,9 @@ is Contained_Indication : Boolean := False; begin Instrumenter.Replace_Manual_Dump_Indication - (Contained_Indication, - Prj_Info.Desc, - Source); + (Prj_Info.Desc, + Source, + Contained_Indication); if Contained_Indication and then not Is_Root_Prj then