From: Eric Botcazou <ebotcazou@adacore.com>
Date: Tue, 4 Feb 2020 23:13:00 +0000 (+0100)
Subject: [Ada] Fix incorrect initialization for array of non-standard enumeration type
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c7d193178f7b3a7747849d4f8574091bc2d4a7f8;p=gcc.git

[Ada] Fix incorrect initialization for array of non-standard enumeration type

2020-06-05  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* exp_aggr.adb (Aggr_Assignment_OK_For_Backend): Use
	Expr_Rep_Value instead of Expr_Value to obtain the equivalent
	integer value.
	* sem_eval.ads (Expr_Value): Document more supported cases.
	* sem_eval.adb (Expr_Rep_Value): Copy missing cases from
	Exp_Value.
---

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 7805c2d8f85..26765e9f438 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -5390,9 +5390,10 @@ package body Exp_Aggr is
             return Expr_Value_R (Expr) = Ureal_0;
          end if;
 
-         --  For other types, we can look into the value as an integer
+         --  For other types, we can look into the value as an integer, which
+         --  means the representation value for enumeration literals.
 
-         Value := Expr_Value (Expr);
+         Value := Expr_Rep_Value (Expr);
 
          if Has_Biased_Representation (Ctyp) then
             Value := Value - Expr_Value (Type_Low_Bound (Ctyp));
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index ce0d9074052..d4a3ff86e6a 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -4203,10 +4203,16 @@ package body Sem_Eval is
          pragma Assert (Is_Fixed_Point_Type (Underlying_Type (Etype (N))));
          return Corresponding_Integer_Value (N);
 
-      --  Otherwise must be character literal
+      --  The NULL access value
 
-      else
-         pragma Assert (Kind = N_Character_Literal);
+      elsif Kind = N_Null then
+         pragma Assert (Is_Access_Type (Underlying_Type (Etype (N)))
+           or else Error_Posted (N));
+         return Uint_0;
+
+      --  Character literal
+
+      elsif Kind = N_Character_Literal then
          Ent := Entity (N);
 
          --  Since Character literals of type Standard.Character don't have any
@@ -4220,6 +4226,15 @@ package body Sem_Eval is
          else
             return Enumeration_Rep (Ent);
          end if;
+
+      --  Unchecked conversion, which can come from System'To_Address (X)
+      --  where X is a static integer expression. Recursively evaluate X.
+
+      elsif Kind = N_Unchecked_Type_Conversion then
+         return Expr_Rep_Value (Expression (N));
+
+      else
+         raise Program_Error;
       end if;
    end Expr_Rep_Value;
 
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index 15016461a41..ba84e54868b 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -276,7 +276,9 @@ package Sem_Eval is
    --  or character literals. In the latter two cases, the value returned is
    --  the Pos value in the relevant enumeration type. It can also be used for
    --  fixed-point values, in which case it returns the corresponding integer
-   --  value. It cannot be used for floating-point values.
+   --  value, but it cannot be used for floating-point values. Finally, it can
+   --  also be used for the Null access value, as well as for the result of an
+   --  unchecked conversion of the aforementioned handled values.
 
    function Expr_Value_E (N : Node_Id) return Entity_Id;
    --  Returns the folded value of the expression. This function is called in