DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦f62613a86⟧ Ada Source

    Length: 9216 (0x2400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Find_Unused_Declarations, seg_004415

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

E3 Source Code



with More_String_Utilities;
with Lrm_Utilities;
with Log;
with Profile;
with Common;
with Add_Hyper_Table;
with Create_Null_Document;
with Lrm_Renames;
use Lrm_Renames;
with Directory_Renames;
use Directory_Renames;
with Errors;
with Simple_Status;
with Lrm_Utilities;
package body Find_Unused_Declarations is

    function Replace_Underscores_With_Blanks
                (This_String   : in String;  
                 Old_Character : in Character := '_';
                 New_Character : in Character := ' ';
                 Ignore_Case   : in Boolean   := False) return String
        renames More_String_Utilities.Replaced;

    function Is_Id (Elem : Ada.Element) return Boolean is
    begin
        return Ada."=" (Ada.Id_Kind (Elem), Ada.An_Identifier_Definition);
    end Is_Id;

    function Id_Check (Elem : Ada.Element) return Boolean is
    begin
        if Is_Id (Elem) then
            return Ada.Done (Ada.Usage (Elem));
        else
            return False;
        end if;
    end Id_Check;

    procedure Add (Units       :        String := "";
                   To_Document : in out Abstract_Document.Handle;
                   Response    :        String := "<PROFILE>") is

        Units_Iter : Object.Iterator := Naming.Resolution (Units);

        type Columns is (Parent_Unit, Declaration, Kind);

        function Is_Integer_Column (C : Columns) return Boolean is
        begin
            return False;
        end Is_Integer_Column;

        function Is_Included (Elem : Ada.Element) return Boolean is
            Enclosing : Ada.Element;
        begin
            case Decls.Kind (Elem) is
                when Decls.Not_A_Declaration =>
                    return False;
                when Decls.A_Subprogram_Formal_Parameter =>
                    case Ada.Id_Kind (Elem) is
                        when Ada.An_Identifier_Definition =>
                            -- get to the parent_declaration of
                            -- the parameter
                            Enclosing := Decls.Enclosing_Declaration
                                            (Ada.Parent (Ada.Parent (Elem)));

                        when others =>
                            Enclosing := Decls.Enclosing_Declaration
                                            (Ada.Parent (Elem));
                    end case;
                    case Decls.Kind (Enclosing) is
                        when Decls.A_Procedure_Rename_Declaration |
                             Decls.A_Function_Rename_Declaration =>
                            return False;
                        when others =>
                            return Id_Check (Elem);
                    end case;
                when others =>
                    return Id_Check (Elem);
            end case;
        end Is_Included;

        function Explanation (C    : Columns;  
                              Elem : Ada.Element) return String is
        begin
            case C is
                when Declaration =>
                    return "Name of the unused declaration";
                when Parent_Unit =>
                    return "Name of the parent unit containing the declaration";
                when Kind =>
                    return "The kind of the declaration";
            end case;
        end Explanation;

        function Column_Image (C    : Columns;  
                               Elem : Ada.Element) return String is
        begin
            case C is
                when Declaration =>
                    return Decls.Name (Elem);
                when Parent_Unit =>
                    return Decls.Name
                              (Comp_Units.Unit_Declaration
                                  (Comp_Units.Parent_Compilation_Unit (Elem)));
                when Kind =>
                    case Decls.Kind (Elem) is
                        when Decls.A_Variable_Declaration =>
                            if not Lrm_Utilities.Is_Actual_Variable_Declaration
                                      (Decls.Enclosing_Declaration (Elem)) then
                                return "A RECORD COMPONENT DECLARATION";
                            end if;
                        when others =>
                            null;
                    end case;

                    return Replace_Underscores_With_Blanks
                              (Decls.Declaration_Kinds'Image
                                  (Decls.Kind (Elem)));
            end case;
        end Column_Image;

        procedure Linkage (C                :     Columns;
                           Elem             :     Ada.Element;
                           Linkage_Element  : out Ada.Element;
                           Linkage_Elements : out Ada.Element_List) is
        begin
            Linkage_Elements := Ada.Nil_List;

            case C is
                when Kind =>
                    Linkage_Element := Ada.Nil_Element;
                when Declaration =>
                    Linkage_Element := Elem;
                when Parent_Unit =>
                    Linkage_Element :=
                       Ada.Value (Decls.Identifiers
                                     (Comp_Units.Unit_Declaration
                                         (Comp_Units.Parent_Compilation_Unit
                                             (Elem))));
            end case;

        end Linkage;

        procedure Add_Hyper_Table_To_Doc is
           new Add_Hyper_Table
                  (Is_Included,  
                   Columns,  
                   Is_Integer_Column, Column_Image, Explanation, Linkage,  
                   Table_Title => "UNUSED DECLARATIONS");
    begin
        if Object.Is_Bad (Units_Iter) then
            Log.Put_Line (Units & " is not a valid pathname",
                          Profile.Error_Msg);       else
            Add_Hyper_Table_To_Doc (Units_Iter, To_Document);
        end if;
    end Add;

    procedure Display (Units             : String := "";
                       To_Preview_Object : String := "Unused_Declaration_Info";
                       Response          : String := "<PROFILE>") is
        Document  : Abstract_Document.Handle;
        Condition : Errors.Condition;
    begin

        Create_Null_Document (Named           => To_Preview_Object,
                              Error_Info      => Condition,
                              Document_Handle => Document);

        case Errors.Severity (Condition) is
            when Simple_Status.Problem | Simple_Status.Fatal =>
                Log.Put_Line ("Problem creating object " & To_Preview_Object &
                              ".  " & Errors.Info (Condition),
                              Profile.Error_Msg);
            when others =>

                Add (Units, Document, Response);

                Abstract_Document.Close (Document);
                Common.Definition (To_Preview_Object);

        end case;
    end Display;
end Find_Unused_Declarations;

E3 Meta Data

    nblk1=8
    nid=0
    hdr6=10
        [0x00] rec0=22 rec1=00 rec2=01 rec3=018
        [0x01] rec0=1b rec1=00 rec2=02 rec3=058
        [0x02] rec0=16 rec1=00 rec2=03 rec3=048
        [0x03] rec0=18 rec1=00 rec2=04 rec3=03c
        [0x04] rec0=17 rec1=00 rec2=05 rec3=006
        [0x05] rec0=18 rec1=00 rec2=06 rec3=002
        [0x06] rec0=17 rec1=00 rec2=07 rec3=060
        [0x07] rec0=08 rec1=00 rec2=08 rec3=001
    tail 0x2170016e8815c63ab8f74 0x42a00088462061e03