with Io;
with Directory;
with Diana;
with Diana_Utilities;
with Test_Program_Generation;
with Directory_Tools;
procedure Build_Unit_Test (Subprogram_Declarations : String := "";
                           Test_Program_Context : String := "") is

    package Object renames Directory_Tools.Object;
    package Naming renames Directory_Tools.Naming;
    package Traversal renames Directory_Tools.Traversal;
    package Ada_Object renames Directory_Tools.Ada_Object;
    package Any_Object renames Directory_Tools.Any_Object;
    package Library_Object renames Directory_Tools.Library_Object;
    package Statistics renames Directory_Tools.Statistics;
    package Low_Level renames Directory_Tools.Object.Low_Level;
    package Gen renames Test_Program_Generation;

    Data : Gen.Unit_Test_Data;
    Key : Gen.Subprogram_Key;

    Found : Boolean := False;

    Decls : Object.Iterator :=
       Naming.Resolution (Subprogram_Declarations, Objects_Only => False);

    This_Object : Object.Handle;

    Diana_Decl : Diana.Tree;
    Return_Type : Diana.Tree;

    Params : Diana_Utilities.Iterator;
    A_Param : Diana.Tree;
    Param_Type : Diana.Tree;

    A_Decl : Object.Handle;

    Comp_Unit : Diana.Tree;
    Status : Object.Error_Code;

    Dir_Object : Directory.Object;
    Dir_Stat : Directory.Error_Status;

    function Get_Mode (Param : Diana.Tree) return Gen.Mode_Kind is
    begin
        case Diana_Utilities.Parameter_Mode (Param) is
            when Diana_Utilities.In_Mode | Diana_Utilities.Default_In_Mode =>
                return Gen.In_Mode;
            when Diana_Utilities.Out_Mode =>
                return Gen.Out_Mode;
            when Diana_Utilities.In_Out_Mode =>
                return Gen.In_Out_Mode;
        end case;
    end Get_Mode;

    function Is_Predefined (Node : Diana.Tree) return Boolean is
    begin
        case Diana_Utilities.Type_Kind (Node) is
            when Diana_Utilities.An_Integer_Type_Definition =>
                return True;
            when Diana_Utilities.A_Float_Type_Definition =>
                return True;
            when Diana_Utilities.A_Subtype_Indication =>
                if Diana_Utilities.Is_Positive (Node) then
                    return True;
                elsif Diana_Utilities.Is_Natural (Node) then
                    return True;
                else
                    return False;
                end if;
            when others =>
                if Diana_Utilities.Is_Boolean (Node) then
                    return True;
                elsif Diana_Utilities.Is_Character (Node) then
                    return True;
                elsif Diana_Utilities.Is_Duration (Node) then
                    return True;
                elsif Diana_Utilities.Is_Long_Integer (Node) then
                    return True;
                elsif Diana_Utilities.Is_String (Node) then
                    return True;
                else
                    return False;
                end if;
        end case;
    end Is_Predefined;

    function Get_Kind (Node : Diana.Tree) return Gen.Type_Kind is
    begin
        case Diana_Utilities.Type_Kind (Node) is
            when Diana_Utilities.An_Integer_Type_Definition =>
                return Gen.An_Integer;
            when Diana_Utilities.A_Float_Type_Definition =>
                return Gen.A_Float;
            when Diana_Utilities.A_Subtype_Indication =>
                return Get_Kind (Diana_Utilities.Base_Type (Node));
            when others =>
                if Diana_Utilities.Is_Boolean (Node) then
                    return Gen.A_Boolean;
                elsif Diana_Utilities.Is_Character (Node) then
                    return Gen.A_Character;
                elsif Diana_Utilities.Is_Duration (Node) then
                    return Gen.A_Duration;
                elsif Diana_Utilities.Is_String (Node) then
                    return Gen.A_String;
                else
                    return Gen.Other;
                end if;
        end case;

    end Get_Kind;

    function Lower_Bound (Constraint : Diana.Tree) return String is
        Local : Diana.Tree := Constraint;
    begin
        loop
            case Diana.Kind (Local) is
                when Diana.Dn_Subtype =>
                    Local := Diana.As_Constrained (Local);
                when Diana.Dn_Constrained =>
                    Local := Diana.As_Constraint (Local);
                when Diana.Dn_Range =>
                    Local := Diana.As_Exp1 (Local);
                when Diana.Dn_Numeric_Literal =>
                    return Diana.Image (Diana.Lx_Numrep (Local));
                when others =>
                    return "";
            end case;
        end loop;
    end Lower_Bound;
    function Initial_Expression (Param_Type : Diana.Tree) return String is
    begin
        case Diana_Utilities.Type_Kind (Param_Type) is
            when Diana_Utilities.An_Integer_Type_Definition =>
                return "0";
            when Diana_Utilities.A_Float_Type_Definition =>
                return "0.0";
            when Diana_Utilities.A_Subtype_Indication =>
                return Lower_Bound (Param_Type);
            when others =>
                if Diana_Utilities.Is_Boolean (Param_Type) then
                    return "true";
                elsif Diana_Utilities.Is_Character (Param_Type) then
                    return "'A'";
                elsif Diana_Utilities.Is_String (Param_Type) then
                    return """" & """";
                else
                    return "";
                end if;
        end case;
    end Initial_Expression;

    function Get_Containing_Package (Node : Diana.Tree) return Object.Handle is
        Dir_Stat : Directory.Error_Status;
        Comp_Unit : Diana.Tree;
        Status : Object.Error_Code;
    begin
        Directory.Ada.Get_Root (Node, Comp_Unit, Dir_Stat);
        return Low_Level.Make_Handle
                  (Status, The_Name => "", The_Declaration => Comp_Unit);
    end Get_Containing_Package;

    procedure Register_Parameters (Diana_Decl : Diana.Tree) is

        Params : Diana_Utilities.Iterator :=
           Diana_Utilities.Parameters (Diana_Decl);
        A_Param : Diana.Tree;
        Param_Type : Diana.Tree;

        Ids : Diana_Utilities.Iterator;
        An_Id : Diana.Tree;

        Param_Type_Package : Object.Handle;
    begin
        while not Diana_Utilities.Done (Params) loop
            A_Param := Diana_Utilities.Value (Params);

            Param_Type := Diana_Utilities.Object_Type (A_Param);

            Param_Type_Package := Get_Containing_Package (Param_Type);

            Ids := Diana_Utilities.All_Ids (A_Param);

            while not Diana_Utilities.Done (Ids) loop

                An_Id := Diana_Utilities.Value (Ids);

                Gen.Register_Parameter
                   (Diana_Utilities.Name (An_Id), Get_Kind (Param_Type),
                    Is_Predefined (Param_Type), Get_Mode (A_Param),
                    Diana_Utilities.Name (Param_Type),
                    Naming.Simple_Name (Param_Type_Package),
                    Initial_Expression (Param_Type), Key, Data);

                Diana_Utilities.Next (Ids);
            end loop;

            Diana_Utilities.Next (Params);
        end loop;

    end Register_Parameters;

