sem_ch8.adb (Available_Subtype): Optimization in Find_Selected_Component...

2015-03-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Available_Subtype): Optimization in
	Find_Selected_Component: when safe, use existing subtype of
	array component, possibly discriminant-dependent, rather than
	creating new subtype declaration for it. In this fashion different
	occurrences of the component have the same subtype, rather than
	just equivalent ones. Simplifies value tracing in GNATProve.

From-SVN: r221100

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5deda8fb5b29be1458ccde94d8c24a06bd7d444e..ca420de816e891425f2966151395da4f7c799abd 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2015-03-02  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch8.adb (Available_Subtype): Optimization in
+       Find_Selected_Component: when safe, use existing subtype of
+       array component, possibly discriminant-dependent, rather than
+       creating new subtype declaration for it. In this fashion different
+       occurrences of the component have the same subtype, rather than
+       just equivalent ones. Simplifies value tracing in GNATProve.
+
 2015-03-01  Arnaud Charlet  <charlet@adacore.com>
 
        PR ada/65259

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index c8d81f0baa18a142c81ff20c5799a6bec2691874..93998be02791b88cb79276489f304d8bb2054b05 100644 (file)
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -6454,6 +6454,13 @@ package body Sem_Ch8 is
 
       Nam : Node_Id;
 
+      function Available_Subtype return Boolean;
+      --  A small optimization: if the prefix is constrained and the component
+      --  is an array type we may already have a usable subtype for it, so we
+      --  can use it rather than generating a new one, because the bounds
+      --  will be the values of the discriminants and not discriminant refs.
+      --  This simplifies value tracing in GNATProve.
+
       function Is_Reference_In_Subunit return Boolean;
       --  In a subunit, the scope depth is not a proper measure of hiding,
       --  because the context of the proper body may itself hide entities in
@@ -6461,6 +6468,27 @@ package body Sem_Ch8 is
       --  because the proper body is inserted in the main unit and its context
       --  is simply added to that of the parent.
 
+      -----------------------
+      -- Available_Subtype --
+      -----------------------
+
+      function Available_Subtype return Boolean is
+         Comp : Entity_Id;
+      begin
+         Comp := First_Entity (Etype (P));
+         while Present (Comp) loop
+            if Chars (Comp) = Chars (Selector_Name (N)) then
+               Set_Etype (N, Etype (Comp));
+               Set_Etype (Selector_Name (N), Etype (Comp));
+               return True;
+            end if;
+
+            Next_Component (Comp);
+         end loop;
+
+         return False;
+      end Available_Subtype;
+
       -----------------------------
       -- Is_Reference_In_Subunit --
       -----------------------------
@@ -6563,6 +6591,15 @@ package body Sem_Ch8 is
                  and then (not Is_Entity_Name (P)
                             or else Chars (Entity (P)) /= Name_uInit)
                then
+                  if Is_Entity_Name (P)
+                    and then Ekind (Etype (P)) = E_Record_Subtype
+                    and then Nkind (Parent (Etype (P))) = N_Subtype_Declaration
+                    and then Is_Array_Type (Etype (Selector))
+                    and then not Is_Packed (Etype (Selector))
+                    and then Available_Subtype
+                  then
+                     return;
+
                   --  Do not build the subtype when referencing components of
                   --  dispatch table wrappers. Required to avoid generating
                   --  elaboration code with HI runtimes. JVM and .NET use a
@@ -6570,7 +6607,7 @@ package body Sem_Ch8 is
                   --  Dispatch_Table_Wrapper and RE_No_Dispatch_Table_Wrapper.
                   --  Avoid raising RE_Not_Available exception in those cases.
 
-                  if VM_Target = No_VM
+                  elsif VM_Target = No_VM
                     and then RTU_Loaded (Ada_Tags)
                     and then
                       ((RTE_Available (RE_Dispatch_Table_Wrapper)