diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index e81f304c44..6600b06d8c 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-02-04 Jerome Guitton + + * gdb.ada/uninitialized_vars: New test program. + * gdb.ada/uninitialized_vars.exp: New testcase. + 2009-02-02 Tom Tromey * gdb.cp/cpcompletion.exp: Name the test "pr9594". diff --git a/gdb/testsuite/gdb.ada/uninitialized_vars.exp b/gdb/testsuite/gdb.ada/uninitialized_vars.exp new file mode 100644 index 0000000000..d2339d5525 --- /dev/null +++ b/gdb/testsuite/gdb.ada/uninitialized_vars.exp @@ -0,0 +1,54 @@ +# 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 . + +# Check that GDB is able to print unconstrained variables and discriminated +# records before their initialization. + +if $tracelevel then { + strace $tracelevel +} + +load_lib "ada.exp" + +set testdir "uninitialized_vars" +set testfile "${testdir}/parse" +set srcfile ${srcdir}/${subdir}/${testfile}.adb +set binfile ${objdir}/${subdir}/${testfile} + +file mkdir ${objdir}/${subdir}/${testdir} +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug]] != "" } { + return -1 +} + +gdb_exit +gdb_start +gdb_reinitialize_dir $srcdir/$subdir +gdb_load ${binfile} + +# Start the program; we should land in the program main procedure, before +# variable initialization. +if { [gdb_start_cmd] < 0 } { + untested start + return -1 +} + +gdb_test "" \ + "parse \\(\\) at .*parse.adb.*" \ + "start" + +# Check that printing uninitialized variables does not crash the debugger. +gdb_test "info locals" \ + ".*" \ + "info locals" 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 0000000000..f91eb6297d --- /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 . + +-- 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; diff --git a/gdb/testsuite/gdb.ada/uninitialized_vars/parse_controlled.ads b/gdb/testsuite/gdb.ada/uninitialized_vars/parse_controlled.ads new file mode 100755 index 0000000000..0d30fb79eb --- /dev/null +++ b/gdb/testsuite/gdb.ada/uninitialized_vars/parse_controlled.ads @@ -0,0 +1,35 @@ +-- 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 . + +with Ada.Finalization; + +package Parse_Controlled is + + type Variant_Kind is (VK_Null, VK_Num, VK_String); + type Null_Variant_Record (Kind : Variant_Kind := VK_Null) is record + case Kind is + when VK_Null => + null; + when VK_Num => + Num_Value : Long_Float; + when VK_String => + String_Value : Natural; + end case; + end record; + type Null_Variant is new Ada.Finalization.Controlled with record + V : Null_Variant_Record; + end record; + +end Parse_Controlled;