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

⟦32cf0dcb5⟧ TextFile

    Length: 22750 (0x58de)
    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;
with Compilation;
with Unit_Test_Fragments;
separate (Test_Program_Generation)
procedure Generate_Unit_Test_Program
             (In_Context : String; From_Data : Unit_Test_Data) is

    Temp_File : Io.File_Type;

    Subprogram_Iter : Subprogram_Map.Iterator;
    One_Subprogram : Subprogram_Record;

    Unique_Param_Iter : Parameter_Id_Set.Iterator;
    Unique_Parameter : Parameter_Id;

    Parameter_Iter : Parameter_List.Iterator;
    A_Parameter : Parameter_Record;

    Found_First_Out_Parameter : Boolean := False;

    Package_Prefix : Ada_Name;

    This_Package : constant String := Bounded.Image (From_Data.Package_Name);

    Iter : String_Table.Iterator;

    procedure Put_Line (Line : String) is
    begin
        Io.Put_Line (Temp_File, Line);
    end Put_Line;

    procedure Put (Line : String) is
    begin
        Io.Put (Temp_File, Line);
    end Put;

    package Add is new Unit_Test_Fragments (Put_Line, Put);

    function Parameter_Image (Param : Parameter_Record) return String is
    begin
        if Param.Is_Predefined then
            return Bounded.Image (Param.Id.Type_Name);
        else
            return Bounded.Image (Param.Id.Package_Name) &
                      "." & Bounded.Image (Param.Id.Type_Name);
        end if;

    end Parameter_Image;
