trans.c (Identifier_to_gnu): Also handle deferred constants whose full view has discriminants specially.

* gcc-interface/trans.c (Identifier_to_gnu): Also handle deferred
	constants whose full view has discriminants specially.

From-SVN: r174689
This commit is contained in:
Eric Botcazou 2011-06-06 10:21:58 +00:00 committed by Eric Botcazou
parent 10e4d0563e
commit e9f57686fc
6 changed files with 66 additions and 3 deletions

View File

@ -1,3 +1,8 @@
2011-06-06 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/trans.c (Identifier_to_gnu): Also handle deferred
constants whose full view has discriminants specially.
2011-06-06 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils.c: Include diagnostic.h.

View File

@ -906,9 +906,11 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
attribute Position, generated for dispatching code (see Make_DT in
exp_disp,adb). In that case we need the type itself, not is parent,
in particular if it is a derived type */
if (Is_Private_Type (gnat_temp_type)
&& Has_Unknown_Discriminants (gnat_temp_type)
&& Ekind (gnat_temp) == E_Constant
if (Ekind (gnat_temp) == E_Constant
&& Is_Private_Type (gnat_temp_type)
&& (Has_Unknown_Discriminants (gnat_temp_type)
|| (Present (Full_View (gnat_temp_type))
&& Has_Discriminants (Full_View (gnat_temp_type))))
&& Present (Full_View (gnat_temp)))
{
gnat_temp = Full_View (gnat_temp);

View File

@ -1,3 +1,8 @@
2011-06-06 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/deferred_const4.ad[sb]: New test.
* gnat.dg/deferred_const4_pkg.ads: New helper.
2011-06-06 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/test_tamdt.adb: Rename to...

View File

@ -0,0 +1,12 @@
-- { dg-do compile }
package body Deferred_Const4 is
function F return My_Q.T is
R : My_Q.T;
begin
R := My_Q.Null_T;
return R;
end;
end Deferred_Const4;

View File

@ -0,0 +1,17 @@
with Deferred_Const4_Pkg;
package Deferred_Const4 is
type R1 is tagged record
I1 : Integer;
end record;
type R2 is new R1 with record
I2 : Integer;
end record;
package My_Q is new Deferred_Const4_Pkg (R2);
function F return My_Q.T;
end Deferred_Const4;

View File

@ -0,0 +1,22 @@
generic
type User_T is private;
package Deferred_Const4_Pkg is
type T is private;
Null_T : constant T;
private
type T (Valid : Boolean := False) is record
case Valid is
when True => Value : User_T;
when False => null;
end case;
end record;
Null_T : constant T := (Valid => False);
end Deferred_Const4_Pkg;