begin
    if Object.Is_Bad (Decls) then
        Io.Put_Line ("Bad subprogram declaration specifiction");
        return;
    end if;

    Gen.Initialize (Data);

    while not Object.Done (Decls) loop

        This_Object := Object.Value (Decls);

        Low_Level.Get_Declaration (Object.Value (Decls), Diana_Decl, Dir_Stat);

        if not Found then
            Gen.Register_Test_Package
               (Get_Containing_Package (Diana_Decl), Data);
            Found := True;
        end if;

        Diana_Decl := Diana.As_Parent (Diana_Decl);

        case Diana_Utilities.Kind (Diana_Decl) is
            when Diana_Utilities.A_Function_Declaration =>
                Return_Type := Diana_Utilities.Return_Type (Diana_Decl);

                Gen.Register_Function
                   (Obj => This_Object,
                    Op_Kind => Diana_Utilities.Operator_Kind (Diana_Decl),
                    Return_Type_Kind => Get_Kind (Return_Type),
                    Predefined => Is_Predefined (Return_Type),
                    Return_Type_Name => Diana_Utilities.Name (Return_Type),
                    Return_Type_Package =>
                       Naming.Simple_Name
                          (Get_Containing_Package (Return_Type)),
                    With_Data => Data,
                    Key => Key);

                Register_Parameters (Diana_Decl);
            when Diana_Utilities.A_Procedure_Declaration =>

                Gen.Register_Procedure
                   (Obj => This_Object, With_Data => Data, Key => Key);

                Register_Parameters (Diana_Decl);
            when others =>
                null;
        end case;


        Object.Next (Decls);
    end loop;

    Gen.Generate_Unit_Test_Program (Test_Program_Context, Data);
end Build_Unit_Test;