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:
parent
10e4d0563e
commit
e9f57686fc
@ -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.
|
||||
|
@ -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);
|
||||
|
@ -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...
|
||||
|
12
gcc/testsuite/gnat.dg/deferred_const4.adb
Normal file
12
gcc/testsuite/gnat.dg/deferred_const4.adb
Normal 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;
|
17
gcc/testsuite/gnat.dg/deferred_const4.ads
Normal file
17
gcc/testsuite/gnat.dg/deferred_const4.ads
Normal 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;
|
22
gcc/testsuite/gnat.dg/deferred_const4_pkg.ads
Normal file
22
gcc/testsuite/gnat.dg/deferred_const4_pkg.ads
Normal 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;
|
Loading…
Reference in New Issue
Block a user