[Ada] Enhance constraints propagation to ease the work of optimizers

This patch recognizes additional object declarations whose defining
identifier is known statically to be valid. This allows additional
optimizations to be performed by the front-end.

Executing:

   gcc -c -gnatDG p.ads

On the following sources:

----
with G;
With Q;

package P is

  Val : constant Positive := Q.Config_Value ("Size");

  package My_G is new G (Val);

end P;
----
generic

  Num : Natural := 0;

package G is

  Multi : constant Boolean := Num > 0;

  type Info is array (True .. Multi) of Integer;

  type Arr is array (Natural range <>) of Boolean;

  type Rec (D : Natural) is record
    C : character;
    I : Info;
    E : Arr (0 .. D);
  end record;

end G;
----
package Q is

  function Config_Value (S : String) return Integer;

end Q;
----

Must yield (note that variable Multi has been statically optimized to
true):

----
with g;
with q;
p_E : short_integer := 0;

package p is
   p__R2s : constant integer := q.q__config_value ("Size");
   [constraint_error when
     not (p__R2s >= 1)
     "range check failed"]
   p__val : constant positive := p__R2s;

   package p__my_g is
      p__my_g__num : constant natural := p__val;
      package p__my_g__g renames p__my_g;
      package p__my_g__gGH renames p__my_g__g;
      p__my_g__multi : constant boolean := true;
      type p__my_g__info is array (true .. p__my_g__multi) of integer;
      type p__my_g__arr is array (0 .. 16#7FFF_FFFF# range <>) of
        boolean;
      type p__my_g__rec (d : natural) is record
         c : character;
         i : p__my_g__info;
         e : p__my_g__arr (0 .. d);
      end record;
      [type p__my_g__TinfoB is array (true .. p__my_g__multi range <>) of
        integer]
      freeze p__my_g__TinfoB [
         procedure p__my_g__TinfoBIP (_init : in out p__my_g__TinfoB) is
         begin
            null;
            return;
         end p__my_g__TinfoBIP;
      ]
      freeze p__my_g__info []
      freeze p__my_g__arr [
         procedure p__my_g__arrIP (_init : in out p__my_g__arr) is
         begin
            null;
            return;
         end p__my_g__arrIP;
      ]
      freeze p__my_g__rec [
         procedure p__my_g__recIP (_init : in out p__my_g__rec; d :
           natural) is
         begin
            _init.d := d;
            null;
            return;
         end p__my_g__recIP;
      ]
   end p__my_g;

   package my_g is new g (p__val);
end p;

freeze_generic info
[subtype TinfoD1 is boolean range true .. multi]
freeze_generic TinfoD1
[type TinfoB is array (true .. multi range <>) of integer]
freeze_generic TinfoB
freeze_generic arr
freeze_generic rec
----

2018-11-14  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch3.adb (Analyze_Object_Declaration): Use the
	Actual_Subtype to preserve information about a constant
	initialized with a non-static entity that is known to be valid,
	when the type of the entity has a narrower range than that of
	the nominal subtype of the constant.
	* checks.adb (Determine_Range): If the expression is a constant
	entity that is known-valid and has a defined Actual_Subtype, use
	it to determine the actual bounds of the value, to enable
	additional optimizations.

From-SVN: r266123

1 files changed, 12 insertions, 1 deletions

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 6b9e6541f86..89f26fa0770 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -722,7 +722,7 @@ package body Checks is
       --  Generate a check to raise PE if alignment may be inappropriate
 
       else
-         --  If the original expression is a non-static constant, use the name
+         --  If the original expression is a nonstatic constant, use the name
          --  of the constant itself rather than duplicating its initialization
          --  expression, which was extracted above.
 
@@ -4563,6 +4563,17 @@ package body Checks is
         or else Assume_No_Invalid_Values
         or else Assume_Valid
       then
+         --  If this is a known valid constant with a nonstatic value, it may
+         --  have inherited a narrower subtype from its initial value; use this
+         --  saved subtype (see sem_ch3.adb).
+
+         if Is_Entity_Name (N)
+           and then Ekind (Entity (N)) = E_Constant
+           and then Present (Actual_Subtype (Entity (N)))
+         then
+            Typ := Actual_Subtype (Entity (N));
+         end if;
+
          null;
       else
          Typ := Underlying_Type (Base_Type (Typ));