begin
    Io.Create (Temp_File, Io.Out_File, Temp_File_Name);

    -- TEST PACKAGE SPEC
    Add.Test_Package (This_Package, Spec => True);
    Add.New_Line;
    Add.Open_And_Close (Spec => True, Package_Name => "not necessary");
    Add.New_Line;

    Subprogram_Map.Init (Subprogram_Iter, From_Data.Map);

    while not Subprogram_Map.Done (Subprogram_Iter) loop
        One_Subprogram := Subprogram_Map.Eval
                             (From_Data.Map, Subprogram_Map.Value
                                                (Subprogram_Iter));

        Add.Test_Subprogram
           (This_Package, Bounded.Image (One_Subprogram.Test_Name),
            Spec => True,
            Subunit => False);
        Add.New_Line;

        Subprogram_Map.Next (Subprogram_Iter);
    end loop;

    Add.End_Token;

    -- TEST PACKAGE BODY

    -- WITH CLAUSES

    String_Table.Init (Iter, From_Data.Unique_Package_Refs);
    while not String_Table.Done (Iter) loop
        Add.With_Clause (String_Table.Image (String_Table.Value (Iter)));
        String_Table.Next (Iter);
    end loop;

    Add.New_Line;
    Add.With_Clause ("Debug_Tools");
    Add.With_Clause ("Report");

    if From_Data.String_Parameter_Found then
        Add.With_Clause ("Unbounded_String");
    end if;

    -- BODY HEADER

    Add.Test_Package (This_Package, Spec => False);
    Add.New_Line;

    -- EQUALITY RENAMES

    if From_Data.String_Parameter_Found then
        Add.Unbounded_Instantiation;
    end if;

    Add.New_Line;

    Parameter_Id_Set.Init (Unique_Param_Iter, From_Data.Unique_Parameters);

    while not Parameter_Id_Set.Done (Unique_Param_Iter) loop

        Unique_Parameter := Parameter_Id_Set.Value (Unique_Param_Iter);

        if Unique_Parameter.Kind = Other then

            Add.Equality_Renames (Bounded.Image (Unique_Parameter.Package_Name),
                                  Bounded.Image (Unique_Parameter.Type_Name));
            Add.New_Line;
            Add.New_Line;
        end if;
        Parameter_Id_Set.Next (Unique_Param_Iter);
    end loop;

    -- TYPE DECLS FOR PARAMETERS:

    Subprogram_Map.Init (Subprogram_Iter, From_Data.Map);

    while not Subprogram_Map.Done (Subprogram_Iter) loop
        One_Subprogram := Subprogram_Map.Eval
                             (From_Data.Map, Subprogram_Map.Value
                                                (Subprogram_Iter));

        -- PARAMETER RECORD COMPONENTS

        Add.Parameter_Record_Header (Bounded.Image (One_Subprogram.Test_Name));

        Parameter_List.Init (Parameter_Iter, One_Subprogram.Parameters);

        while not Parameter_List.Done (Parameter_Iter) loop
            A_Parameter := Parameter_List.Value (Parameter_Iter);

            case A_Parameter.Mode is
                when In_Mode =>
                    Add.Component_Decl
                       (Add.Component_Name
                           (Bounded.Image (A_Parameter.Formal_Name), Add.Input,
                            Bounded.Image (A_Parameter.Id.Type_Name)),
                        Parameter_Image (A_Parameter), A_Parameter.Is_String,
                        Bounded.Image (A_Parameter.Initial_Expression));
                when Out_Mode =>
                    Add.Component_Decl
                       (Add.Component_Name
                           (Bounded.Image (A_Parameter.Formal_Name),
                            Add.Expected,
                            Bounded.Image (A_Parameter.Id.Type_Name)),
                        Parameter_Image (A_Parameter), A_Parameter.Is_String,
                        Bounded.Image (A_Parameter.Initial_Expression));

                when In_Out_Mode =>
                    Add.Component_Decl
                       (Add.Component_Name
                           (Bounded.Image (A_Parameter.Formal_Name), Add.Input,
                            Bounded.Image (A_Parameter.Id.Type_Name)),
                        Parameter_Image (A_Parameter), A_Parameter.Is_String,
                        Bounded.Image (A_Parameter.Initial_Expression));
                    Add.Component_Decl
                       (Add.Component_Name
                           (Bounded.Image (A_Parameter.Formal_Name),
                            Add.Expected,
                            Bounded.Image (A_Parameter.Id.Type_Name)),
                        Parameter_Image (A_Parameter), A_Parameter.Is_String,
                        Bounded.Image (A_Parameter.Initial_Expression));

            end case;

            Parameter_List.Next (Parameter_Iter);
        end loop;

        case One_Subprogram.Kind is
            when A_Function =>

                Add.Component_Decl
                   ("Expected_Function_Return_Value",
                    Parameter_Image (One_Subprogram.Return_Type),
                    One_Subprogram.Return_Type.Is_String, "[expression]");
            when A_Procedure =>
                null;
        end case;

        Add.New_Line;
        Add.End_Token (Add.A_Record);
        Add.New_Line;

        Subprogram_Map.Next (Subprogram_Iter);
    end loop;

    -- IMAGE FUNCTIONS
    Parameter_Id_Set.Init (Unique_Param_Iter, From_Data.Unique_Parameters);

    while not Parameter_Id_Set.Done (Unique_Param_Iter) loop
        Unique_Parameter := Parameter_Id_Set.Value (Unique_Param_Iter);

        if Unique_Parameter.Kind = Other then

            Add.Images (Bounded.Image (Unique_Parameter.Package_Name),
                        Bounded.Image (Unique_Parameter.Type_Name));
            Add.New_Line;
        end if;

        Parameter_Id_Set.Next (Unique_Param_Iter);
    end loop;

    -- OPEN AND CLOSE

    Add.Open_And_Close (Spec => False,
                        Package_Name => Bounded.Image (From_Data.Package_Name));
    Add.New_Line;

    -- TEST SUBPROGRAMS

    Subprogram_Map.Init (Subprogram_Iter, From_Data.Map);

    while not Subprogram_Map.Done (Subprogram_Iter) loop
        One_Subprogram := Subprogram_Map.Eval
                             (From_Data.Map, Subprogram_Map.Value
                                                (Subprogram_Iter));

        -- YIELD PROCEDURE

        Add.Yield_Procedure (Bounded.Image (One_Subprogram.Test_Name));
        Add.New_Line;

        -- SUBPROGRAM STUB

        Add.Test_Subprogram
           (This_Package, Bounded.Image (One_Subprogram.Test_Name),
            Spec => False,
            Subunit => False);
        Add.New_Line;

        Subprogram_Map.Next (Subprogram_Iter);
    end loop;

    Add.End_Token;

    -- DO ALL PROCEDURES AS SUBUNITS

    Subprogram_Map.Init (Subprogram_Iter, From_Data.Map);

    while not Subprogram_Map.Done (Subprogram_Iter) loop

        One_Subprogram := Subprogram_Map.Eval
                             (From_Data.Map, Subprogram_Map.Value
                                                (Subprogram_Iter));

        Subprogram_Map.Next (Subprogram_Iter);

        -- PROCEDURE HEADER
        Add.Test_Subprogram
           (This_Package, Bounded.Image (One_Subprogram.Test_Name),
            Spec => False,
            Subunit => True);

        Add.New_Line;

        Add.Local_Decls (Bounded.Image (One_Subprogram.Test_Name));

        Add.New_Line;

        case One_Subprogram.Kind is
            when A_Function =>
                Add.Function_Return_Value
                   (One_Subprogram.Return_Type.Is_String,
                    Parameter_Image (One_Subprogram.Return_Type));
            when A_Procedure =>
                Parameter_List.Init (Parameter_Iter, One_Subprogram.Parameters);

                while not Parameter_List.Done (Parameter_Iter) loop
                    A_Parameter := Parameter_List.Value (Parameter_Iter);

                    case A_Parameter.Mode is
                        when Out_Mode =>
                            Add.Local_Output_Value
                               (Add.Component_Name
                                   (Bounded.Image (A_Parameter.Formal_Name),
                                    Add.Output,
                                    Bounded.Image (A_Parameter.Id.Type_Name)),
                                Parameter_Image (A_Parameter),
                                A_Parameter.Is_String);
                        when In_Mode | In_Out_Mode =>
                            null;
                    end case;

                    Parameter_List.Next (Parameter_Iter);
                end loop;

        end case;
        Add.New_Line;
        Add.Begin_Token;
        Add.New_Line;
        Add.Begin_Execution (Naming.Unique_Full_Name
                                (One_Subprogram.Subprogram_Object));

        Add.Report_New_Line;
        Add.New_Line;
        Add.While_Terminate_Loop_Header;
        Add.New_Line;
        Add.Report_Capture_Output;
        Add.New_Line;

        -- CALL YIELD FUNCTION

        Add.Yield_Call;
        Add.Report_New_Line;
        Add.New_Line;

        -- REPORT INPUT VALUES

        Add.Report_Comments ("INPUTS:");
        Add.Report_New_Line;
        Add.New_Line;

        Parameter_List.Init (Parameter_Iter, One_Subprogram.Parameters);

        while not Parameter_List.Done (Parameter_Iter) loop
            A_Parameter := Parameter_List.Value (Parameter_Iter);

            case A_Parameter.Mode is
                when In_Mode | In_Out_Mode =>
                    Add.Report_Value
                       (Bounded.Image (A_Parameter.Formal_Name),
                        Bounded.Image (One_Subprogram.Test_Name),
                        "Parameters." &
                           Add.Component_Name
                              (Bounded.Image (A_Parameter.Formal_Name),
                               Add.Input,
                               Bounded.Image (A_Parameter.Id.Type_Name)),
                        A_Parameter.Is_String, A_Parameter.Id.Kind = Other);
                when Out_Mode =>
                    null;
            end case;

            Parameter_List.Next (Parameter_Iter);
        end loop;

        Add.New_Line;
        Add.Report_New_Line;
        Add.Report_New_Line;
        Add.New_Line;

        -- CALL TO SUBPROGRAM

        case One_Subprogram.Kind is
            when A_Function =>
                Add.Function_Call (This_Package,
                                   Bounded.Image (One_Subprogram.Simple_Name),
                                   One_Subprogram.Return_Type.Is_String);

            when A_Procedure =>
                Add.Procedure_Call (This_Package,
                                    Bounded.Image (One_Subprogram.Simple_Name));
        end case;
        Parameter_List.Init (Parameter_Iter, One_Subprogram.Parameters);

        if Parameter_List.Done (Parameter_Iter) then
            Add.Put_String (";");
        else
            Add.Put_String ("(");
        end if;

        while not Parameter_List.Done (Parameter_Iter) loop
            A_Parameter := Parameter_List.Value (Parameter_Iter);

            Parameter_List.Next (Parameter_Iter);

            case A_Parameter.Mode is
                when In_Mode | In_Out_Mode =>
                    Add.Actual_Parameter
                       (Bounded.Image (A_Parameter.Formal_Name),
                        Bounded.Image (One_Subprogram.Test_Name),
                        "Parameters." &
                           Add.Component_Name
                              (Bounded.Image (A_Parameter.Formal_Name),
                               Add.Input,
                               Bounded.Image (A_Parameter.Id.Type_Name)),
                        A_Parameter.Is_String,
                        Parameter_List.Done (Parameter_Iter),
                        One_Subprogram.Return_Type.Is_String);

                when Out_Mode =>
                    Add.Actual_Parameter
                       (Bounded.Image (A_Parameter.Formal_Name),
                        Bounded.Image (One_Subprogram.Test_Name),
                        Add.Component_Name
                           (Bounded.Image (A_Parameter.Formal_Name), Add.Output,
                            Bounded.Image (A_Parameter.Id.Type_Name)),
                        A_Parameter.Is_String,
                        Parameter_List.Done (Parameter_Iter),
                        One_Subprogram.Return_Type.Is_String);


            end case;
        end loop;

        Add.New_Line;

        Add.Report_New_Line;
        Add.New_Line;

        -- REPORT OUTPUT VALUES
        Parameter_List.Init (Parameter_Iter, One_Subprogram.Parameters);

        while not Parameter_List.Done (Parameter_Iter) loop
            A_Parameter := Parameter_List.Value (Parameter_Iter);

            case A_Parameter.Mode is
                when In_Out_Mode =>
                    Add.Report_Comments ("EXPECTED VALUE:");
                    Add.Report_New_Line;

                    Add.Report_Value
                       (Bounded.Image (A_Parameter.Formal_Name),
                        Bounded.Image (One_Subprogram.Test_Name),
                        "Parameters." &
                           Add.Component_Name
                              (Bounded.Image (A_Parameter.Formal_Name),
                               Add.Expected,
                               Bounded.Image (A_Parameter.Id.Type_Name)),
                        A_Parameter.Is_String, A_Parameter.Id.Kind = Other);

                    Add.New_Line;
                    Add.Report_Comments ("ACTUAL OUTPUTS:");
                    Add.Report_New_Line;

                    Add.Report_Value
                       (Bounded.Image (A_Parameter.Formal_Name),
                        Bounded.Image (One_Subprogram.Test_Name),
                        "Parameters." &
                           Add.Component_Name
                              (Bounded.Image (A_Parameter.Formal_Name),
                               Add.Input,
                               Bounded.Image (A_Parameter.Id.Type_Name)),
                        A_Parameter.Is_String, A_Parameter.Id.Kind = Other);
                when Out_Mode =>
                    Add.Report_Comments ("EXPECTED VALUE:");
                    Add.Report_New_Line;
                    Add.New_Line;

                    Add.Report_Value
                       (Bounded.Image (A_Parameter.Formal_Name),
                        Bounded.Image (One_Subprogram.Test_Name),
                        "Parameters." &
                           Add.Component_Name
                              (Bounded.Image (A_Parameter.Formal_Name),
                               Add.Expected,
                               Bounded.Image (A_Parameter.Id.Type_Name)),
                        A_Parameter.Is_String, A_Parameter.Id.Kind = Other);

                    Add.Report_Comments ("ACTUAL OUTPUTS:");
                    Add.Report_New_Line;
                    Add.New_Line;

                    Add.Report_Value
                       (Bounded.Image (A_Parameter.Formal_Name),
                        Bounded.Image (One_Subprogram.Test_Name),
                        Add.Component_Name
                           (Bounded.Image (A_Parameter.Formal_Name), Add.Output,
                            Bounded.Image (A_Parameter.Id.Type_Name)),
                        A_Parameter.Is_String, A_Parameter.Id.Kind = Other);

                when In_Mode =>
                    null;
            end case;

            Parameter_List.Next (Parameter_Iter);
        end loop;

        A_Parameter := One_Subprogram.Return_Type;

        Add.New_Line;
        Add.Report_New_Line;
        Add.New_Line;

        case One_Subprogram.Kind is
            when A_Function =>
                Add.New_Line;

                Add.Report_Value ("EXPECTED RETURN VALUE", "",
                                  "Parameters.expected_function_return_value",
                                  A_Parameter.Is_String,
                                  A_Parameter.Id.Kind = Other);


                Add.New_Line;

                Add.Report_Value ("ACTUAL   RETURN VALUE", "",
                                  "Function_Return_Value",
                                  A_Parameter.Is_String,
                                  A_Parameter.Id.Kind = Other);

            when A_Procedure =>
                null;
        end case;
        Add.New_Line;
        Add.Report_New_Line;
        Add.Report_New_Line;
        Add.New_Line;

        Add.Terminate_Execution;
        Add.Report_New_Line;
        Add.New_Line;


        case One_Subprogram.Kind is
            when A_Function =>
                Add.If_Token;
                Add.New_Line;

                Add.Function_Return_Compare
                   (One_Subprogram.Return_Type.Is_String);

                Add.Then_Token;
                Add.Report_Passed;
                Add.Else_Token;
                Add.Report_Failed;
                Add.End_Token (Add.An_If);
            when A_Procedure =>

                if One_Subprogram.Out_Parameters_Found then
                    Add.If_Token;
                    Add.New_Line;
                    Parameter_List.Init (Parameter_Iter,
                                         One_Subprogram.Parameters);

                    while not Parameter_List.Done (Parameter_Iter) loop
                        A_Parameter := Parameter_List.Value (Parameter_Iter);

                        Parameter_List.Next (Parameter_Iter);

                        case A_Parameter.Mode is
                            when In_Out_Mode =>
                                if Found_First_Out_Parameter then
                                    Add.New_Line;
                                    Add.And_Token;
                                    Add.New_Line;
                                else
                                    Found_First_Out_Parameter := True;
                                end if;

                                Add.Comparison
                                   ("Parameters." &
                                    Add.Component_Name
                                       (Bounded.Image (A_Parameter.Formal_Name),
                                        Add.Expected,
                                        Bounded.Image
                                           (A_Parameter.Id.Type_Name)),
                                    "Parameters." &
                                       Add.Component_Name
                                          (Bounded.Image
                                              (A_Parameter.Formal_Name),
                                           Add.Input, Bounded.Image
                                                         (A_Parameter.Id.
                                                          Type_Name)),
                                    A_Parameter.Is_String);

                            when Out_Mode =>
                                if Found_First_Out_Parameter then
                                    Add.New_Line;
                                    Add.And_Token;
                                    Add.New_Line;
                                else
                                    Found_First_Out_Parameter := True;
                                end if;

                                Add.Comparison
                                   ("Parameters." &
                                    Add.Component_Name
                                       (Bounded.Image (A_Parameter.Formal_Name),
                                        Add.Expected,
                                        Bounded.Image
                                           (A_Parameter.Id.Type_Name)),
                                    Add.Component_Name
                                       (Bounded.Image (A_Parameter.Formal_Name),
                                        Add.Output,
                                        Bounded.Image
                                           (A_Parameter.Id.Type_Name)),
                                    A_Parameter.Is_String);

                            when In_Mode =>
                                null;
                        end case;

                    end loop;
                    Add.Then_Token;
                    Add.Report_Passed;
                    Add.Else_Token;
                    Add.Report_Failed;
                    Add.End_Token (Add.An_If);
                end if;

        end case;


        Add.New_Line;
        Add.Report_New_Line;
        Add.Report_New_Line;
        Add.End_Token (Add.A_Loop);
        Add.Exception_Handler;

        -- FINAL END

        Add.End_Token;

    end loop;

    -- BUILD MAIN PROGRAM

    Add.With_Clause (Unit => "Test_" & This_Package);

    Add.Main_Program (This_Package);
    Add.Begin_Token;

    Add.Call_Test_Open (This_Package);

    Subprogram_Map.Init (Subprogram_Iter, From_Data.Map);

    while not Subprogram_Map.Done (Subprogram_Iter) loop
        One_Subprogram := Subprogram_Map.Eval
                             (From_Data.Map, Subprogram_Map.Value
                                                (Subprogram_Iter));
        Subprogram_Map.Next (Subprogram_Iter);
        Add.Call_Test_Subprogram (This_Package,
                                  Bounded.Image (One_Subprogram.Test_Name));
        Add.New_Line;
    end loop;

    Add.Call_Test_Close (This_Package);

    Add.End_Token;
    Add.Pragma_Main;

    Io.Close (Temp_File);

    Compilation.Parse (Temp_File_Name, In_Context);

    if not Testing then
        Io.Open (Temp_File, Io.In_File, Temp_File_Name);
        Io.Delete (Temp_File);
    end if;
end Generate_Unit_Test_Program;