* [Ada] Wrong interface tag visible through limited with clause
@ 2017-09-08 9:44 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2017-09-08 9:44 UTC (permalink / raw)
To: gcc-patches; +Cc: Javier Miranda
[-- Attachment #1: Type: text/plain, Size: 1764 bytes --]
If the designated type of an access to a class-wide interface type
is visible through a limited-with clause, and attribute 'Tag is
applied to the dereference of a pointer of such type, and such
'Tag value is used to invoke the routines of the Ada.Tags runtime
package then the Ada.Tags routine may return a wrong value or
raise an exception. After this patch the following test compiles
and executes fine.
with Pkg_Iface_Ptr;
package Pkg_Iface is
type Iface is interface;
end;
limited with Pkg_Iface;
package Pkg_Iface_Ptr is
type Lim_Iface_Ptr is access all Pkg_Iface.Iface'Class;
end;
with Pkg_Iface; use Pkg_Iface;
package Types is
type Root is abstract tagged null record;
type DT is new Root and Iface with null record;
end;
with Pkg_Iface;
package Pkg_Aux is end;
with Pkg_Aux;
with Pkg_Iface_Ptr; use Pkg_Iface_Ptr;
package Pkg_Test is
function Do_Test (Ptr : Lim_Iface_Ptr) return String;
end;
with Ada.Tags;
package body Pkg_Test is
function Do_Test (Ptr : Lim_Iface_Ptr) return String is
begin
return Ada.Tags.External_Tag (Ptr.all'Tag); -- Test
end;
end;
with Types; use Types;
with Pkg_Test; use Pkg_Test;
with GNAT.IO; use GNAT.IO;
procedure Main is
begin
GNAT.IO.Put_Line (Do_Test (new DT));
end;
Command: gnatmake -q main; ./main
Output: TYPES.DT
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-09-08 Javier Miranda <miranda@adacore.com>
* einfo.adb (Underlying_Type): Add missing support for class-wide
types that come from the limited view.
* exp_attr.adb (Attribute_Address): Check class-wide type
interfaces using the underlying type to handle limited-withed
types.
(Attribute_Tag): Check class-wide type interfaces using
the underlying type to handle limited-withed types.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 2160 bytes --]
Index: einfo.adb
===================================================================
--- einfo.adb (revision 251863)
+++ einfo.adb (working copy)
@@ -9300,6 +9300,15 @@
if Ekind (Id) = E_Record_Type_With_Private then
return Full_View (Id);
+ -- If we have a class-wide type that comes from the limited view then
+ -- we return the Underlying_Type of its nonlimited view.
+
+ elsif Ekind (Id) = E_Class_Wide_Type
+ and then From_Limited_With (Id)
+ and then Present (Non_Limited_View (Id))
+ then
+ return Underlying_Type (Non_Limited_View (Id));
+
elsif Ekind (Id) in Incomplete_Or_Private_Kind then
-- If we have an incomplete or private type with a full view,
@@ -9324,9 +9333,8 @@
then
return Underlying_Type (Underlying_Full_View (Id));
- -- If we have an incomplete entity that comes from the limited
- -- view then we return the Underlying_Type of its non-limited
- -- view.
+ -- If we have an incomplete entity that comes from the limited view
+ -- then we return the Underlying_Type of its nonlimited view.
elsif From_Limited_With (Id)
and then Present (Non_Limited_View (Id))
Index: exp_attr.adb
===================================================================
--- exp_attr.adb (revision 251863)
+++ exp_attr.adb (working copy)
@@ -2235,7 +2235,7 @@
-- issues are taken care of by the virtual machine.
elsif Is_Class_Wide_Type (Ptyp)
- and then Is_Interface (Ptyp)
+ and then Is_Interface (Underlying_Type (Ptyp))
and then Tagged_Type_Expansion
and then not (Nkind (Pref) in N_Has_Entity
and then Is_Subprogram (Entity (Pref)))
@@ -6241,7 +6241,7 @@
elsif Comes_From_Source (N)
and then Is_Class_Wide_Type (Etype (Prefix (N)))
- and then Is_Interface (Etype (Prefix (N)))
+ and then Is_Interface (Underlying_Type (Etype (Prefix (N))))
then
-- Generate:
-- (To_Tag_Ptr (Prefix'Address)).all
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2017-09-08 9:44 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-09-08 9:44 [Ada] Wrong interface tag visible through limited with clause Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).