From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 25 May 2020 21:27:46 +0000 (+0200)
Subject: [Ada] Fix internal error on if-expression in call returning tagged type
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=b89896312467947542a6eebee886d182e6508760;p=gcc.git

[Ada] Fix internal error on if-expression in call returning tagged type

gcc/ada/

	* checks.adb (Determine_Range): Deal with Min and Max attributes.
	* exp_ch6.adb (Expand_Call_Helper): When generating code to pass
	the accessibility level to the caller in the case of an actual
	which is an if-expression, also remove the nodes created after
	the declaration of the dummy temporary.
	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Use Natural as
	the type of the minimum accessibility level object.
---

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 6f1bb18d9b5..2f6760067c4 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -5119,6 +5119,27 @@ package body Checks is
          when N_Attribute_Reference =>
             case Get_Attribute_Id (Attribute_Name (N)) is
 
+               --  For Min/Max attributes, we can refine the range using the
+               --  possible range of values of the attribute expressions.
+
+               when Attribute_Min
+                  | Attribute_Max
+               =>
+                  Determine_Range
+                    (First (Expressions (N)),
+                     OK1, Lo_Left, Hi_Left, Assume_Valid);
+
+                  if OK1 then
+                     Determine_Range
+                       (Next (First (Expressions (N))),
+                        OK1, Lo_Right, Hi_Right, Assume_Valid);
+                  end if;
+
+                  if OK1 then
+                     Lor := UI_Min (Lo_Left, Lo_Right);
+                     Hir := UI_Max (Hi_Left, Hi_Right);
+                  end if;
+
                --  For Pos/Val attributes, we can refine the range using the
                --  possible range of values of the attribute expression.
 
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index e3fcbc7afef..776ff49daea 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -3927,6 +3927,8 @@ package body Exp_Ch6 is
                      then
                         declare
                            Decl : Node_Id;
+                           pragma Warnings (Off, Decl);
+                           --  Suppress warning for the final removal loop
                            Lvl  : Entity_Id;
                            Res  : Entity_Id;
                            Temp : Node_Id;
@@ -4045,8 +4047,7 @@ package body Exp_Ch6 is
                            --  expansion if we are dealing with a function
                            --  call.
 
-                           if Nkind (Call_Node) =
-                                N_Procedure_Call_Statement
+                           if Nkind (Call_Node) = N_Procedure_Call_Statement
                            then
                               --  Generate:
                               --    Lvl : Natural;
@@ -4109,7 +4110,13 @@ package body Exp_Ch6 is
 
                               Set_Expression (Call_Node, Relocate_Node (Temp));
                               Call_Node := Expression (Call_Node);
-                              Remove (Next (Decl));
+
+                              --  Remove the declaration of the dummy and the
+                              --  subsequent actions its analysis has created.
+
+                              while Present (Remove_Next (Decl)) loop
+                                 null;
+                              end loop;
                            end if;
 
                            --  Decorate the conditional expression with
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 0785c1cab4c..fb14cbd68cf 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -4684,7 +4684,7 @@ package body Sem_Ch6 is
                   then
                      --  Generate the minimum accessibility level object
 
-                     --    A60b : integer := integer'min(2, paramL);
+                     --    A60b : natural := natural'min(1, paramL);
 
                      declare
                         Loc      : constant Source_Ptr := Sloc (Body_Nod);
@@ -4694,11 +4694,11 @@ package body Sem_Ch6 is
                               Make_Temporary
                                 (Loc, 'A', Extra_Accessibility (Form)),
                             Object_Definition   => New_Occurrence_Of
-                                                     (Standard_Integer, Loc),
+                                                     (Standard_Natural, Loc),
                             Expression          =>
                               Make_Attribute_Reference (Loc,
                                 Prefix         => New_Occurrence_Of
-                                                    (Standard_Integer, Loc),
+                                                    (Standard_Natural, Loc),
                                 Attribute_Name => Name_Min,
                                 Expressions    => New_List (
                                   Make_Integer_Literal (Loc,