1 -- Copyright 2009-2024 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; 131
Indexes created Mon Mar 30 00:23:01 UTC 2026