------------------------------------------------------------------------------ -- -- -- GNATELIM COMPONENTS -- -- -- -- G N A T E L I M . O U T P U T -- -- -- -- B o d y -- -- -- -- Copyright (c) 1997-2002, Free Software Foundation, Inc. -- -- -- -- Gnatelim 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. Gnatelim is distributed in the hope that it will be useful, -- -- but WITHOUT ANY WARRANTY; without even the implied warranty of MER- -- -- CHANTABILITY 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, 59 Temple Place Suite 330, -- -- Boston, MA 02111-1307, USA. -- -- -- -- Gnatelim is distributed as a part of the ASIS implementation for GNAT -- -- (ASIS-for-GNAT). -- -- -- -- Gnatelim was originally developed by Alain Le Guennec -- -- -- -- Gnatelim is now maintained by Ada Core Technologies Inc -- -- (http://www.gnat.com). -- ------------------------------------------------------------------------------ with GNATELIM.Entities; use GNATELIM.Entities; with Asis; use Asis; with Asis.Implementation; with Asis.Compilation_Units; with Asis.Elements; use Asis.Elements; with Asis.Text; with Ada.Strings; use Ada.Strings; with Ada.Strings.Wide_Fixed; use Ada.Strings.Wide_Fixed; with Ada.Wide_Text_IO; use Ada.Wide_Text_IO; package body GNATELIM.Output is Nb_Unused_Subprograms : Natural; -- Counts unused subprograms during the iteration -- through registered subprogram declarations. ------------------------- -- Local subprograms -- ------------------------- function Corresponding_Scopes (Entity : Entity_Id) return Entity_Id_List; -- Returns the Scopes in which Entity is declared. -- The first element of the list is the compilation unit, -- the last element is the Entity itself. -- Corresponding_Scopes (No_Entity) returns a list -- with No_Entity as single element. function Should_Be_Reported (Entity : Entity_Id) return Boolean; -- Returns True if Entity should be reported. function No_Homonym_Is_Used (Entity : Entity_Id) return Boolean; procedure Output_Pragma (Entity : Entity_Id); -- procedure Output_Text_Reference (Entity : Entity_Id); -- procedure Check_If_Used (Entity : in Entity_Id; Continue : in out Boolean); -- Subprogram acting as the Action actual -- for the generic procedure Iterate_For_Unused on Entities. procedure Iterate_For_Unused is new Iterate (Action => Check_If_Used); -------------------------- -- Put_Gnatelim_Version -- -------------------------- procedure Put_Gnatelim_Version is begin Put ("-- GNATELIM (built with "); Put (Asis.Implementation.ASIS_Implementor_Version); Put (")"); end Put_Gnatelim_Version; -------------------------- -- Should_Be_Reported -- -------------------------- function Should_Be_Reported (Entity : Entity_Id) return Boolean is use Asis, Asis.Elements; Element : Asis.Element := Corresponding_Declaration (Entity); begin case Declaration_Kind (Element) is when A_Procedure_Declaration | A_Function_Declaration | A_Procedure_Body_Declaration | A_Function_Body_Declaration | A_Procedure_Body_Stub | A_Function_Body_Stub | A_Procedure_Renaming_Declaration | A_Function_Renaming_Declaration | A_Procedure_Instantiation | A_Function_Instantiation => return True; when others => return False; end case; end Should_Be_Reported; ---------------------------- -- No_Homonym_Is_Used -- ---------------------------- function No_Homonym_Is_Used (Entity : Entity_Id) return Boolean is Homonym : Entity_Id := First_Homonym (Entity); begin while Present (Homonym) loop if Is_Used (Homonym) then return False; end if; Homonym := Next_Homonym (Homonym); end loop; return True; end No_Homonym_Is_Used; ---------------------------- -- Corresponding_Scopes -- ---------------------------- function Corresponding_Scopes (Entity : Entity_Id) return Entity_Id_List is Scope : Entity_Id; begin if No (Entity) then return Entity_Id_List '(1 => No_Entity); else Scope := Get_Scope (Entity); if No (Scope) then return Entity_Id_List '(1 => Entity); else return Corresponding_Scopes (Scope) & Entity; end if; end if; end Corresponding_Scopes; --------------------- -- Output_Pragma -- --------------------- procedure Output_Pragma (Entity : Entity_Id) is Scopes : Entity_Id_List := Corresponding_Scopes (Entity); First : Entity_Id := First_Homonym (Entity); No_Used_Homonyms : Boolean := No_Homonym_Is_Used (Entity); begin pragma Assert (Scopes'Length > 0); -- Case when there is nothing to output: if (No_Used_Homonyms and then First /= Entity) -- All overloads are unused, and the first has already been reported. or else not No_Used_Homonyms -- Only some overloads are used, but we can't yet output the profile, -- so we consider this entity as also used for the moment. then return; end if; -- Now output the unit name, always present. Put ("pragma Eliminate (" & Get_Name (Scopes (Scopes'First))); if Scopes'Length > 1 then -- This is not a library unit. -- We have to output the entity name. Put (", "); -- if Quote_Case then -- Put ('"'); -- end if; for S in Scopes'First + 1 .. Scopes'Last loop declare Name : Wide_String := Get_Name (Scopes (S)); begin for I in Name'Range loop -- if Name (I) = '"' then -- Put ('"'); -- end if; Put (Name (I)); end loop; end; if S < Scopes'Last then Put ('.'); end if; end loop; -- if Quote_Case then -- Put ('"'); -- end if; if not No_Used_Homonyms then -- There are some used homonyms in the same scope. -- We have to output the profile to make a difference. -- Not reachable at the moment anyway. pragma Assert (False); -- Output the parameter types here if any. Put (','); New_Line; Put (" Parameter_Types => ("); -- To be completed later. Put (')'); -- Output the result type if a function. Put (','); New_Line; Put (" Result_Type => """); -- To be completed later. Put ('"'); end if; end if; -- Let's close the pragma. Put_Line (");"); end Output_Pragma; ----------------------------- -- Output_Text_Reference -- ----------------------------- procedure Output_Text_Reference (Entity : Entity_Id) is Span : Asis.Text.Span; Element : Asis.Element; Name : Wide_String := Get_Name (Entity); begin Element := Get_Element (Entity); Put (Asis.Compilation_Units.Text_Name (Asis.Elements.Enclosing_Compilation_Unit (Element)) & ":"); Span := Asis.Text.Element_Span (Element); Put_Line (Ada.Strings.Wide_Fixed.Trim (Integer'Wide_Image (Span.First_Line), Ada.Strings.Left) & ":" & Ada.Strings.Wide_Fixed.Trim (Integer'Wide_Image (Span.First_Column), Ada.Strings.Left) & ":" & Name); end Output_Text_Reference; ----------------------- -- Check if unused -- ----------------------- procedure Check_If_Used (Entity : in Entity_Id; Continue : in out Boolean) is begin if not Is_Used (Entity) and then Should_Be_Reported (Entity) -- and then Is_Library_Level (Entity) then Nb_Unused_Subprograms := Nb_Unused_Subprograms + 1; if Format = Text_References then -- Source reference form. Output_Text_Reference (Entity); else -- Pragma Form. Output_Pragma (Entity); end if; end if; Continue := True; end Check_If_Used; --------------------------------- -- Report_Unused_Subprograms -- --------------------------------- procedure Report_Unused_Subprograms is begin Put_Line ("---------------------------------------------------------"); Put_Line ("-- List of unused entities to be placed in gnat.adc. --"); Put_Line ("---------------------------------------------------------"); Nb_Unused_Subprograms := 0; Iterate_For_Unused; if Nb_Unused_Subprograms = 0 then Put_Line ("-- No unused entities."); end if; end Report_Unused_Subprograms; end GNATELIM.Output;