DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

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 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software. 

top - metrics - download
Index: B T

⟦8120660eb⟧ TextFile

    Length: 10396 (0x289c)
    Types: TextFile
    Names: »B«

Derivation

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧

TextFile

with Io;
package body Test_Program_Generation is

    package Naming renames Directory_Tools.Naming;

    Next_Key : Subprogram_Key := 0;

    function Testing return Boolean is separate;
    procedure Register_Test_Package (Package_Object : Object.Handle;
                                     With_Data : in out Unit_Test_Data) is
        Item : String_Table.Item;
    begin
        With_Data.Package_Object := Package_Object;
        Bounded.Copy (With_Data.Package_Name,
                      Naming.Simple_Name (Package_Object));
        Item := String_Table.Unique (Naming.Simple_Name (Package_Object),
                                     With_Data.Unique_Package_Refs);


        if Testing then
            Io.Put_Line ("Package name : " &
                         Naming.Simple_Name (Package_Object));
            Io.New_Line;
        end if;
    end Register_Test_Package;

    procedure Register_Function (Obj : Object.Handle;
                                 Op_Kind : Diana_Utilities.Operator;
                                 Return_Type_Kind : Type_Kind;
                                 Predefined : Boolean;
                                 Return_Type_Name : String;
                                 Return_Type_Package : String;
                                 With_Data : in out Unit_Test_Data;
                                 Key : out Subprogram_Key) is

        Subprogram_Rec : Subprogram_Record;

    begin
        Subprogram_Rec.Subprogram_Object := Obj;

        Subprogram_Rec.Op_Kind := Op_Kind;

        case Op_Kind is
            when Diana_Utilities.Not_An_Operator =>
                if Naming.Is_Overloaded (Obj) then
                    Bounded.Copy (Subprogram_Rec.Test_Name,
                                  Naming.Simple_Name (Obj) & "_NICKNAMED_" &
                                     Naming.Nickname (Obj));
                else
                    Bounded.Copy (Subprogram_Rec.Test_Name,
                                  Naming.Simple_Name (Obj));
                end if;

                Bounded.Copy (Subprogram_Rec.Simple_Name,
                              Naming.Simple_Name (Obj));

            when others =>
                if Predefined then
                    Bounded.Copy (Subprogram_Rec.Test_Name,
                                  Diana_Utilities.Operator'Image (Op_Kind) &
                                     "_For_" & Return_Type_Name);
                else
                    Bounded.Copy (Subprogram_Rec.Test_Name,
                                  Diana_Utilities.Operator'Image (Op_Kind) &
                                     "_For_" & Return_Type_Package &
                                     "_" & Return_Type_Name);
                end if;
                Bounded.Copy (Subprogram_Rec.Simple_Name,
                              Diana_Utilities.Image (Op_Kind));

        end case;

        Subprogram_Rec.Kind := A_Function;

        Subprogram_Rec.Return_Type.Id.Kind := Return_Type_Kind;
        Bounded.Copy (Subprogram_Rec.Return_Type.Id.Package_Name,
                      Return_Type_Package);

        Subprogram_Rec.Return_Type.Is_Predefined := Predefined;

        case Return_Type_Kind is
            when A_String =>
                Subprogram_Rec.Return_Type.Is_String := True;
                With_Data.String_Parameter_Found := True;
            when others =>
                Subprogram_Rec.Return_Type.Is_String := False;
        end case;

        if Return_Type_Name = "" then
            case Return_Type_Kind is
                when A_Boolean =>
                    Bounded.Copy
                       (Subprogram_Rec.Return_Type.Id.Type_Name, "Boolean");
                when A_Character =>
                    Bounded.Copy (Subprogram_Rec.Return_Type.Id.Type_Name,
                                  "Character");
                when A_String =>
                    Bounded.Copy
                       (Subprogram_Rec.Return_Type.Id.Type_Name, "String");
                when An_Integer =>
                    Bounded.Copy
                       (Subprogram_Rec.Return_Type.Id.Type_Name, "Integer");
                when A_Float =>
                    Bounded.Copy
                       (Subprogram_Rec.Return_Type.Id.Type_Name, "Float");
                when A_Duration =>
                    Bounded.Copy
                       (Subprogram_Rec.Return_Type.Id.Type_Name, "Duration");
                when Other =>
                    raise Program_Error;
            end case;
        else
            Bounded.Copy (Subprogram_Rec.Return_Type.Id.Type_Name,
                          Return_Type_Name);

        end if;

        Subprogram_Rec.Parameters := Parameter_List.Nil;

        Subprogram_Map.Define (The_Map => With_Data.Map,
                               D => Next_Key,
                               R => Subprogram_Rec,
                               Trap_Multiples => False);

        Key := Next_Key;
        Next_Key := Next_Key + 1;

        if Testing then
            Io.Put_Line ("Function name : " & Naming.Simple_Name (Obj));
            Io.Put_Line ("Return type: " & Type_Kind'Image (Return_Type_Kind) &
                         " Name: " & Return_Type_Name);
            Io.New_Line;
        end if;
    end Register_Function;

    procedure Register_Procedure (Obj : Object.Handle;
                                  With_Data : in out Unit_Test_Data;
                                  Key : out Subprogram_Key) is

        Subprogram_Rec : Subprogram_Record;

    begin
        Subprogram_Rec.Subprogram_Object := Obj;

        if Naming.Is_Overloaded (Obj) then
            Bounded.Copy (Subprogram_Rec.Test_Name,
                          Naming.Simple_Name (Obj) & "_NICKNAMED_" &
                             Naming.Nickname (Obj));
        else
            Bounded.Copy (Subprogram_Rec.Test_Name, Naming.Simple_Name (Obj));
        end if;

        Bounded.Copy (Subprogram_Rec.Simple_Name, Naming.Simple_Name (Obj));

        Subprogram_Rec.Kind := A_Procedure;

        Subprogram_Rec.Parameters := Parameter_List.Nil;

        Subprogram_Map.Define (The_Map => With_Data.Map,
                               D => Next_Key,
                               R => Subprogram_Rec,
                               Trap_Multiples => False);

        Key := Next_Key;
        Next_Key := Next_Key + 1;

        if Testing then
            Io.Put_Line ("procedure name : " & Naming.Simple_Name (Obj));
            Io.New_Line;
        end if;
    end Register_Procedure;

    procedure Register_Parameter (Formal_Name : String;
                                  Kind : Type_Kind;
                                  Predefined : Boolean;
                                  Mode : Mode_Kind;
                                  Type_Name : String;
                                  Defining_Package : String;
                                  Init_Expression : String;
                                  Key : Subprogram_Key;
                                  With_Data : in out Unit_Test_Data) is

        Subprogram_Rec : Subprogram_Record;
        Parameter_Rec : Parameter_Record;

        Item : String_Table.Item;
    begin
        Subprogram_Rec := Subprogram_Map.Eval (With_Data.Map, Key);

        Bounded.Copy (Parameter_Rec.Formal_Name, Formal_Name);

        Parameter_Rec.Mode := Mode;

        Bounded.Copy (Parameter_Rec.Id.Package_Name, Defining_Package);
        Parameter_Rec.Id.Kind := Kind;

        if Type_Name = "" then
            case Kind is
                when A_Boolean =>
                    Bounded.Copy (Parameter_Rec.Id.Type_Name, "Boolean");
                when A_Character =>
                    Bounded.Copy (Parameter_Rec.Id.Type_Name, "Character");
                when A_String =>
                    Bounded.Copy (Parameter_Rec.Id.Type_Name, "String");
                when An_Integer =>
                    Bounded.Copy (Parameter_Rec.Id.Type_Name, "Integer");
                when A_Float =>
                    Bounded.Copy (Parameter_Rec.Id.Type_Name, "Float");
                when A_Duration =>
                    Bounded.Copy (Parameter_Rec.Id.Type_Name, "Duration");
                when Other =>
                    raise Program_Error;
            end case;
        else
            Bounded.Copy (Parameter_Rec.Id.Type_Name, Type_Name);
        end if;

        if Init_Expression = "" then
            Bounded.Copy (Parameter_Rec.Initial_Expression, "[Expression]");

        else
            Bounded.Copy (Parameter_Rec.Initial_Expression, Init_Expression);
        end if;

        Parameter_Rec.Is_Predefined := Predefined;

        if Kind = A_String then
            Parameter_Rec.Is_String := True;
            With_Data.String_Parameter_Found := True;
        else
            Parameter_Rec.Is_String := False;
        end if;

        case Mode is
            when Out_Mode | In_Out_Mode =>
                Subprogram_Rec.Out_Parameters_Found := True;
            when others =>
                null;
        end case;

        Subprogram_Rec.Parameters :=
           Parameter_List.Make (Parameter_Rec, Subprogram_Rec.Parameters);

        Subprogram_Map.Define (With_Data.Map, Key, Subprogram_Rec);

        Parameter_Id_Set.Add (With_Data.Unique_Parameters, Parameter_Rec.Id);

        if not Predefined then
            Item := String_Table.Unique (Defining_Package,
                                         With_Data.Unique_Package_Refs);
        end if;
        if Testing then
            Io.Put_Line ("  " & Formal_Name & "  " & Type_Kind'Image (Kind) &
                         "  " & Mode_Kind'Image (Mode));
            Io.Put_Line (Defining_Package & "." & Type_Name);
            Io.New_Line;
        end if;
    exception
        when Subprogram_Map.Undefined =>
            raise;
    end Register_Parameter;

    function Temp_File_Name return String is separate;
    procedure Generate_Unit_Test_Program
                 (In_Context : String; From_Data : Unit_Test_Data) is separate;

    function Hash (Subprogram : Subprogram_Key) return Integer is
    begin
        return Integer (Subprogram);
    end Hash;

    procedure Initialize (Unit_Data : in out Unit_Test_Data) is
    begin
        Unit_Data.String_Parameter_Found := False;
        Subprogram_Map.Initialize (Unit_Data.Map);
        Parameter_Id_Set.Initialize (Unit_Data.Unique_Parameters);
    end Initialize;

end Test_Program_Generation;