ada: Fix inefficient Unchecked_Conversion to large array type

We fail to use the implementation permission given by RM 13.9(12) because
the array type does not have the Size_Known_At_Compile_Time flag set.

gcc/ada/ChangeLog:

	* freeze.adb (Check_Compile_Time_Size): Try harder to see whether
	the bounds of array types are known at compile time.

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index be2115a90867a2cb80b7d29502f412b6823dbaab..3755d9e53debc776d133d04008d1ca25ae6407b1 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -765,6 +765,9 @@ package body Freeze is
       --  in fact constrained by non-static discriminant values. Could be made
       --  more precise ???
 
+      function Value_Known (Exp : Node_Id) return Boolean;
+      --  Return True if the value of expression Exp is known at compile time
+
       --------------------
       -- Set_Small_Size --
       --------------------
@@ -880,13 +883,13 @@ package body Freeze is
                      High := Type_High_Bound (Etype (Index));
                   end if;
 
-                  if not Compile_Time_Known_Value (Low)
-                    or else not Compile_Time_Known_Value (High)
-                    or else Etype (Index) = Any_Type
-                  then
+                  if Etype (Index) = Any_Type then
                      return False;
 
-                  else
+                  elsif Compile_Time_Known_Value (Low)
+                    and then Compile_Time_Known_Value (High)
+                  then
+
                      Dim := Expr_Value (High) - Expr_Value (Low) + 1;
 
                      if Dim > Uint_0 then
@@ -894,6 +897,12 @@ package body Freeze is
                      else
                         Size := Uint_0;
                      end if;
+
+                  elsif Value_Known (Low) and then Value_Known (High) then
+                     Size := Uint_0;
+
+                  else
+                     return False;
                   end if;
 
                   Next_Index (Index);
@@ -1160,6 +1169,70 @@ package body Freeze is
          return True;
       end Static_Discriminated_Components;
 
+      -----------------
+      -- Value_Known --
+      -----------------
+
+      function Value_Known (Exp : Node_Id) return Boolean is
+      begin
+         --  This is the immediate case
+
+         if Compile_Time_Known_Value (Exp) then
+            return True;
+         end if;
+
+         --  The value may be known only to the back end, the typical example
+         --  being the alignment or the various sizes of composite types; in
+         --  the latter case, we may mutually recurse with Size_Known.
+
+         case Nkind (Exp) is
+            when N_Attribute_Reference =>
+               declare
+                  P : constant Node_Id := Prefix (Exp);
+
+               begin
+                  if not Is_Entity_Name (P)
+                    or else not Is_Type (Entity (P))
+                  then
+                     return False;
+                  end if;
+
+                  case Get_Attribute_Id (Attribute_Name (Exp)) is
+                     when Attribute_Alignment =>
+                        return True;
+
+                     when Attribute_Component_Size =>
+                        return Size_Known (Component_Type (Entity (P)));
+
+                     when Attribute_Object_Size
+                        | Attribute_Size
+                        | Attribute_Value_Size
+                     =>
+                        return Size_Known (Entity (P));
+
+                     when others =>
+                        return False;
+                  end case;
+               end;
+
+            when N_Binary_Op =>
+               return Value_Known (Left_Opnd (Exp))
+                 and then Value_Known (Right_Opnd (Exp));
+
+            when N_Qualified_Expression
+               | N_Type_Conversion
+               | N_Unchecked_Type_Conversion
+            =>
+               return Value_Known (Expression (Exp));
+
+            when N_Unary_Op =>
+               return Value_Known (Right_Opnd (Exp));
+
+            when others =>
+               return False;
+         end case;
+      end Value_Known;
+
    --  Start of processing for Check_Compile_Time_Size
 
    begin