------------------------------------------------------------------------------ -- -- -- GNATTEST COMPONENTS -- -- -- -- G N A T T E S T . H A R N E S S . S O U R C E _ T A B L E -- -- -- -- B o d y -- -- -- -- Copyright (C) 2011-2016, AdaCore -- -- -- -- GNATTEST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the Free -- -- Software Foundation; either version 2, or (at your option) any later -- -- version. GNATTEST is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -- -- Public License for more details. You should have received a copy of the -- -- GNU General Public License distributed with GNAT; see file COPYING. If -- -- not, write to the Free Software Foundation, 51 Franklin Street, Fifth -- -- Floor, Boston, MA 02110-1301, USA., -- -- -- -- GNATTEST is maintained by AdaCore (http://www.adacore.com). -- -- -- ------------------------------------------------------------------------------ pragma Ada_2012; with Ada.Containers.Indefinite_Ordered_Maps; with Ada.Containers.Indefinite_Ordered_Sets; with GNAT.OS_Lib; use GNAT.OS_Lib; with GNAT.Directory_Operations; use GNAT.Directory_Operations; with GNATtest.Common; use GNATtest.Common; with GNATtest.Options; use GNATtest.Options; package body GNATtest.Harness.Source_Table is ----------------------- -- Source File table -- ----------------------- type SF_Record; Sources_Total : Natural := 1; type SF_Record is record Full_Source_Name : String_Access; -- This field stores the source name with full directory information -- in absolute form Suffixless_Name : String_Access; -- The source name without directory information and suffix (if any) -- is used to create the names of the tree file and ALI files Status : SF_Status; -- Status of the given source. Initially is set to Waiting, then is -- changed according to the results of the metrics computation end record; package Source_File_Table is new Ada.Containers.Indefinite_Ordered_Maps (String, SF_Record); package Source_File_Locations is new Ada.Containers.Indefinite_Ordered_Sets (String); use Source_File_Table; use Source_File_Locations; SF_Table : Source_File_Table.Map; -- Source Table itself SFL_Table : Source_File_Locations.Set; -- A set of paths to source files. Used for creation of project file. SF_Iterator : Source_File_Table.Cursor; SFL_Iterator : Source_File_Locations.Cursor; Short_Source_Name_String : String_Access; Full_Source_Name_String : String_Access; procedure Reset_Source_Iterator; -- Sets SF_Iterator to the begining of SF_Table. ----------------------------- -- Add_Source_To_Process -- ----------------------------- procedure Add_Source_To_Process (Fname : String) is First_Idx : Natural; Last_Idx : Natural; New_SF_Record : SF_Record; begin if not Is_Regular_File (Fname) then Report_Std ("gnattest: " & Fname & " not found"); return; end if; -- Check if we already have a file with the same short name: Short_Source_Name_String := new String'(Base_Name (Fname)); Full_Source_Name_String := new String'(Normalize_Pathname (Fname, Resolve_Links => False, Case_Sensitive => False)); SF_Iterator := Find (SF_Table, Short_Source_Name_String.all); if not (SF_Iterator = Source_File_Table.No_Element) then Report_Std ("gnattest: more than one version of " & Short_Source_Name_String.all & " processed"); Report_Std ("multiple files sharing the same name aren't supported", 10); Report_Std (Full_Source_Name_String.all & " is ignored", 10); return; end if; -- If we are here, we have to store the file in the table -- Making the new SF_Record New_SF_Record.Full_Source_Name := new String'(Full_Source_Name_String.all); First_Idx := Short_Source_Name_String'First; Last_Idx := Short_Source_Name_String'Last; for J in reverse First_Idx + 1 .. Last_Idx loop if Short_Source_Name_String (J) = '.' then Last_Idx := J - 1; exit; end if; end loop; New_SF_Record.Suffixless_Name := new String'(Short_Source_Name_String.all (First_Idx .. Last_Idx)); New_SF_Record.Status := Waiting; Insert (SF_Table, Short_Source_Name_String.all, New_SF_Record); Include (SFL_Table, Normalize_Pathname (Name => Dir_Name (Full_Source_Name_String.all), Case_Sensitive => False)); Sources_Total := Sources_Total + 1; Free (Short_Source_Name_String); Free (Full_Source_Name_String); end Add_Source_To_Process; ---------------- -- Is_Empty -- ---------------- function SF_Table_Empty return Boolean is begin return Is_Empty (SF_Table); end SF_Table_Empty; ---------------------------- -- Get_Source_Full_Name -- ---------------------------- function Get_Source_Full_Name (Source_Name : String) return String is begin return Source_File_Table.Element (SF_Table, Source_Name).Full_Source_Name.all; end Get_Source_Full_Name; ------------------------- -- Get_Source_Status -- ------------------------- function Get_Source_Status (Source_Name : String) return SF_Status is begin return Source_File_Table.Element (SF_Table, Source_Name).Status; end Get_Source_Status; ---------------------------------- -- Get_Source_Suffixless_Name -- ---------------------------------- function Get_Source_Suffixless_Name (Source_Name : String) return String is begin return Source_File_Table.Element (SF_Table, Source_Name).Suffixless_Name.all; end Get_Source_Suffixless_Name; --------------------------------- -- Next_Non_Processed_Source -- --------------------------------- function Next_Non_Processed_Source return String is Cur_Pending : Source_File_Table.Cursor := Source_File_Table.No_Element; Cur_Body : Source_File_Table.Cursor := Source_File_Table.No_Element; begin Reset_Source_Iterator; loop if Cur_Pending = Source_File_Table.No_Element and then Source_File_Table.Element (SF_Iterator).Status = Pending then Cur_Pending := SF_Iterator; end if; if Cur_Pending = Source_File_Table.No_Element and then Source_File_Table.Element (SF_Iterator).Status = Pending_For_Body then Cur_Body := SF_Iterator; end if; if Source_File_Table.Element (SF_Iterator).Status = Waiting then return Key (SF_Iterator); end if; Next (SF_Iterator); exit when SF_Iterator = Source_File_Table.No_Element; end loop; if Cur_Pending /= Source_File_Table.No_Element then return Key (Cur_Pending); end if; if Cur_Body /= Source_File_Table.No_Element then return Key (Cur_Body); end if; return ""; end Next_Non_Processed_Source; ---------------------------- -- Next_Source_Location -- ---------------------------- function Next_Source_Location return String is Cur : Source_File_Locations.Cursor; begin if SFL_Iterator /= Source_File_Locations.No_Element then Cur := SFL_Iterator; Source_File_Locations.Next (SFL_Iterator); return Source_File_Locations.Element (Cur); else return ""; end if; end Next_Source_Location; ------------------- -- Report_Source -- ------------------- procedure Report_Source (S : String) is Im : constant String := Natural'Image (Sources_Total - 1); begin if not Verbose or not Source_Present (S) then return; end if; Sources_Total := Sources_Total - 1; Report_Std ("[" & Im (2 .. Im'Last) & "] " & S); end Report_Source; ------------------------------- -- Reset_Location_Iterator -- ------------------------------- procedure Reset_Location_Iterator is begin SFL_Iterator := First (SFL_Table); end Reset_Location_Iterator; ----------------------------- -- Reset_Source_Iterator -- ----------------------------- procedure Reset_Source_Iterator is begin SF_Iterator := First (SF_Table); end Reset_Source_Iterator; ------------------ -- Set_Status -- ------------------ procedure Set_Source_Status (Source_Name : String; New_Status : SF_Status) is SF_Rec : SF_Record; begin SF_Rec := Source_File_Table.Element (SF_Table, Source_Name); SF_Rec.Status := New_Status; Replace (SF_Table, Source_Name, SF_Rec); end Set_Source_Status; ---------------------- -- Source_Present -- ---------------------- function Source_Present (Source_Name : String) return Boolean is begin return Contains (SF_Table, Source_Name); end Source_Present; end GNATtest.Harness.Source_Table;