gdb/testsuite/gdb.ada/uninitialized_vars/parse.adb

   1 --  Copyright 2009-2019 Free Software Foundation, Inc.
   2 --
   3 --  This program is free software; you can redistribute it and/or modify
   4 --  it under the terms of the GNU General Public License as published by
   5 --  the Free Software Foundation; either version 3 of the License, or
   6 --  (at your option) any later version.
   7 --
   8 --  This program is distributed in the hope that it will be useful,
   9 --  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 --  GNU General Public License for more details.
  12 --
  13 --  You should have received a copy of the GNU General Public License
  14 --  along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 --  This program declares a bunch of unconstrained objects and
  17 --  discrinimated records; the goal is to check that GDB does not crash
  18 --  when printing them even if they are not initialized.
  19
  20 with Parse_Controlled;
  21
  22 procedure Parse is -- START
  23
  24    A  : aliased Integer := 1;
  25
  26    type Access_Type is access all Integer;
  27
  28    type String_Access is access String;
  29
  30    type My_Record is record
  31       Field1 : Access_Type;
  32       Field2 : String (1 .. 2);
  33    end record;
  34
  35    type Discriminants_Record (A : Integer; B : Boolean) is record
  36       C : Float;
  37    end record;
  38    Z : Discriminants_Record := (A => 1, B => False, C => 2.0);
  39
  40    type Variable_Record (A : Boolean := True) is record
  41       case A is
  42          when True =>
  43             B : Integer;
  44          when False =>
  45             C : Float;
  46             D : Integer;
  47       end case;
  48    end record;
  49    Y  : Variable_Record := (A => True, B => 1);
  50    Y2 : Variable_Record := (A => False, C => 1.0, D => 2);
  51    Nv : Parse_Controlled.Null_Variant;
  52
  53    type Union_Type (A : Boolean := False) is record
  54       case A is
  55          when True  => B : Integer;
  56          when False => C : Float;
  57       end case;
  58    end record;
  59    pragma Unchecked_Union (Union_Type);
  60    Ut : Union_Type := (A => True, B => 3);
  61
  62    type Tagged_Type is tagged record
  63       A : Integer;
  64       B : Character;
  65    end record;
  66    Tt : Tagged_Type := (A => 2, B => 'C');
  67
  68    type Child_Tagged_Type is new Tagged_Type with record
  69       C : Float;
  70    end record;
  71    Ctt : Child_Tagged_Type := (Tt with C => 4.5);
  72
  73    type Child_Tagged_Type2 is new Tagged_Type with null record;
  74    Ctt2 : Child_Tagged_Type2 := (Tt with null record);
  75
  76    type My_Record_Array is array (Natural range <>) of My_Record;
  77    W : My_Record_Array := ((Field1 => A'Access, Field2 => "ab"),
  78                            (Field1 => A'Access, Field2 => "rt"));
  79
  80    type Discriminant_Record (Num1, Num2,
  81                              Num3, Num4 : Natural) is record
  82       Field1 : My_Record_Array (1 .. Num2);
  83       Field2 : My_Record_Array (Num1 .. 10);
  84       Field3 : My_Record_Array (Num1 .. Num2);
  85       Field4 : My_Record_Array (Num3 .. Num2);
  86       Field5 : My_Record_Array (Num4 .. Num2);
  87    end record;
  88    Dire : Discriminant_Record (1, 7, 3, 0);
  89
  90    type Null_Variant_Part (Discr : Integer) is record
  91       case Discr is
  92          when 1 => Var_1 : Integer;
  93          when 2 => Var_2 : Boolean;
  94          when others => null;
  95       end case;
  96    end record;
  97    Nvp : Null_Variant_Part (3);
  98
  99    type T_Type is array (Positive range <>) of Integer;
 100    type T_Ptr_Type is access T_Type;
 101
 102    T_Ptr : T_Ptr_Type := new T_Type' (13, 17);
 103    T_Ptr2 : T_Ptr_Type := new T_Type' (2 => 13, 3 => 17);
 104
 105    function Foos return String is
 106    begin
 107       return "string";
 108    end Foos;
 109
 110    My_Str : String := Foos;
 111
 112    type Value_Var_Type is ( V_Null, V_Boolean, V_Integer );
 113    type Value_Type( Var : Value_Var_Type := V_Null ) is
 114       record
 115          case Var is
 116             when V_Null =>
 117                null;
 118             when V_Boolean =>
 119                Boolean_Value : Boolean;
 120             when V_Integer =>
 121                Integer_Value : Integer;
 122          end case;
 123       end record;
 124    NBI_N : Value_Type := (Var => V_Null);
 125    NBI_I : Value_Type := (Var => V_Integer, Integer_Value => 18);
 126    NBI_B : Value_Type := (Var => V_Boolean, Boolean_Value => True);
 127
 128 begin
 129    null;
 130 end Parse;