New testcase for interface type printing.
gdb/testsuite/ChangeLog: * gdb.ada/iwide: New testcase.
This commit is contained in:
parent
ac4a2da45d
commit
cdde3dfbda
@ -1,3 +1,7 @@
|
||||
2012-11-29 Jerome Guitton <guitton@adacore.com>
|
||||
|
||||
* gdb.ada/iwide: New testcase.
|
||||
|
||||
2012-11-29 Jerome Guitton <guitton@adacore.com>
|
||||
|
||||
* gdb.ada/ptype_tagged_param.exp: Adjust expected output in
|
||||
|
42
gdb/testsuite/gdb.ada/iwide.exp
Normal file
42
gdb/testsuite/gdb.ada/iwide.exp
Normal file
@ -0,0 +1,42 @@
|
||||
# Copyright 2012 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/>.
|
||||
|
||||
load_lib "ada.exp"
|
||||
|
||||
standard_ada_testfile p
|
||||
|
||||
if {[gdb_compile_ada "${srcfile}" "${binfile}" executable [list debug additional_flags=-gnat05 ]] != "" } {
|
||||
return -1
|
||||
}
|
||||
|
||||
clean_restart ${testfile}
|
||||
|
||||
set bp_location [gdb_get_line_number "BREAK" ${testdir}/p.adb]
|
||||
runto "p.adb:$bp_location"
|
||||
|
||||
gdb_test "print My_Drawable" \
|
||||
"= \\(center => \\(x => 1, y => 2\\), radius => 3\\)"
|
||||
|
||||
gdb_test "print s_access.all" \
|
||||
"\\(center => \\(x => 1, y => 2\\), radius => 3\\)"
|
||||
|
||||
gdb_test "print sp_access.all" \
|
||||
"\\(center => \\(x => 1, y => 2\\), radius => 3\\)"
|
||||
|
||||
gdb_test "print d_access.all" \
|
||||
"\\(center => \\(x => 1, y => 2\\), radius => 3\\)"
|
||||
|
||||
gdb_test "print dp_access.all" \
|
||||
"\\(center => \\(x => 1, y => 2\\), radius => 3\\)"
|
23
gdb/testsuite/gdb.ada/iwide/classes.adb
Normal file
23
gdb/testsuite/gdb.ada/iwide/classes.adb
Normal file
@ -0,0 +1,23 @@
|
||||
-- Copyright 2012 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/>.
|
||||
|
||||
package body Classes is
|
||||
|
||||
procedure Draw (R : Circle) is
|
||||
begin
|
||||
null;
|
||||
end Draw;
|
||||
|
||||
end Classes;
|
59
gdb/testsuite/gdb.ada/iwide/classes.ads
Normal file
59
gdb/testsuite/gdb.ada/iwide/classes.ads
Normal file
@ -0,0 +1,59 @@
|
||||
-- Copyright 2012 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/>.
|
||||
|
||||
package Classes is
|
||||
|
||||
type Point is record
|
||||
X : Integer;
|
||||
Y : Integer;
|
||||
end record;
|
||||
|
||||
type Shape is abstract tagged null record;
|
||||
|
||||
type Shape_Access is access all Shape'Class;
|
||||
|
||||
type Drawable is interface;
|
||||
|
||||
type Drawable_Access is access all Drawable'Class;
|
||||
|
||||
procedure Draw (D : Drawable) is abstract;
|
||||
|
||||
type Circle is new Shape and Drawable with record
|
||||
Center : Point;
|
||||
Radius : Natural;
|
||||
end record;
|
||||
|
||||
procedure Draw (R : Circle);
|
||||
|
||||
My_Circle : Circle := ((1, 2), 3);
|
||||
My_Shape : Shape'Class := Shape'Class (My_Circle);
|
||||
My_Drawable : Drawable'Class := Drawable'Class (My_Circle);
|
||||
|
||||
S_Access : Shape_Access := new Circle'(My_Circle);
|
||||
D_Access : Drawable_Access := new Circle'(My_Circle);
|
||||
|
||||
type R (MS : Shape_Access; MD : Drawable_Access) is record
|
||||
E : Integer;
|
||||
end record;
|
||||
|
||||
MR : R := (MS => S_Access, MD => D_Access, E => 42);
|
||||
|
||||
type Shape_Array is array (1 .. 4) of Shape_Access;
|
||||
type Drawable_Array is array (1 .. 4) of Drawable_Access;
|
||||
|
||||
S_Array : Shape_Array := (others => S_Access);
|
||||
D_Array : Drawable_Array := (others => D_Access);
|
||||
|
||||
end Classes;
|
25
gdb/testsuite/gdb.ada/iwide/p.adb
Normal file
25
gdb/testsuite/gdb.ada/iwide/p.adb
Normal file
@ -0,0 +1,25 @@
|
||||
-- Copyright 2012 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/>.
|
||||
|
||||
With Classes; use Classes;
|
||||
|
||||
procedure P is
|
||||
SP_Access : Shape_Access := new Circle'(My_Circle);
|
||||
DP_Access : Drawable_Access := new Circle'(My_Circle);
|
||||
SP_Array : Shape_Array := (others => S_Access);
|
||||
DP_Array : Drawable_Array := (others => D_Access);
|
||||
begin
|
||||
null; -- BREAK
|
||||
end P;
|
Loading…
x
Reference in New Issue
Block a user