exp_dist.adb (Build_From_Any_Call, [...]): For a used-defined subtype, always go...

2012-12-05  Thomas Quinot  <quinot@adacore.com>

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 365039f0bf31b913be418b7bb2e01fe540dd2c44..802b2dbdf4e55ae2f6ecf878a57ebdc26df82869 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2012-12-05  Thomas Quinot  <quinot@adacore.com>
+
+       * 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  <quinot@adacore.com>
 
        * exp_dist.adb: Minor reformatting.

diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb
index 92aa42700570361c259bc35861c33237bd72b260..7c7fbd06f5f0662c2d1d55c2e3944a7685c5c3db 100644 (file)
--- 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));