------------------------------------------------------------------------------ -- -- -- ASIS UTILITY LIBRARY COMPONENTS -- -- -- -- A S I S _ U L . S O U R C E _ T A B L E -- -- -- -- S p e c -- -- -- -- Copyright (C) 2004-2018, AdaCore -- -- -- -- Asis Utility Library (ASIS UL) 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 3, or (at your -- -- option) any later version. ASIS UL 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 -- -- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy -- -- of the license. -- -- -- -- ASIS UL is maintained by AdaCore (http://www.adacore.com). -- -- -- ------------------------------------------------------------------------------ pragma Ada_2012; -- This package defines the source file table - the table containing the -- information about the source files to be processed and the state of their -- processing. Used by Several_Files_Driver. with Ada.Containers.Indefinite_Ordered_Sets; with GNAT.OS_Lib; use GNAT.OS_Lib; with Asis; with ASIS_UL.Misc; with ASIS_UL.Projects; use ASIS_UL.Projects; package ASIS_UL.Source_Table is Low_SF_Bound : constant := 0; High_SF_Bound : constant := 999_999; -- Almost 1_000_000 source files for one run of the tool type SF_Id is range Low_SF_Bound .. High_SF_Bound; No_SF_Id : constant SF_Id := Low_SF_Bound; First_SF_Id : constant SF_Id := No_SF_Id + 1; Total_Sources : Natural; Sources_Left : Natural; -- Counters used to form and output progress information. type SF_Status is ( Waiting, -- Waiting for processing Waiting_Subunit, -- We have visited the source, detected that it is a subunit and -- postponed its processing. Not_A_Legal_Source, -- The file does not contain compilable source Not_A_Legal_Source_Needs_Listing_Processing, -- The file does not contain compilable source. The difference with the -- previous state is that this state tells the gnatcheck tool that the -- compiler error messages should be collected for gnatcheck report. Error_Detected, -- Some tool problem has been detected when processing this source -- so the results of processing may not be safe Out_File_Problem, -- The out file was not successfully created or opened ASIS_Processed, Non_ASIS_Processed, Processed, -- The source file has been successfully processed Preparing_Tree, -- The compilation that creates the tree for the source has been started -- but not sure to be finished Tree_Is_Ready, -- The tree for the source has been successfully created. Waiting_For_Closure -- The source is waiting for the decision if it should be added to the -- closure being computed ); type SF_Info is new Integer; -- The type to be used for the integer values associate with each source in -- the source file table. The use of this value is client-specific function Present (SF : SF_Id) return Boolean; -- Checks that SF is not is equal to No_SF_Id function Get_File_Names_Case_Sensitive return Integer; pragma Import (C, Get_File_Names_Case_Sensitive, "__gnat_get_file_names_case_sensitive"); File_Names_Case_Sensitive : constant Boolean := Get_File_Names_Case_Sensitive /= 0; -- Set to indicate whether the operating system convention is for file -- names to be case sensitive (e.g., in Unix, set True), or non case -- sensitive (e.g., in Windows, set False). This code is taken as is from -- the GNAT Osint package to avoid dependency on Osint function File_Find (SF_Name : String; Use_Short_Name : Boolean := False; Case_Sensitive : Boolean := File_Names_Case_Sensitive) return SF_Id; -- Returns the Id of the file with name SF_Name stored in the files -- table. Returns No_SF_Id if the table does not contain such a file. -- In case if ASIS_UL.Common.Use_Project_File_Obsolete is set ON, or -- Use_Short_Name parameter is set ON, the short file name is used to -- locate the file; if the argument contains a directory information it is -- stripped out. Otherwise this function tries to locate the name with the -- full normalized name equal to SF_Name. -- If Case_Sensitive is OFF, then this function first looks for the SF_Name -- using the original casing of SF_Name and files stored in the Source -- Table, and if it cannot locate the file, it repeats the search with all -- the path/file names converted to lower case. function File_Find (El : Asis.Element) return SF_Id; -- Returns the Id of the file containing the argument Element enclosing -- compilation unit. Returns No_SF_Id if the argument is Nil_Element or -- if the source file table does not contain the given file. procedure Add_Source_To_Process (Fname : String; Arg_Project : Arg_Project_Type'Class; Duplication_Report : Boolean := True; Status : SF_Status := Waiting); -- Fname is treated as the name of the file to process by the tool. We try -- to add this file to the table of files to process. The following checks -- are performed: -- -- If ASIS_UL.Common.Use_Project_File_Obsolete is set ON: -- -- - This routine checks if we have already stored a file with the same -- short(!) name. If we already have such a file, it generates a -- warning message (if Duplication_Report is set ON) and does nothing -- else. -- -- Note that ASIS_UL.Common.Use_Project_File_Obsolete corresponds to the -- very old partial implementation of the project support for ASIS tools, -- we keep it for compatibility reasons only (AJIS???). It should not be -- used by any new tool. -- -- If ASIS_UL.Common.Use_Project_File_Obsolete is set OFF: -- -- - First, this routine checks if Fname is the name of some existing file, -- and if it is not, generates the corresponding diagnosis and does -- nothing more. If Arg_Project represents a project file being a tool -- parameter, it uses the corresponding project to check the file -- existence (no source search path should be used in this case!). -- Otherwise this procedure takes into account the search path for the -- Ada sources only if ASIS_UL.Compiler_Options.Source_Search_Path is -- set, otherwise it just calls GNAT.OS_Lib.Is_Readable_File (Fname) -- and checks the result. -- -- - Then, it checks if we already have stored a file with the same name. -- If we have the file with the same name, but from a different -- directory, a warning is generated, but the file is added to the file -- table (the situation when the metric tool is called to process files -- with the same name but from different directories looks strange, but -- this may be quite legal and reasonable). But if we have already stored -- in the list the name of exactly the same file, we generate the error -- message and do not change anything in the list of files. -- -- At this stage we do not know if Fname denotes a compilable Ada source -- file. -- -- This procedure tries to detect if this source is the source of a -- body unit, and if so, stores this in the corresponding record of the -- source table. To define this, it checks the suffix of the file name. -- It treats suffixes '.adb' and '.2.ada' as suffixes of body files. -- -- It is supposed to be used as a part of the tool parameter processing -- in the following way: -- -- loop -- declare -- Arg : constant String := Get_Argument (...); -- begin -- exit when Arg = ""; -- Add_Source_To_Process (Arg); -- end; -- end loop; procedure Store_Sources_To_Process (Fname : String; Store : Boolean := True); -- Fname is stored in an internal database as the name of the file to be -- processed by the tool. No check is made if Fname denotes an existing -- file. Similar to the previous Add_Source_To_Process routine, this -- procedure is supposed to be used when processing tool parameters. The -- reason to use this procedure instead of Add_Source_To_Process is to do -- the checks if a file exists only when we already have the full search -- path for sources. -- -- If Store is OFF then the procedure does not store anything. -- -- If Fname is not an empty string, sets the -- ASIS_UL.Options.No_Argument_File_Specified flag OFF procedure Read_Args_From_Temp_Storage (Duplication_Report : Boolean; Arg_Project : Arg_Project_Type'Class; Status : SF_Status := Waiting); -- Reads argument files from temporary storage (where they are placed by -- Store_Sources_To_Process/Store_Args_From_File routine(s)). Uses -- Add_Source_To_Process to read each file, so the check if a file exists -- is performed on the base of the source search path -- (ASIS_UL.Compiler_Options.Source_Search_Path) or the project file that -- is a tool argument. This procedure calls Add_Source_To_Process for each -- file to do the existence test and to store source in the source table. -- The temporary storage is cleaned up. -- -- The Duplication_Report parameter has the same meaning as for -- Add_Source_To_Process. procedure Read_Args_From_File (Par_File_Name : String); -- Reads argument files from the file. Stores the file names in the -- temporary storage as Store_Sources_To_Process does. This procedure -- assumes that the file named by Par_File_Name contains argument file -- names, one per line. -- -- This procedure sets the ASIS_UL.Options.No_Argument_File_Specified flag -- OFF. function Files_In_Temp_Storage return Natural; -- Returns the number of files stored in temporary storage. function First_File_In_Temp_Storage return String; -- Returns the simple name of the first file in the temporary file storage -- (according to the way how the storage is ordered). A caller should make -- sure that the temporary storage is not empty. -- -- What actually is needed on a tool side is the name of the file if this -- file is the only file that is kept in the temporary storage. So it may -- make sense to revise this function. procedure Temp_Storage_Iterate (Action : not null access procedure (File_Name : String)); -- Call Action for each File_Name in the temporary file storage function Arg_Source_File_Name return String; -- If the tool is called with all the argument sources specified in a -- single text file (using '-files=arg_files' option), returns the name of -- this file. Otherwise returns null string. -- If the tool is called from the GNAT driver, the result of this function -- corresponds to the call generated by the GNAT driver, but not to the -- call to the GNAT driver. Individual_Files_Specified : Boolean := False; -- Flag indicating if for the tool call there is at least one source file -- explicitly specified in the command line. Note that the tool has itself -- to take care of proper setting of this flag. ------------------------------------------------------- -- Recommended way of reading tool argument sources -- ------------------------------------------------------- -- If you would like to make sure that the search path specified by the -- tool '-I' options or by a project file (in case when the tool is called -- from the GNAT driver) is used when locating the argument sources, use -- the following procedure: -- -- - When processing tool parameters, use Store_Sources_To_Process instead -- of Add_Source_To_Process; -- -- - after reading all the tool arguments, use the following sequence of -- calls: -- -- ASIS_UL.Compiler_Options.Process_ADA_PRJ_INCLUDE_FILE; -- ASIS_UL.Compiler_Options.Set_Source_Search_Path; -- ASIS_UL.Source_Table.Read_Args_From_Temp_Storage (...);' function Add_Needed_Source (Fname : String) return SF_Id; -- This function unconditionally stores the file with the name Fname in the -- source file table and returns the corresponding Id. Fname should be a -- full (???) name of existing file. This procedure is supposed to be -- called to store the name of the file that is not the argument of the -- tool, but that is detected as a file that is needed because of any -- reason for some argument file. For example, it may be a file containing -- a unit needed to be analyzed to build a full call graph. The caller is -- responsible for the fact that this source has not been already stored in -- the file table. function Last_Source return SF_Id; -- Returns the Id of the last source stored in the source table. Returns -- No_SF_Id if there is no source file stored function Total_Sources_To_Process return Natural; -- Returns the number of the arument sources to be processed. This may be -- different from Last_Source if '--ignore=...' option specifies the list -- of files to be ignored. function Exempted_Sources return Natural; -- Returns the number of (existing) sources marked as ignored/exempted as -- the result of '--ignore=...' option. function Last_Argument_Source return SF_Id; -- Returns the Id of the last argument source stored in the source table. -- An argument source is the source set as the argument of the tool call. function Is_Argument_Source (SF : SF_Id) return Boolean; -- Checks if SF is from tool argument sources function Is_Needed_Source (SF : SF_Id) return Boolean; -- Checks if SF is a source that has been added as a needed source for some -- argument source (i.e. Is_Argument_Source is False). procedure Reset_Source_Iterator; function Next_Non_Processed_Source (Only_Bodies : Boolean := False; Include_Needed_Sources : Boolean := False) return SF_Id; procedure Create_Tree (SF : SF_Id; Success : out Boolean; Compiler_Out : String := ""; All_Warnings_Off : Boolean := True); -- Tries to create a tree file for SF. Sets Success ON if this attempt is -- successful. Otherwise sets Success OFF, generates the diagnostic -- information, sets the file status for SF to Not_A_Legal_Source and -- decreases the counter of the sources which have to be processed -- (Sources_Left) -- If Compiler_Out is a name of an existing file, this file is used -- to redirect the compiler output into. Otherwise the compiler output is -- sent to Stderr -- If All_Warnings_Off is set ON, the call to the compiler contains an -- option that suppresses all the compiler warnings. -- The tree and the corresponding ALI file are placed in the subdirectory -- of the tool temporary directory that has the name equal to SF string -- image. The file the compiler output is redirected into is placed into -- the tool temporary directory. procedure Output_Source (SF : SF_Id); -- Depending on the options set generates the trace of the units/sources -- processing. If Verbose_Mode is ON, outputs into Stderr the number of the -- units left and the name of the source being processed. Otherwise, if -- Quiet_Mode is OFF, outputs only the number of units left. If -- Progress_Indicator_Mode is ON, generates the output to be used for GPS -- progress indicator. (Unconditionally) decreases the counter of the -- sources which have to be processed (Sources_Left) procedure Source_Clean_Up (SF : SF_Id; Keep_ALI_Files : Boolean := False); -- Minimal clean-up needed for one source (closing and dissociating the -- Context, removing the tree and ALI files created for this source in -- the temporary directory, if Keep_ALI_Files is set ON, ALI file(s) is -- (are) not deleted). function Is_A_Body (SF : SF_Id) return Boolean; -- Checks if SF could be an Ada body file. ---------------------------------------- -- Source file access/update routines -- ---------------------------------------- function Source_Name (SF : SF_Id) return String; -- If ASIS_UL.Common.Use_Project_File_Obsolete is set OFF, this function -- returns the full source file name in absolute normalized form, otherwise -- it result is the same as returned by Short_Source_Name for the same -- argument. function Short_Source_Name (SF : SF_Id) return String; -- Short file name with no directory information function Suffixless_Name (SF : SF_Id) return String; -- Returns the file name with no directory information and with -- no suffix (if any). Can be used to create the name of the tree and -- ALI file that correspond to SF. function CU_Name (SF : SF_Id) return String; procedure Set_CU_Name (SF : SF_Id; N : String); -- Returns (sets) the full expanded Ada name of the compilation unit that -- is contained in the source. -- ??? Should this function return Wide_String??? function Source_Status (SF : SF_Id) return SF_Status; procedure Set_Source_Status (SF : SF_Id; S : SF_Status); -- Queries and updates the source status. function Source_Info (SF : SF_Id) return SF_Info; procedure Set_Source_Info (SF : SF_Id; Info : SF_Info); -- Queries and updates the source Info value. The use of this value is up -- to the client of the source file table. You can store some integer-coded -- information or you can use this value as an index value in some other -- structure. Ignore_Unit : constant ASIS_UL.Source_Table.SF_Info := 1; -- Used to mark units to be ignored in the source table. The exact meaning -- of "to be ignored" depends on a tool. procedure Set_Exemption (Fname : String); -- Marks the argument file in the source table as exempted (depending on -- the tool, either the file is not processed or no result is generated -- for the tool). Generates a warning if Fname does not point to argument -- file). procedure Process_Exemptions is new ASIS_UL.Misc.Parse_File_List (Set_Exemption); -- Reads the content of the text file that contains a list of the units to -- be exempts/ignored and marks the corresponding units in the source -- table. function Compilation_Switches (SF : SF_Id) return String_List; -- Returns the list of switches to be used for this particular file to -- call the compiler to create the tree. procedure Add_Compilation_Switches (SF : SF_Id; Switches : String_List_Access); -- Stores a switch list to be used to create the tree for SF. Once stored, -- the list cannot be freed, so if you use this procedure more then once -- for the same file this results in memory leaks. function Get_Result_Dir (SF : SF_Id) return String; procedure Set_Result_Dir (SF : SF_Id; Path : String); -- Gets/stores a path to the directory where per-file results should be -- placed in. function Get_Compiler_Out_File_Name (SF : SF_Id) return String; -- Gets the name of a temporary file used to redirect the compiler output -- into. In case of gnatcheck we have to analyze the messages generated by -- each compilation issued for tree creation because the compiler error -- messages are included into gnatcheck report. The returned file names are -- different for different argument sources, procedure Source_Table_Debug_Image; -- Prints into Stdout the debug image of the current state of source table -- if the corresponding debug flag is ON (or if ASIS_UL.Options.Debug_Mode -- is ON, but we have to get rid of this flag), otherwise does nothing. ----------------------------- -- Temporary file storage -- ----------------------------- -- We use an ordered set for temporary file storage to ensure as much -- determinism in the tool output as possible (in case if a tool prints out -- the results and/or diagnoses on per-file basis). function File_Name_Is_Less_Than (L, R : String) return Boolean; -- Assuming that L and R are file names compares them as follows: -- -- * if L and/or R contains a directory separator, compares -- lexicographicaly parts that follow the rightmost directory separator. -- If these parts are equal, compares L and R lexicographicaly -- -- * otherwise compares L and R lexicographicaly -- -- Comparisons are case-sensitive. package Temporary_File_Storages is new Ada.Containers.Indefinite_Ordered_Sets (Element_Type => String, "<" => File_Name_Is_Less_Than); ---------------------- -- Problem counters -- ---------------------- Illegal_Sources : Natural := 0; Out_File_Problems : Natural := 0; end ASIS_UL.Source_Table;