From baad98300aff8149553e5f09871be690bd5cacb9 Mon Sep 17 00:00:00 2001 From: Thomas Quinot Date: Wed, 5 Dec 2012 11:03:15 +0000 Subject: [PATCH] exp_dist.adb (Build_From_Any_Call, [...]): For a used-defined subtype, always go to the first subtype of the base type. 2012-12-05 Thomas Quinot * exp_dist.adb (Build_From_Any_Call, Build_To_Any_Call, Build_TypeCode_Call): For a used-defined subtype, always go to the first subtype of the base type. From-SVN: r194206 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/exp_dist.adb | 30 ++++++++++++++++++++++++++---- 2 files changed, 32 insertions(+), 4 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 365039f0bf3..802b2dbdf4e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2012-12-05 Thomas Quinot + + * exp_dist.adb (Build_From_Any_Call, Build_To_Any_Call, + Build_TypeCode_Call): For a used-defined subtype, always go to + the first subtype of the base type. + 2012-12-05 Thomas Quinot * exp_dist.adb: Minor reformatting. diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 92aa4270057..7c7fbd06f5f 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -839,7 +839,7 @@ package body Exp_Dist is Fnam : out Entity_Id); -- Build TypeCode attribute function for Typ. Loc is the reference -- location for generated nodes, Typ is the type for which the - -- conversion function is generated. On return, Decl and Fnam contain + -- typecode function is generated. On return, Decl and Fnam contain -- the declaration and entity for the newly-created function. procedure Build_Name_And_Repository_Id @@ -8453,6 +8453,14 @@ package body Exp_Dist is if Sloc (U_Type) <= Standard_Location then U_Type := Base_Type (U_Type); + + -- For a user subtype, go to first subtype + + elsif Comes_From_Source (U_Type) + and then Nkind (Declaration_Node (U_Type)) + = N_Subtype_Declaration + then + U_Type := First_Subtype (U_Type); end if; -- Check first for Boolean and Character. These are enumeration @@ -9261,6 +9269,14 @@ package body Exp_Dist is if Sloc (U_Type) <= Standard_Location then U_Type := Base_Type (U_Type); + + -- For a user subtype, go to first subtype + + elsif Comes_From_Source (U_Type) + and then Nkind (Declaration_Node (U_Type)) + = N_Subtype_Declaration + then + U_Type := First_Subtype (U_Type); end if; if Present (Fnam) then @@ -10045,6 +10061,14 @@ package body Exp_Dist is if Sloc (U_Type) <= Standard_Location then U_Type := Base_Type (U_Type); + + -- For a user subtype, go to first subtype + + elsif Comes_From_Source (U_Type) + and then Nkind (Declaration_Node (U_Type)) + = N_Subtype_Declaration + then + U_Type := First_Subtype (U_Type); end if; if No (Fnam) then @@ -10257,9 +10281,7 @@ package body Exp_Dist is -- Return_Alias_TypeCode -- --------------------------- - procedure Return_Alias_TypeCode - (Base_TypeCode : Node_Id) - is + procedure Return_Alias_TypeCode (Base_TypeCode : Node_Id) is begin Add_TypeCode_Parameter (Base_TypeCode, Parameters); Return_Constructed_TypeCode (RTE (RE_TC_Alias)); -- 2.30.2