aboutsummaryrefslogtreecommitdiff
path: root/gdb/testsuite/gdb.ada/uninitialized_vars/parse.adb
diff options
context:
space:
mode:
authorJerome Guitton <guitton@adacore.com>2009-02-04 18:09:38 +0000
committerJerome Guitton <guitton@adacore.com>2009-02-04 18:09:38 +0000
commit20261af84c27478a2333f573702ba2b6e4a8b038 (patch)
treeca51a4242a5dc11b65e6890d765db21a1d89fdae /gdb/testsuite/gdb.ada/uninitialized_vars/parse.adb
parent538e13a60cefe0baa6cbd446e480587881a55089 (diff)
downloadgdb-20261af84c27478a2333f573702ba2b6e4a8b038.zip
gdb-20261af84c27478a2333f573702ba2b6e4a8b038.tar.gz
gdb-20261af84c27478a2333f573702ba2b6e4a8b038.tar.bz2
* gdb.ada/uninitialized_vars: New test program.
* gdb.ada/uninitialized_vars.exp: New testcase.
Diffstat (limited to 'gdb/testsuite/gdb.ada/uninitialized_vars/parse.adb')
-rw-r--r--gdb/testsuite/gdb.ada/uninitialized_vars/parse.adb130
1 files changed, 130 insertions, 0 deletions
diff --git a/gdb/testsuite/gdb.ada/uninitialized_vars/parse.adb b/gdb/testsuite/gdb.ada/uninitialized_vars/parse.adb
new file mode 100644
index 0000000..f91eb62
--- /dev/null
+++ b/gdb/testsuite/gdb.ada/uninitialized_vars/parse.adb
@@ -0,0 +1,130 @@
+-- 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;