Subversion Repositories openrisc_me

--  Copyright 2009 Free Software Foundation, Inc.

--

--  This program is free software; you can redistribute it and/or modify

--  it under the terms of the GNU General Public License as published by

--  the Free Software Foundation; either version 3 of the License, or

--  (at your option) any later version.

--

--  This program is distributed in the hope that it will be useful,

--  but WITHOUT ANY WARRANTY; without even the implied warranty of

--  MERCHANTABILITY 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

--  along with this program.  If not, see <http://www.gnu.org/licenses/>.

--  This program declares a bunch of unconstrained objects and

--  discrinimated records; the goal is to check that GDB does not crash

--  when printing them even if they are not initialized.

with Parse_Controlled;

procedure Parse is

   A  : aliased Integer := 1;

   type Access_Type is access all Integer;

   type String_Access is access String;

   type My_Record is record

      Field1 : Access_Type;

      Field2 : String (1 .. 2);

   end record;

   type Discriminants_Record (A : Integer; B : Boolean) is record

      C : Float;

   end record;

   Z : Discriminants_Record := (A => 1, B => False, C => 2.0);

   type Variable_Record (A : Boolean := True) is record

      case A is

         when True =>

            B : Integer;

         when False =>

            C : Float;

            D : Integer;

      end case;

   end record;

   Y  : Variable_Record := (A => True, B => 1);

   Y2 : Variable_Record := (A => False, C => 1.0, D => 2);

   Nv : Parse_Controlled.Null_Variant;

   type Union_Type (A : Boolean := False) is record

      case A is

         when True  => B : Integer;

         when False => C : Float;

      end case;

   end record;

   pragma Unchecked_Union (Union_Type);

   Ut : Union_Type := (A => True, B => 3);

   type Tagged_Type is tagged record

      A : Integer;

      B : Character;

   end record;

   Tt : Tagged_Type := (A => 2, B => 'C');

   type Child_Tagged_Type is new Tagged_Type with record

      C : Float;

   end record;

   Ctt : Child_Tagged_Type := (Tt with C => 4.5);

   type Child_Tagged_Type2 is new Tagged_Type with null record;

   Ctt2 : Child_Tagged_Type2 := (Tt with null record);

   type My_Record_Array is array (Natural range <>) of My_Record;

   W : My_Record_Array := ((Field1 => A'Access, Field2 => "ab"),

                           (Field1 => A'Access, Field2 => "rt"));

   type Discriminant_Record (Num1, Num2,

                             Num3, Num4 : Natural) is record

      Field1 : My_Record_Array (1 .. Num2);

      Field2 : My_Record_Array (Num1 .. 10);

      Field3 : My_Record_Array (Num1 .. Num2);

      Field4 : My_Record_Array (Num3 .. Num2);

      Field5 : My_Record_Array (Num4 .. Num2);

   end record;

   Dire : Discriminant_Record (1, 7, 3, 0);

   type Null_Variant_Part (Discr : Integer) is record

      case Discr is

         when 1 => Var_1 : Integer;

         when 2 => Var_2 : Boolean;

         when others => null;

      end case;

   end record;

   Nvp : Null_Variant_Part (3);

   type T_Type is array (Positive range <>) of Integer;

   type T_Ptr_Type is access T_Type;

   T_Ptr : T_Ptr_Type := new T_Type' (13, 17);

   T_Ptr2 : T_Ptr_Type := new T_Type' (2 => 13, 3 => 17);

   function Foos return String is

   begin

      return "string";

   end Foos;

   My_Str : String := Foos;

   type Value_Var_Type is ( V_Null, V_Boolean, V_Integer );

   type Value_Type( Var : Value_Var_Type := V_Null ) is

      record

         case Var is

            when V_Null =>

               null;

            when V_Boolean =>

               Boolean_Value : Boolean;

            when V_Integer =>

               Integer_Value : Integer;

         end case;

      end record;

   NBI_N : Value_Type := (Var => V_Null);

   NBI_I : Value_Type := (Var => V_Integer, Integer_Value => 18);

   NBI_B : Value_Type := (Var => V_Boolean, Boolean_Value => True);

begin

   null;

end Parse;