2019-01-01 14:01:51 +08:00
|
|
|
-- Copyright 2010-2019 Free Software Foundation, Inc.
|
(Ada) Handle same component names when searching in tagged types
Consider the following code:
type Top_T is tagged record
N : Integer := 1;
U : Integer := 974;
A : Integer := 48;
end record;
type Middle_T is new Top.Top_T with record
N : Character := 'a';
C : Integer := 3;
end record;
type Bottom_T is new Middle.Middle_T with record
N : Float := 4.0;
C : Character := '5';
X : Integer := 6;
A : Character := 'J';
end record;
Tagged records in Ada provide object-oriented features, and what
is interesting in the code above is that a child tagged record
introduce additional components (fields) which sometimes have
the same name as one of the components in the parent. For instance,
Bottom_T introduces a component named "C", while at the same time
inheriting from Middle_T which also has a component named "C";
so, in essence, type Bottom_T has two components with the same name!
And before people start wondering why the language can possibly
be allowing that, this can only happen if the parent type has
a private definition. In our case, this was brought to our attention
when the parent was a generic paramenter.
With that in mind... Let's say we now have a variable declared
and initialized as follow:
TC : Top_A := new Bottom_T;
And then we use this variable to call this function
procedure Assign (Obj: in out Top_T; TV : Integer);
as follow:
Assign (Top_T (B), 12);
Now, we're in the debugger, and we're inside that procedure
(Top.Assign in our gdb testcase), and we want to print
the value of obj.c:
Usually, the tagged record or one of the parent type owns the
component to print and there's no issue but in this particular
case, what does it mean to ask for Obj.C ? Since the actual
type for object is type Bottom_T, it could mean two things: type
component C from the Middle_T view, but also component C from
Bottom_T. So in that "undefined" case, when the component is
not found in the non-resolved type (which includes all the
components of the parent type), then resolve it and see if we
get better luck once expanded.
In the case of homonyms in the derived tagged type, we don't
guaranty anything, and pick the one that's easiest for us
to program.
This patch fixes the behavior like described above.
gdb/ChangeLog:
* ada-lang.c (ada_value_primitive_field): Handle field search
in case of homonyms.
(find_struct_field): Ditto.
(ada_search_struct_field): Ditto.
(ada_value_struct_elt): Ditto.
(ada_lookup_struct_elt_type): Ditto.
gdb/testsuite/ChangeLog:
* gdb.ada/same_component_name: New testcase.
Tested on x86_64-linux.
2017-12-15 11:38:17 +08:00
|
|
|
--
|
|
|
|
-- 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 System;
|
|
|
|
|
|
|
|
package body Pck is
|
|
|
|
package body Top is
|
|
|
|
procedure Assign (Obj: in out Top_T; TV : Integer) is
|
|
|
|
begin
|
|
|
|
Do_Nothing (Obj'Address); -- BREAK_TOP
|
|
|
|
end Assign;
|
|
|
|
end Top;
|
|
|
|
|
|
|
|
package body Middle is
|
|
|
|
procedure Assign (Obj: in out Middle_T; MV : Character) is
|
|
|
|
begin
|
|
|
|
Do_Nothing (Obj'Address); -- BREAK_MIDDLE
|
|
|
|
end Assign;
|
|
|
|
end Middle;
|
|
|
|
|
|
|
|
procedure Assign (Obj: in out Bottom_T; BV : Float) is
|
|
|
|
begin
|
|
|
|
Do_Nothing (Obj'Address); -- BREAK_BOTTOM
|
|
|
|
end Assign;
|
|
|
|
|
|
|
|
procedure Do_Nothing (A : System.Address) is
|
|
|
|
begin
|
|
|
|
null;
|
|
|
|
end Do_Nothing;
|
(Ada) Fix resolving of homonym components in tagged types
ada_value_struct_elt is used when displaying a component (say, 'N') of
a record object (say, 'Obj') of type, say, 't1'. Now if Obj is tagged
(Ada parlance: "tagged types" are what other object-oriented languages
call "classes"), then 'N' may not be visible in the current view and
we need to look for it in its actual type. We do that at the same time
as resolving variable-length fields. This would typically be done by
the following call to ada_value_struct_elt, with the last parameter
check_tag set to 1:
t1 = ada_to_fixed_type (ada_get_base_type (t1), NULL,
address, NULL, 1);
This is the general logic, but recently we introduced a special case
to handle homonyms. Different components may have the same name in a
tagged type. For instance:
type Top_T is tagged record
N : Integer := 1;
end record;
type Middle_T is new Top.Top_T with record
N : Character := 'a';
end record;
Middle_T extends Top_T and both define a (different) component with
the same name ('N'). In such a case, using the actual type of a
Middle_T object would create a confusion, since we would have two
component 'N' in this actual type.
So, to handle homonyms, we convert t1 to the actual type *if
and only if* N cannot be found in the current view. For example, if Obj
has been created as a Middle_T but is seen as a Top_T'Class at our
point of execution, then "print Obj.N" will display the integer field
defined in Top_T's declaration.
Now, even if we find N in the current view, we still have to get a
fixed type: for instance, the record can be unconstrained and we still
need a fixed type to get the proper offset to each field. That is
to say, in this case:
type Dyn_Top_T (Disc : Natural) is tagged record
S : Integer_Array (1 .. Disc) := (others => Disc);
N : Integer := 1;
end record;
type Dyn_Middle_T is new Dyn_Top.Dyn_Top_T with record
N : Character := 'a';
U : Integer := 42;
end record;
If we have an object Obj of type Dyn_Middle_T and we want to display
U, we don't need to build, from its tag, a real type with all its real
fields. In other words, we don't need to add the parent components:
Disc, S, and the integer N. We only need to access U and it is
directly visible in Dyn_Middle_T. So no tag handling. However, we do
need to build a fixed-size type to have the proper offset to U (since
this offset to U depends on the size of Obj.S, which itself is dynamic
and depends on the value of Obj.Disc).
We accidentally lost some of this treatment when we introduced the
resolution of homonyms. This patch re-install this part by uncoupling
the tag resolution from the "fixing" of variable-length components.
This change also slightly simplifies the non-tagged case: in the
non-tagged case, no need to set check_tag to 1, since we already know
that there is no tag.
gdb/ChangeLog:
* ada-lang.c (ada_value_struct_elt): Call ada_to_fixed_type
with check_tag to 1 if and only if the type is tagged and the
component being searched cannot been found in the current
view. Otherwise, always call ada_to_fixed_type with
check_tag to 0.
gdb/testsuite/ChangeLog:
* gdb.ada/same_component_name: Add test for case of tagged record
with variable-length fields.
2018-09-10 23:37:52 +08:00
|
|
|
|
|
|
|
package body Dyn_Top is
|
|
|
|
procedure Assign (Obj: in out Dyn_Top_T; TV : Integer) is
|
|
|
|
begin
|
|
|
|
Do_Nothing (Obj'Address); -- BREAK_DYN_TOP
|
|
|
|
end Assign;
|
|
|
|
end Dyn_Top;
|
|
|
|
|
|
|
|
package body Dyn_Middle is
|
|
|
|
procedure Assign (Obj: in out Dyn_Middle_T; MV : Character) is
|
|
|
|
begin
|
|
|
|
Do_Nothing (Obj'Address); -- BREAK_DYN_MIDDLE
|
|
|
|
end Assign;
|
|
|
|
end Dyn_Middle;
|
|
|
|
|
(Ada) Handle same component names when searching in tagged types
Consider the following code:
type Top_T is tagged record
N : Integer := 1;
U : Integer := 974;
A : Integer := 48;
end record;
type Middle_T is new Top.Top_T with record
N : Character := 'a';
C : Integer := 3;
end record;
type Bottom_T is new Middle.Middle_T with record
N : Float := 4.0;
C : Character := '5';
X : Integer := 6;
A : Character := 'J';
end record;
Tagged records in Ada provide object-oriented features, and what
is interesting in the code above is that a child tagged record
introduce additional components (fields) which sometimes have
the same name as one of the components in the parent. For instance,
Bottom_T introduces a component named "C", while at the same time
inheriting from Middle_T which also has a component named "C";
so, in essence, type Bottom_T has two components with the same name!
And before people start wondering why the language can possibly
be allowing that, this can only happen if the parent type has
a private definition. In our case, this was brought to our attention
when the parent was a generic paramenter.
With that in mind... Let's say we now have a variable declared
and initialized as follow:
TC : Top_A := new Bottom_T;
And then we use this variable to call this function
procedure Assign (Obj: in out Top_T; TV : Integer);
as follow:
Assign (Top_T (B), 12);
Now, we're in the debugger, and we're inside that procedure
(Top.Assign in our gdb testcase), and we want to print
the value of obj.c:
Usually, the tagged record or one of the parent type owns the
component to print and there's no issue but in this particular
case, what does it mean to ask for Obj.C ? Since the actual
type for object is type Bottom_T, it could mean two things: type
component C from the Middle_T view, but also component C from
Bottom_T. So in that "undefined" case, when the component is
not found in the non-resolved type (which includes all the
components of the parent type), then resolve it and see if we
get better luck once expanded.
In the case of homonyms in the derived tagged type, we don't
guaranty anything, and pick the one that's easiest for us
to program.
This patch fixes the behavior like described above.
gdb/ChangeLog:
* ada-lang.c (ada_value_primitive_field): Handle field search
in case of homonyms.
(find_struct_field): Ditto.
(ada_search_struct_field): Ditto.
(ada_value_struct_elt): Ditto.
(ada_lookup_struct_elt_type): Ditto.
gdb/testsuite/ChangeLog:
* gdb.ada/same_component_name: New testcase.
Tested on x86_64-linux.
2017-12-15 11:38:17 +08:00
|
|
|
end Pck;
|