Weekly merge from trunk. No regressions.reload-v2a

git-svn-id: https://gcc.gnu.org/svn/gcc/branches/reload-v2a@181834 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 77 insertions, 0 deletions

diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 4b284cd9599..35c4eeebda0 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -905,6 +905,83 @@ package body Sem_Ch9 is
          Bad_Predicated_Subtype_Use
            ("subtype& has predicate, not allowed in entry family",
             D_Sdef, Etype (D_Sdef));
+
+         --  Check entry family static bounds outside allowed limits
+
+         --  Note: originally this check was not performed here, but in that
+         --  case the check happens deep in the expander, and the message is
+         --  posted at the wrong location, and omitted in -gnatc mode.
+         --  If the type of the entry index is a generic formal, no check
+         --  is possible. In an instance, the check is not static and a run-
+         --  time exception will be raised if the bounds are unreasonable.
+
+         declare
+            PEI : constant Entity_Id := RTE (RE_Protected_Entry_Index);
+            LB  : constant Uint      := Expr_Value (Type_Low_Bound (PEI));
+            UB  : constant Uint      := Expr_Value (Type_High_Bound (PEI));
+
+            LBR : Node_Id;
+            UBR : Node_Id;
+
+         begin
+
+            --  No bounds checking if the type is generic or if previous error.
+            --  In an instance the check is dynamic.
+
+            if Is_Generic_Type (Etype (D_Sdef))
+              or else In_Instance
+              or else Error_Posted (D_Sdef)
+            then
+               goto Skip_LB;
+
+            elsif Nkind (D_Sdef) = N_Range then
+               LBR := Low_Bound (D_Sdef);
+
+            elsif Is_Entity_Name (D_Sdef)
+              and then Is_Type (Entity (D_Sdef))
+            then
+               LBR := Type_Low_Bound (Entity (D_Sdef));
+
+            else
+               goto Skip_LB;
+            end if;
+
+            if Is_Static_Expression (LBR)
+              and then Expr_Value (LBR) < LB
+            then
+               Error_Msg_Uint_1 := LB;
+               Error_Msg_N ("entry family low bound must be '>'= ^!", D_Sdef);
+            end if;
+
+            <<Skip_LB>>
+            if Is_Generic_Type (Etype (D_Sdef))
+              or else In_Instance
+              or else Error_Posted (D_Sdef)
+            then
+               goto Skip_UB;
+
+            elsif Nkind (D_Sdef) = N_Range then
+               UBR := High_Bound (D_Sdef);
+
+            elsif Is_Entity_Name (D_Sdef)
+              and then Is_Type (Entity (D_Sdef))
+            then
+               UBR := Type_High_Bound (Entity (D_Sdef));
+
+            else
+               goto Skip_UB;
+            end if;
+
+            if Is_Static_Expression (UBR)
+              and then Expr_Value (UBR) > UB
+            then
+               Error_Msg_Uint_1 := UB;
+               Error_Msg_N ("entry family high bound must be '<'= ^!", D_Sdef);
+            end if;
+
+            <<Skip_UB>>
+            null;
+         end;
       end if;
 
       --  Decorate Def_Id