------------------------------------------------------------------------------
-- --
-- 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;
syntax highlighted by Code2HTML, v. 0.9.1