This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix ICE on deferred constant with tagged type
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Mon, 6 Jun 2011 12:14:46 +0200
- Subject: [Ada] Fix ICE on deferred constant with tagged type
This is again the compiler trying to create a temporary for a VIEW_CONVERT_EXPR
and the type doesn't allow it. Fixed by not generating the VIEW_CONVERT_EXPR
in the first place.
Tested on i586-suse-linux, applied on the mainline
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>
* gnat.dg/deferred_const4.ad[sb]: New test.
* gnat.dg/deferred_const4_pkg.ads: New helper.
--
Eric Botcazou
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 174631)
+++ gcc-interface/trans.c (working copy)
@@ -906,9 +906,11 @@ Identifier_to_gnu (Node_Id gnat_node, tr
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);
-- { 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;
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;
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;