* [Ada] Wrong runtime check on function returning interface type
@ 2015-03-04 10:28 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2015-03-04 10:28 UTC (permalink / raw)
To: gcc-patches; +Cc: Javier Miranda
[-- Attachment #1: Type: text/plain, Size: 1342 bytes --]
For functions returning class-wide interface types the compiler may generate
erroneous code implementing the Ada rule 6.5(8/3), thus causing an unexpected
exception at runtime.
After this patch the following test compiles and executes without errors.
package Ifaces is
type Iface is limited interface;
end;
package Roots is
type Root is tagged record
X : integer;
end record;
end;
with Ifaces; use Ifaces;
with Roots; use Roots;
package Maps is
type DT is new Root and Iface with null record;
function Get_Iface return Iface'Class;
end;
package body Maps is
function Prim return Iface'Class is
Obj : DT;
begin
return Obj;
end;
function Get_Iface return Iface'Class is
begin
return Prim; -- test
end;
end;
with Maps; use Maps;
with Ifaces; use Ifaces;
procedure debug is
Junk : Iface'Class := Get_Iface;
begin
null;
end debug;
Command: gnatmake debug; ./debug
Tested on x86_64-pc-linux-gnu, committed on trunk
2015-03-04 Javier Miranda <miranda@adacore.com>
* exp_ch6.adb (Expand_Simple_Function_Return): When the returned
object is a class-wide interface object and we generate the
accessibility described in RM 6.5(8/3) then displace the pointer
to the object to reference the base of the object (to get access
to the TSD of the object).
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 4290 bytes --]
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 221177)
+++ exp_ch6.adb (working copy)
@@ -4379,7 +4379,7 @@
(Result, New_Occurrence_Of (Return_Statement_Entity (N), Loc));
-- If the object decl was already rewritten as a renaming, then we
- -- don't want to do the object allocation and transformation of of
+ -- don't want to do the object allocation and transformation of
-- the return object declaration to a renaming. This case occurs
-- when the return object is initialized by a call to another
-- build-in-place function, and that function is responsible for
@@ -6266,18 +6266,60 @@
if Is_Class_Wide_Type (Etype (Exp))
and then Is_Interface (Etype (Exp))
- and then Nkind (Exp) = N_Explicit_Dereference
then
- Tag_Node :=
- Make_Explicit_Dereference (Loc,
- Prefix =>
- Unchecked_Convert_To (RTE (RE_Tag_Ptr),
- Make_Function_Call (Loc,
- Name =>
- New_Occurrence_Of (RTE (RE_Base_Address), Loc),
- Parameter_Associations => New_List (
- Unchecked_Convert_To (RTE (RE_Address),
- Duplicate_Subexpr (Prefix (Exp)))))));
+ -- If the expression is an explicit dereference then we can
+ -- directly displace the pointer to reference the base of
+ -- the object.
+
+ if Nkind (Exp) = N_Explicit_Dereference then
+ Tag_Node :=
+ Make_Explicit_Dereference (Loc,
+ Prefix =>
+ Unchecked_Convert_To (RTE (RE_Tag_Ptr),
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Base_Address), Loc),
+ Parameter_Associations => New_List (
+ Unchecked_Convert_To (RTE (RE_Address),
+ Duplicate_Subexpr (Prefix (Exp)))))));
+
+ -- Similar case to the previous one but the expression is a
+ -- renaming of an explicit dereference.
+
+ elsif Nkind (Exp) = N_Identifier
+ and then Present (Renamed_Object (Entity (Exp)))
+ and then Nkind (Renamed_Object (Entity (Exp)))
+ = N_Explicit_Dereference
+ then
+ Tag_Node :=
+ Make_Explicit_Dereference (Loc,
+ Prefix =>
+ Unchecked_Convert_To (RTE (RE_Tag_Ptr),
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Base_Address), Loc),
+ Parameter_Associations => New_List (
+ Unchecked_Convert_To (RTE (RE_Address),
+ Duplicate_Subexpr
+ (Prefix
+ (Renamed_Object (Entity (Exp)))))))));
+
+ -- Common case: obtain the address of the actual object and
+ -- displace the pointer to reference the base of the object.
+
+ else
+ Tag_Node :=
+ Make_Explicit_Dereference (Loc,
+ Prefix =>
+ Unchecked_Convert_To (RTE (RE_Tag_Ptr),
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (RTE (RE_Base_Address), Loc),
+ Parameter_Associations => New_List (
+ Make_Attribute_Reference (Loc,
+ Prefix => Duplicate_Subexpr (Exp),
+ Attribute_Name => Name_Address)))));
+ end if;
else
Tag_Node :=
Make_Attribute_Reference (Loc,
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2015-03-04 10:28 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-03-04 10:28 [Ada] Wrong runtime check on function returning interface type 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).